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