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

(-)a/misc/cronjobs/check-url.pl (-302 lines)
Lines 1-301 Link Here
1
#!/usr/bin/perl
2
3
#
4
# Copyright 2009 Tamil s.a.r.l.
5
#
6
# This file is part of Koha.
7
#
8
# Koha is free software; you can redistribute it and/or modify it
9
# under the terms of the GNU General Public License as published by
10
# the Free Software Foundation; either version 3 of the License, or
11
# (at your option) any later version.
12
#
13
# Koha is distributed in the hope that it will be useful, but
14
# WITHOUT ANY WARRANTY; without even the implied warranty of
15
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16
# GNU General Public License for more details.
17
#
18
# You should have received a copy of the GNU General Public License
19
# along with Koha; if not, see <http://www.gnu.org/licenses>.
20
21
22
23
package C4::URL::Checker;
24
25
=head1 NAME 
26
27
C4::URL::Checker - base object for checking URL stored in Koha DB
28
29
=head1 SYNOPSIS
30
31
 use C4::URL::Checker;
32
33
 my $checker = C4::URL::Checker->new( );
34
 $checker->{ host_default } = 'http://mylib.kohalibrary.com';
35
 my $checked_urls = $checker->check_biblio( 123 );
36
 foreach my $url ( @$checked_urls ) {
37
     print "url:        ", $url->{ url        }, "\n",
38
           "is_success: ", $url->{ is_success }, "\n",
39
           "status:     ", $url->{ status     }, "\n";
40
 }
41
42
=head1 FUNCTIONS
43
44
=head2 new
45
46
Create a URL Checker. The returned object can be used to set
47
default host variable :
48
49
 my $checker = C4::URL::Checker->new( );
50
 $checker->{ host_default } = 'http://mylib.kohalibrary.com';
51
52
=head2 check_biblio
53
54
Check all URL from a biblio record. Returns a pointer to an array
55
containing all URLs with checking for each of them.
56
57
 my $checked_urls = $checker->check_biblio( 123 );
58
59
With 2 URLs, the returned array will look like that:
60
61
  [
62
    {
63
      'url' => 'http://mylib.tamil.fr/img/62265_0055B.JPG',
64
      'is_success' => 1,
65
      'status' => 'ok'
66
    },
67
    {
68
      'url' => 'http://mylib.tamil.fr//img/62265_0055C.JPG',
69
      'is_success' => 0,
70
      'status' => '404 - Page not found'
71
    }
72
  ],
73
  
