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

(-)a/C4/Installer/PerlDependencies.pm (+10 lines)
Lines 590-595 our $PERL_DEPS = { Link Here
590
        'required' => '1',
590
        'required' => '1',
591
        'min_ver'  => '1.23',
591
        'min_ver'  => '1.23',
592
    },
592
    },
593
    'AnyEvent' => {
594
        'usage'    => 'Command line scripts',
595
        'required' => '0',
596
        'min_ver'  => '5.0',
597
    },
598
    'AnyEvent::HTTP' => {
599
        'usage'    => 'Command line scripts',
600
        'required' => '0',
601
        'min_ver'  => '2.13',
602
    },
593
};
603
};
594
604
595
1;
605
1;
(-)a/misc/cronjobs/check-url-quick.pl (+209 lines)
Line 0 Link Here
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
(-)a/misc/cronjobs/check-url.pl (-1 / +1 lines)
Lines 250-255 check-url.pl - Check URLs from 856$u field. Link Here
250
250
251
Scan all URLs found in 856$u of bib records 
251
Scan all URLs found in 856$u of bib records 
252
and display if resources are available or not.
252
and display if resources are available or not.
253
This script is deprecated. You should rather use check-url-quick.pl.
253
254
254
=back
255
=back
255
256
256
- 

Return to bug 7963