3 # Copyright 2012 Tamil s.a.r.l.
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
21 use Pod::Usage qw( pod2usage );
22 use Getopt::Long qw( GetOptions );
24 use Koha::Script -cron;
28 use AnyEvent::HTTP qw( http_request );
29 use Encode qw( encode_utf8 );
31 my ( $verbose, $help, $html ) = ( 0, 0, 0 );
32 my ( $host, $host_intranet ) = ( '', '' );
33 my ( $timeout, $maxconn ) = ( 10, 200 );
35 my $uriedit = "/cgi-bin/koha/cataloguing/addbiblio.pl?biblionumber=";
36 my $user_agent = 'Mozilla/5.0 (compatible; U; Koha checkurl)';
38 'verbose' => \$verbose,
42 'host-intranet=s' => \$host_intranet,
43 'timeout=i' => \$timeout,
44 'maxconn=i' => \$maxconn,
45 'tags=s{,}' => \@tags,
48 # Validate tags to check
50 my %h = map { $_ => undef } @tags;
54 push @invalids, $_ unless /^\d{3}$/;
57 say "Invalid tag(s): ", join( ' ', @invalids );
60 push @tags, '856' unless @tags;
64 pod2usage( -verbose => 2 );
69 my ( $hdr, $biblionumber, $url ) = @_;
71 ? "<tr>\n <td><a href=\""
75 . "\">$biblionumber</a>"
76 . "</td>\n <td>$url</td>\n <td>"
77 . "$hdr->{Status} $hdr->{Reason}</td>\n</tr>\n"
78 : "$biblionumber\t$url\t" . "$hdr->{Status} $hdr->{Reason}\n";
81 # Check all URLs from all current Koha biblio records
84 my $sth = C4::Context->dbh->prepare(
85 "SELECT biblionumber FROM biblioitems ORDER BY biblionumber");
88 my $count = 0; # Number of requested URL
89 my $cv = AnyEvent->condvar;
90 say "<html>\n<body>\n<div id=\"checkurl\">\n<table>" if $html;
91 my $idle = AnyEvent->timer(
94 return if $count > $maxconn;
95 while ( my ($biblionumber) = $sth->fetchrow ) {
96 my $biblio = Koha::Biblios->find($biblionumber);
97 my $record = $biblio->metadata->record;
99 foreach my $field ( $record->field($tag) ) {
100 my $url = $field->subfield('u');
102 $url = "$host/$url" unless $url =~ /^http/i;
103 $url = encode_utf8($url);
107 headers => { 'user-agent' => $user_agent },
110 my ( undef, $hdr ) = @_;
112 report( $hdr, $biblionumber, $url )
113 if $hdr->{Status} !~ /^2/ || $verbose;
118 return if $count > $maxconn;
126 # Few more time for pending requests
127 $cv = AnyEvent->condvar;
128 my $timer = AnyEvent->timer(
130 interval => $timeout,
131 cb => sub { $cv->send if $count == 0; }
134 say "</table>\n</div>\n</body>\n</html>" if $html;
139 if ( $html && !$host_intranet ) {
141 $host_intranet = $host;
145 "Error: host-intranet parameter or host must be provided in html mode";
154 check-url-quick.pl - Check URLs from biblio records
160 =item check-url-quick [--verbose|--help|--html] [--tags 310 856] [--host=http://default.tld]
163 Scan all URLs found by default in 856$u of bib records and display if resources
164 are available or not. HTTP requests are sent in parallel for efficiency, and
165 speed. This script replaces check-url.pl script.
173 =item B<--host=http://default.tld>
175 Server host used when URL doesn't have one, ie doesn't begin with 'http:'.
176 For example, if --host=http://www.mylib.com, then when 856$u contains
177 'img/image.jpg', the url checked is: http://www.mylib.com/image.jpg'.
181 Tags containing URLs in $u subfields. If not provided, 856 tag is checked. Multiple tags can be specified, for example:
183 check-url-quick.pl --tags 310 410 856
185 =item B<--verbose|-v>
187 Outputs both successful and failed URLs.
191 Formats output in HTML. The result can be redirected to a file
192 accessible by http. This way, it's possible to link directly to biblio
193 record in edit mode. With this parameter B<--host-intranet> is required.
195 =item B<--host-intranet=http://koha-pro.tld>
197 Server host used to link to biblio record editing page in Koha intranet
200 =item B<--timeout=10>
202 Timeout for fetching URLs. By default 10 seconds.
204 =item B<--maxconn=1000>
206 Number of simulaneous HTTP requests. By default 200 connexions.
210 Print this help page.