View | Details | Raw Unified | Return to bug 7963
Collapse All | Expand All

(-)a/misc/cronjobs/check-url-quick (-1 / +190 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright 2012 Tamil s.a.r.l.
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use 5.010;
21
use utf8;
22
use strict;
23
use warnings;
24
use Pod::Usage;
25
use Getopt::Long;
26
use C4::Context;
27
use C4::Biblio;
28
use AnyEvent;
29
use AnyEvent::HTTP;
30
31
my ($verbose, $help, $html) = (0, 0, 0);
32
my ($host, $host_pro)       = ('', '');
33
my ($timeout, $maxconn)     = (10, 200);
34
my $uriedit                 = "/cgi-bin/koha/cataloguing/addbiblio.pl?biblionumber=";
35
my $user_agent              ='Mozilla/5.0 (compatible; U; Koha checkurl)';
36
GetOptions(
37
    'verbose'    => \$verbose,
38
    'html'       => \$html,
39
    'help'       => \$help,
40
    'host=s'     => \$host,
41
    'host-pro=s' => \$host_pro,
42
    'timeout=i'  => \$timeout,
43
    'maxconn=i'  => \$maxconn,
44
);
45
46
47
sub usage {
48
    pod2usage( -verbose => 2 );
49
    exit;
50
}
51
52
53
sub report {
54
    my ($hdr, $biblionumber, $url) = @_;
55
    print $html
56
    ? "<tr>\n <td><a href=\"" .
57
      $host_pro . $uriedit . $biblionumber.
58
      "\">$biblionumber</a>" .
59
      "</td>\n <td>$url</td>\n <td>" .
60
      "$hdr->{Status} $hdr->{Reason}</td>\n</tr>\n"
61
    : "$biblionumber\t$url\t" .
62
      "$hdr->{Status} $hdr->{Reason}\n";
63
}
64
65
66
# Check all URLs from all current Koha biblio records
67
68
sub check_all_url {
69
    my $sth = C4::Context->dbh->prepare(
70
        "SELECT biblionumber FROM biblioitems WHERE url IS NOT NULL");
71
    $sth->execute;
72
73
    my $count = 0; # Number of requested URL
74
    my $cv = AnyEvent->condvar;
75
    say "<html>\n<body>\n<div id=\"checkurl\">\n<table>" if $html;
76
    my $idle = AnyEvent->timer(
77
        interval => .3,
78
        cb => sub {
79
            return if $count > $maxconn;
80
            while ( my ($biblionumber) = $sth->fetchrow ) {
81
                my $record = GetMarcBiblio( $biblionumber );
82
                next unless $record->field('856');
83
                foreach my $field ( $record->field('856') ) {
84
                    my $url = $field->subfield('u');
85
                    next unless $url;
86
                    $url = "$host/$url" unless $url =~ /^http/i;
87
                    $count++;
88
                    http_request(
89
                        HEAD => $url,
90
                        headers => { 'user-agent' => $user_agent },
91
                        timeout => $timeout,
92
                        sub {
93
                            my (undef, $hdr) = @_;
94
                            $count--;
95
                            report($hdr, $biblionumber, $url)
96
                                if $hdr->{Status} !~ /^2/ || $verbose;
97
                        },
98
                    );
99
                }
100
                return if $count > $maxconn;
101
            }
102
            $cv->send;
103
        }
104
    );
105
    $cv->recv;
106
    $idle = undef;
107
108
    # Few more time for pending requests
109
    $cv = AnyEvent->condvar;
110
    my $timer = AnyEvent->timer(
111
        after => $timeout, interval => $timeout,
112
        cb => sub { $cv->send if $count == 0; }
113
    );
114
    $cv->recv;
115
    say "</table>\n</div>\n</body>\n</html>" if $html;
116
}
117
118
119
usage() if $help;
120
121
if ( $html && !$host_pro ) {
122
    if ( $host ) {
123
        $host_pro = $host;
124
    }
125
    else {
126
        say "Error: host-pro parameter or host must be provided in html mode";
127
        exit;
128
    }
129
}
130
131
check_all_url();
132
133
134
=head1 NAME
135
136
check-url-quick - Check URLs from 856$u field.
137
138
=head1 USAGE
139
140
=over
141
142
=item check-url-quick [--verbose|--help|--html] [--host=http://default.tld]
143
[--host-intranet]
144
145
Scan all URLs found in 856$u of bib records and display if resources are
146
available or not. HTTP requests are sent in parallel for efficiency, and speed.
147
This speed replace check-url.pl script.
148
149
=back
150
151
=head1 PARAMETERS
152
153
=over
154
155
=item B<--host=http://default.tld>
156
157
Server host used when URL doesn't have one, ie doesn't begin with 'http:'.
158
For example, if --host=http://www.mylib.com, then when 856$u contains
159
'img/image.jpg', the url checked is: http://www.mylib.com/image.jpg'.
160
161
=item B<--verbose|-v>
162
163
Outputs both successful and failed URLs.
164
165
=item B<--html>
166
167
Formats output in HTML. The result can be redirected to a file
168
accessible by http. This way, it's possible to link directly to biblio
169
record in edit mode. With this parameter B<--host-pro> is required.
170
171
=item B<--host-intranet=http://koha-pro.tld>
172
173
Server host used to link to biblio record editing page in Koha intranet
174
interface.
175
176
=item B<--timeout=10>
177
178
Timeout for fetching URLs. By default 10 seconds.
179
180
=item B<--maxconn=1000>
181
182
Number of simulaneous HTTP requests. By default 200 connexions.
183
184
=item B<--help|-h>
185
186
Print this help page.
187
188
=back
189
190
=cut

Return to bug 7963