74
75
=cut
76
77
use strict;
78
use warnings;
79
use LWP::UserAgent;
80
use HTTP::Request;
81
use Koha::Script -cron;
82
use C4::Biblio;
83
84
85
86
sub new {
87
88
    my $self = {};
89
    my ($class, $timeout, $agent) = @_;
90
    
91
    my $uagent = LWP::UserAgent->new;
92
    $uagent->agent( $agent ) if $agent;
93
    $uagent->timeout( $timeout) if $timeout;
94
    $self->{ user_agent } = $uagent;
95
    $self->{ bad_url    } = { };
96
    
97
    bless $self, $class;
98
    return $self;
99
}
100
101
102
sub check_biblio {
103
    my $self            = shift;
104
    my $biblionumber    = shift;
105
    my $uagent          = $self->{ user_agent   };
106
    my $host            = $self->{ host_default };
107
    my $bad_url         = $self->{ bad_url      };
108
109
    my $record = GetMarcBiblio({ biblionumber => $biblionumber });
110
    return unless $record->field('856');
111
112
    my @urls = ();
113
    foreach my $field ( $record->field('856') ) {
114
        my $url = $field->subfield('u');
115
        next unless $url; 
116
        $url = "$host/$url" unless $url =~ /^http/;
117
        my $check = { url => $url };
118
        if ( $bad_url->{ $url } ) {
119
            $check->{ is_success } = 1;
120
            $check->{ status     } = '500 Site already checked';
121
        }
122
        else {
123
            my $req = HTTP::Request->new( GET => $url );
124
            my $res = $uagent->request( $req, sub { die }, 1 );
125
            if ( $res->is_success ) {
126
                $check->{ is_success } = 1;
127
                $check->{ status     } = 'ok';
128
            }
129
            else {
130
                $check->{ is_success } = 0;
131
                $check->{ status     } = $res->status_line;
132
                $bad_url->{ $url     } = 1;
133
            }
134
        }
135
        push @urls, $check;
136
    }
137
    return \@urls;
138
}
139
140
141
142
package Main;
143
144
use strict;
145
use warnings;
146
use diagnostics;
147
use Carp;
148
149
use Pod::Usage;
150
use Getopt::Long;
151
use Koha::Script -cron;
152
use C4::Context;
153
154
155
156
my $verbose     = 0;
157
my $help        = 0;
158
my $host        = '';
159
my $host_pro    = '';
160
my $html        = 0;
161
my $uriedit     = "/cgi-bin/koha/cataloguing/addbiblio.pl?biblionumber=";
162
my $agent       = '';
163
my $timeout     = 15;
164
GetOptions( 
165
    'verbose'       => \$verbose,
166
    'html'          => \$html,
167
    'help'          => \$help,
168
    'host=s'        => \$host,
169
    'host-pro=s'    => \$host_pro,
170
    'agent=s'       => \$agent,
171
    'timeout=i',    => \$timeout,
172
);
173
174
175
sub usage {
176
    pod2usage( -verbose => 2 );
177
    exit;
178
} 
179
180
181
sub bibediturl {
182
    my $biblionumber = shift;
183
    my $html = "<a href=\"$host_pro$uriedit$biblionumber\">$biblionumber</a>";
184
    return $html;
185
}
186
187
188
# 
189
# Check all URLs from all current Koha biblio records
190
#
191
sub check_all_url {
192
    my $checker = C4::URL::Checker->new($timeout,$agent);
193
    $checker->{ host_default }  = $host;
194
    
195
    my $context = C4::Context->new(  );
196
    my $dbh = $context->dbh;
197
    my $sth = $dbh->prepare( 
198
        "SELECT biblionumber FROM biblioitems WHERE url <> ''" );
199
    $sth->execute;
200
    if ( $html ) {
201
        print <<EOS;
202
<html>
203
<body>
204
<table>
205
EOS
206
    }
207
    while ( my ($biblionumber) = $sth->fetchrow ) {
208
        my $result = $checker->check_biblio( $biblionumber );  
209
        next unless $result;  # No URL
210
        foreach my $url ( @$result ) {
211
            if ( ! $url->{ is_success } || $verbose ) {
212
                print $html
213
                      ? "<tr>\n<td>" . bibediturl( $biblionumber ) . 
214
                        "</td>\n<td>" . $url->{url} . "</td>\n<td>" . 
215
                        $url->{status} . "</td>\n</tr>\n\n"
216
                      : "$biblionumber\t" . $url->{ url } . "\t" .
217
                        $url->{ status } . "\n";
218
            }
219
        }
220
    }
221
    print "</table>\n</body>\n</html>\n" if $html;
222
}
223
224
225
# BEGIN
226
227
usage() if $help;          
228
229
if ( $html && !$host_pro ) {
230
    if ( $host ) {
231
        $host_pro = $host;
232
    }
233
    else {
234
        print "Error: host-pro parameter or host must be provided in html mode\n";
235
        exit;
236
    }
237
}
238
239
check_all_url(); 
240
241
242
243
=head1 NAME
244
245
check-url.pl - Check URLs from 856$u field.
246
247
=head1 USAGE
248
249
=over
250
251
=item check-url.pl [--verbose|--help] [--agent=agent-string] [--host=http://default.tld]
252
253
Scan all URLs found in 856$u of bib records 
254
and display if resources are available or not.
255
This script is deprecated. You should rather use check-url-quick.pl.
256
257
=back
258
259
=head1 PARAMETERS
260
261
=over
262
263
=item B<--host=http://default.tld>
264
265
Server host used when URL doesn't have one, ie doesn't begin with 'http:'. 
266
For example, if --host=http://www.mylib.com, then when 856$u contains 
267
'img/image.jpg', the url checked is: http://www.mylib.com/image.jpg'.
268
269
=item B<--verbose|-v>
270
271
Outputs both successful and failed URLs.
272
273
=item B<--html>
274
275
Formats output in HTML. The result can be redirected to a file
276
accessible by http. This way, it's possible to link directly to biblio
277
record in edit mode. With this parameter B<--host-pro> is required.
278
279
=item B<--host-pro=http://koha-pro.tld>
280
281
Server host used to link to biblio record editing page.
282
283
=item B<--agent=agent-string>
284
285
Change default libwww user-agent string to custom.  Some sites do
286
not like libwww user-agent and return false 40x failure codes,
287
so this allows Koha to report itself as Koha, or a browser.
288
289
=item B<--timeout=15>
290
291
Timeout for fetching URLs. By default 15 seconds.
292
293
=item B<--help|-h>
294
295
Print this help page.
296
297
=back
298
299
=cut
300
301
302
- 

Return to bug 27563