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

(-)a/misc/cronjobs/checkurl (-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
GetOptions( 
36
    'verbose'       => \$verbose,
37
    'html'          => \$html,
38
    'help'          => \$help,
39
    'host=s'        => \$host,
40
    'host-pro=s'    => \$host_pro,
41
    'timeout=i'     => \$timeout,
42
    'maxconn=i'     => \$maxconn,
43
);
44
45
46
sub usage {
47
    pod2usage( -verbose => 2 );
48
    exit;
49
} 
50
51
52
sub bibediturl {
53
    my $biblionumber = shift;
54
    my $html = "<a href=\"$host_pro$uriedit$biblionumber\">$biblionumber</a>";
55
    return $html;
56
}
57
58
59
# Check all URLs from all current Koha biblio records
60
61
sub check_all_url {
62
    my $sth = C4::Context->dbh->prepare( 
63
        "SELECT biblionumber FROM biblioitems WHERE url <> ''" );
64
    $sth->execute;
65
    if ( $html ) {
66
        print <<EOS;
67
<html>
68
<body>
69
<table>
70
EOS
71
    }
72
73
    my $countconn = 0;
74
    my $cv = AnyEvent->condvar;
75
    my $idle = AnyEvent->idle(
76
        cb => sub {
77
            return if $countconn > $maxconn;
78
            while ( my ($biblionumber) = $sth->fetchrow ) {
79
                my $record = GetMarcBiblio( $biblionumber ); 
80
                next unless $record->field('856');
81
                foreach my $field ( $record->field('856') ) {
82
                    my $url = $field->subfield('u');
83
                    next unless $url; 
84
                    $url = "$host/$url" unless $url =~ /^http/;
85
                    $countconn++;
86
                    http_request(
87
                        HEAD => $url,
88
                        headers => { 'user-agent' => 'Mozilla/5.0 (compatible; U; Koha checkurl)' },
89
                        timeout => $timeout,
90
                        sub {
91
                            my ($body, $hdr) = @_;
92
                            #say "HEAD found $url";
93
                            $countconn--;
94
                            if ( $hdr->{Status} !~ /^2/ || $verbose) { # OK
95
                                print $html
96
                                      ? "<tr>\n<td><a href=\"" .
97
                                        $host_pro . $uriedit . $biblionumber.
98
                                        "\">$biblionumber</a>" .
99
                                        "</td>\n<td>" . $url . "</td>\n<td>" . 
100
                                        "$hdr->{Status} $hdr->{Reason}</td>\n</tr>\n\n"
101
                                      : "$biblionumber\t" . $url . "\t" .
102
                                        "$hdr->{Status} $hdr->{Reason} \n";
103
                            }
104
                        }
105
                    );
106
                }
107
                return;
108
            }
109
            $cv->send;
110
        }
111
    );
112
    $cv->recv;
113
114
    print "</table>\n</body>\n</html>\n" if $html;
115
}
116
117
118
# BEGIN
119
120
usage() if $help;          
121
122
if ( $html && !$host_pro ) {
123
    if ( $host ) {
124
        $host_pro = $host;
125
    }
126
    else {
127
        print "Error: host-pro parameter or host must be provided in html mode\n";
128
        exit;
129
    }
130
}
131
132
check_all_url(); 
133
134
135
=head1 NAME
136
137
checkurl - Check URLs from 856$u field.
138
139
=head1 USAGE
140
141
=over
142
143
=item checkurl [--verbose|--help] [--host=http://default.tld] 
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.
147
148
=back
149
150
=head1 PARAMETERS
151
152
=over
153
154
=item B<--host=http://default.tld>
155
156
Server host used when URL doesn't have one, ie doesn't begin with 'http:'. 
157
For example, if --host=http://www.mylib.com, then when 856$u contains 
158
'img/image.jpg', the url checked is: http://www.mylib.com/image.jpg'.
159
160
=item B<--verbose|-v>
161
162
Outputs both successful and failed URLs.
163
164
=item B<--html>
165
166
Formats output in HTML. The result can be redirected to a file
167
accessible by http. This way, it's possible to link directly to biblio
168
record in edit mode. With this parameter B<--host-pro> is required.
169
170
=item B<--host-pro=http://koha-pro.tld>
171
172
Server host used to link to biblio record editing page.
173
174
=item B<--timeout=10>
175
176
Timeout for fetching URLs. By default 10 seconds.
177
178
=item B<--maxconn=1000>
179
180
Number of simulaneous HTTP requests. By default 200 connexions.
181
182
=item B<--help|-h>
183
184
Print this help page.
185
186
=back
187
188
=cut
189
190

Return to bug 7963