misc/cronjobs/check-url-quick.pl

   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
   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.
  11 #
  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.
  16 #
  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>.
  19
  20 use Modern::Perl;
  21 use Pod::Usage;
  22 use Getopt::Long;
  23
  24 use Koha::Script -cron;
  25 use C4::Context;
  26 use C4::Biblio;
  27 use AnyEvent;
  28 use AnyEvent::HTTP;
  29 use Encode;
  30
  31 my ( $verbose, $help, $html ) = ( 0, 0, 0 );
  32 my ( $host,    $host_intranet ) = ( '', '' );
  33 my ( $timeout, $maxconn )       = ( 10, 200 );
  34 my @tags;
  35 my $uriedit    = "/cgi-bin/koha/cataloguing/addbiblio.pl?biblionumber=";
  36 my $user_agent = 'Mozilla/5.0 (compatible; U; Koha checkurl)';
  37 GetOptions(
  38     'verbose'         => \$verbose,
  39     'html'            => \$html,
  40     'h|help'          => \$help,
  41     'host=s'          => \$host,
  42     'host-intranet=s' => \$host_intranet,
  43     'timeout=i'       => \$timeout,
  44     'maxconn=i'       => \$maxconn,
  45     'tags=s{,}'       => \@tags,
  46 );
  47
  48 # Validate tags to check
  49 {
  50     my %h = map { $_ => undef } @tags;
  51     @tags = sort keys %h;
  52     my @invalids;
  53     for (@tags) {
  54         push @invalids, $_ unless /^\d{3}$/;
  55     }
  56     if (@invalids) {
  57         say "Invalid tag(s): ", join( ' ', @invalids );
  58         exit;
  59     }
  60     push @tags, '856' unless @tags;
  61 }
  62
  63 sub usage {
  64     pod2usage( -verbose => 2 );
  65     exit;
  66 }
  67
  68 sub report {
  69     my ( $hdr, $biblionumber, $url ) = @_;
  70     print $html
  71       ? "<tr>\n <td><a href=\""
  72       . $host_intranet
  73       . $uriedit
  74       . $biblionumber
  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";
  79 }
  80
  81 # Check all URLs from all current Koha biblio records
  82
  83 sub check_all_url {
  84     my $sth = C4::Context->dbh->prepare(
  85         "SELECT biblionumber FROM biblioitems ORDER BY biblionumber");
  86     $sth->execute;
  87
  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(
  92         interval => .3,
  93         cb       => sub {
  94             return if $count > $maxconn;
  95             while ( my ($biblionumber) = $sth->fetchrow ) {
  96                 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
  97                 for my $tag (@tags) {
  98                     foreach my $field ( $record->field($tag) ) {
  99                         my $url = $field->subfield('u');
 100                         next unless $url;
 101                         $url = "$host/$url" unless $url =~ /^http/i;
 102                         $url = encode_utf8($url);
 103                         $count++;
 104                         http_request(
 105                             HEAD    => $url,
 106                             headers => { 'user-agent' => $user_agent },
 107                             timeout => $timeout,
 108                             sub {
 109                                 my ( undef, $hdr ) = @_;
 110                                 $count--;
 111                                 report( $hdr, $biblionumber, $url )
 112                                   if $hdr->{Status} !~ /^2/ || $verbose;
 113                             },
 114                         );
 115                     }
 116                 }
 117                 return if $count > $maxconn;
 118             }
 119             $cv->send;
 120         }
 121     );
 122     $cv->recv;
 123     $idle = undef;
 124
 125     # Few more time for pending requests
 126     $cv = AnyEvent->condvar;
 127     my $timer = AnyEvent->timer(
 128         after    => $timeout,
 129         interval => $timeout,
 130         cb       => sub { $cv->send if $count == 0; }
 131     );
 132     $cv->recv;
 133     say "</table>\n</div>\n</body>\n</html>" if $html;
 134 }
 135
 136 usage() if $help;
 137
 138 if ( $html && !$host_intranet ) {
 139     if ($host) {
 140         $host_intranet = $host;
 141     }
 142     else {
 143         say
 144 "Error: host-intranet parameter or host must be provided in html mode";
 145         exit;
 146     }
 147 }
 148
 149 check_all_url();
 150
 151 =head1 NAME
 152
 153 check-url-quick.pl - Check URLs from biblio records
 154
 155 =head1 USAGE
 156
 157 =over
 158
 159 =item check-url-quick [--verbose|--help|--html] [--tags 310 856] [--host=http://default.tld]
 160 [--host-intranet]
 161
 162 Scan all URLs found by default in 856$u of bib records and display if resources
 163 are available or not. HTTP requests are sent in parallel for efficiency, and
 164 speed.  This script replaces check-url.pl script.
 165
 166 =back
 167
 168 =head1 PARAMETERS
 169
 170 =over
 171
 172 =item B<--host=http://default.tld>
 173
 174 Server host used when URL doesn't have one, ie doesn't begin with 'http:'.
 175 For example, if --host=http://www.mylib.com, then when 856$u contains
 176 'img/image.jpg', the url checked is: http://www.mylib.com/image.jpg'.
 177
 178 =item B<--tags>
 179
 180 Tags containing URLs in $u subfields. If not provided, 856 tag is checked. Multiple tags can be specified, for example:
 181
 182  check-url-quick.pl --tags 310 410 856
 183
 184 =item B<--verbose|-v>
 185
 186 Outputs both successful and failed URLs.
 187
 188 =item B<--html>
 189
 190 Formats output in HTML. The result can be redirected to a file
 191 accessible by http. This way, it's possible to link directly to biblio
 192 record in edit mode. With this parameter B<--host-intranet> is required.
 193
 194 =item B<--host-intranet=http://koha-pro.tld>
 195
 196 Server host used to link to biblio record editing page in Koha intranet
 197 interface.
 198
 199 =item B<--timeout=10>
 200
 201 Timeout for fetching URLs. By default 10 seconds.
 202
 203 =item B<--maxconn=1000>
 204
 205 Number of simulaneous HTTP requests. By default 200 connexions.
 206
 207 =item B<--help|-h>
 208
 209 Print this help page.
 210
 211 =back
 212
 213 =cut