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

(-)a/misc/cronjobs/check-url.pl (-68 / +342 lines)
Lines 1-13 Link Here
1
#!/usr/bin/perl
1
#!/usr/bin/perl
2
2
3
#
3
########################################################################
4
# Copyright 2009 Tamil s.a.r.l.
4
# Copyright 2009 Tamil s.a.r.l.                                        #
5
#
5
#                                                                      #
6
# This software is placed under the gnu General Public License, v2 
6
# This software is placed under the gnu General Public License, v2     #
7
# (http://www.gnu.org/licenses/gpl.html)
7
# (http://www.gnu.org/licenses/gpl.html)                               #
8
#
8
#                                                                      #
9
9
########################################################################
10
10
11
################################################################ 
12
#          C 4   U R L   C h e c k e r   P a c k a g e         #
13
################################################################
11
14
12
package C4::URL::Checker;
15
package C4::URL::Checker;
13
16
Lines 69-75 use LWP::UserAgent; Link Here
69
use HTTP::Request;
72
use HTTP::Request;
70
use C4::Biblio;
73
use C4::Biblio;
71
74
75
my @arrbadurls = ();
76
77
my $cdoubleforward  = '//';
78
my $csingleforward  = '/';
72
79
80
###################################################################
81
#                       A d d   B a d   U R L                     #
82
###################################################################
83
84
sub addbadurl
85
 {
86
  my $strURL = shift;
87
  my $strURLBase;
88
  my $intArraySize;
89
90
  my @arrURLElements = split(/$cdoubleforward/, $strURL);
91
  my @arrURL = split(/$csingleforward/,$arrURLElements[1]);
92
  $strURLBase = $arrURL[0];
93
94
  $intArraySize = @arrbadurls;
95
  $arrbadurls[$intArraySize] = $strURLBase;
96
 }
97
98
###################################################################
99
#                     C h e c k   B a d   U R L                   #
100
###################################################################
101
102
sub checkbadurl
103
 {
104
  my $strURL = shift;
105
  my $strURLBase;
106
  my $intReturnCode = 0;
107
  my $intloopcount = 0;
108
  my $intArraySize = 0;
109
110
  my @arrURLElements = split(/$cdoubleforward/, $strURL);
111
  my @arrURL = split(/$csingleforward/,$arrURLElements[1]);
112
  $strURLBase = $arrURL[0];
113
114
  foreach my $badurl (@arrbadurls)
115
   {
116
    if ($badurl =~ /$strURLBase/)
117
     {
118
      $intReturnCode = 1;
119
      last;
120
     }
121
   }
122
123
  return $intReturnCode;
124
 }
125
126
################################################################ 
127
#                             N e w                            #
128
################################################################
73
129
74
sub new {
130
sub new {
75
131
Lines 77-119 sub new { Link Here
77
    my $class = shift;
133
    my $class = shift;
78
    
134
    
79
    $self->{ user_agent } = new LWP::UserAgent;
135
    $self->{ user_agent } = new LWP::UserAgent;
136
137
80
    
138
    
81
    bless $self, $class;
139
    bless $self, $class;
82
    return $self;
140
    return $self;
83
}
141
}
84
142
143
################################################################ 
144
#                     C h e c k   B i b l i o                  #
145
################################################################
146
147
sub check_biblio
148
 {
149
  my $self            = shift;
150
  my $biblionumber    = shift;
151
  my $uagent          = $self->{ user_agent   };
152
  my $host            = $self->{ host_default };
153
  my $wcallstatus     = '';
154
  my $creturn500      = '500';
155
156
#If you are running a proxy server on the network this may need to be filled in otherwise all you will get from the server in response is 500 errors unable to connect
157
# $uagent->proxy(['http', 'ftp'] => 'http://username:password@proxy.server.address');
158
# $uagent->proxy(http  => 'http://proxy.server.address');
159
160
  my $record = GetMarcBiblio( $biblionumber ); 
161
  return unless $record->field('856');
162
163
  my @urls = ();
164
  foreach my $field ( $record->field('856') )
165
   {
166
    my $url = $field->subfield('u');
167
    next unless $url; 
168
    $url = "$host/$url" unless $url =~ /^http/;
169
    my $check = { url => $url };
170
171
    if (checkbadurl($url))
172
     {
173
      $check->{ is_success } = 0;
174
      $check->{ status } = '500: Site already checked.';
175
     }
176
    else
177
     {
178
      my $req = HTTP::Request->new( GET => $url );
179
      my $res = $uagent->request( $req, sub { die }, 1 );
180
      if ( $res->is_success )
181
       {
182
        $check->{ is_success } = 1;
183
        $check->{ status     } = 'ok';
184
       }
185
      else
186
       {
187
        $wcallstatus = $res->status_line;
188
        if ($wcallstatus =~ /$creturn500/)
189
         {
190
          addbadurl($url);
191
         }
192
        $check->{ is_success } = 0;
193
        $check->{ status     } = $wcallstatus;
194
       }
195
     }
196
197
    push( @urls, $check );       
198
   }
199
  return \@urls;
200
 }
85
201
86
sub check_biblio {
202
################################################################
87
    my $self            = shift;
203
#                    M a i n   P a c k a g e                   #
88
    my $biblionumber    = shift;
204
################################################################
89
    my $uagent          = $self->{ user_agent   };
90
    my $host            = $self->{ host_default };
91
92
    my $record = GetMarcBiblio( $biblionumber ); 
93
    return unless $record->field('856');
94
95
    my @urls = ();
96
    foreach my $field ( $record->field('856') ) {
97
        my $url = $field->subfield('u');
98
        next unless $url; 
99
        $url = "$host/$url" unless $url =~ /^http/;
100
        my $check = { url => $url };
101
        my $req = HTTP::Request->new( GET => $url );
102
        my $res = $uagent->request( $req, sub { die }, 1 );
103
        if ( $res->is_success ) {
104
            $check->{ is_success } = 1;
105
            $check->{ status     } = 'ok';
106
        }
107
        else {
108
            $check->{ is_success } = 0;
109
            $check->{ status     } = $res->status_line;
110
        }
111
        push( @urls, $check );       
112
    }
113
    return \@urls;
114
}
115
116
117
205
118
package Main;
206
package Main;
119
207
Lines 126-132 use Pod::Usage; Link Here
126
use Getopt::Long;
214
use Getopt::Long;
127
use C4::Context;
215
use C4::Context;
128
216
217
my $htmldir     = '';
218
my $htmlfile    = '/check-url.htm';
219
my $OutFileHTML = '';
220
my $wiorec      = '';
221
222
my $wdtsecond = '00';
223
my $wdtminute = '00';
224
my $wdthour = '00';
225
226
my $wdtday = '00';
227
my $wdtmonth = '00';
228
my $wdtyear = '0000';
229
230
my $wdt0day = '00';
231
my $wdt0month = '00';
232
my $wdt4year = '0000';
233
234
my $cOpenRow1 = '<tr bgcolor="#f0f0f0">';
235
my $cOpenRow2 = '<tr bgcolor="#ffffff">';
236
237
my $cOpenCell1 = '<td align="center" style="font-weight:bold;font-size:12pt;color:#000000">';
238
my $cOpenCell2 = '<td align="center" style="font-size:10pt;color:#0000ff">';
239
my $cOpenCell3 = '<td style="font-size:10pt;color:#0000ff">';
240
my $cCloseCell = '</td>';
129
241
242
my $intRemainder = 0;
130
243
131
my $verbose     = 0;
244
my $verbose     = 0;
132
my $help        = 0;
245
my $help        = 0;
Lines 140-145 GetOptions( Link Here
140
    'help'          => \$help,
253
    'help'          => \$help,
141
    'host=s'        => \$host,
254
    'host=s'        => \$host,
142
    'host-pro=s'    => \$host_pro,
255
    'host-pro=s'    => \$host_pro,
256
    'htmldir=s'     => \$htmldir,
143
);
257
);
144
258
145
259
Lines 155-193 sub bibediturl { Link Here
155
    return $html;
269
    return $html;
156
}
270
}
157
271
272
################################################################
273
#       Check all URLs from all current Koha biblio records    #
274
################################################################
158
275
159
# 
276
sub check_all_url
160
# Check all URLs from all current Koha biblio records
277
 {
161
#
278
  my $checker = C4::URL::Checker->new();
162
sub check_all_url {
279
  $checker->{ host_default }  = $host;
163
    my $checker = C4::URL::Checker->new();
164
    $checker->{ host_default }  = $host;
165
    
280
    
166
    my $context = new C4::Context(  );  
281
  my $context = new C4::Context(  );  
167
    my $dbh = $context->dbh;
282
  my $dbh = $context->dbh;
168
    my $sth = $dbh->prepare( 
283
  my $sth = $dbh->prepare( 
169
        "SELECT biblionumber FROM biblioitems WHERE url <> ''" );
284
        "SELECT biblionumber FROM biblioitems WHERE url <> ''" );
170
    $sth->execute;
285
  $sth->execute;
171
    print "<html>\n<body>\n<table>\n" if $html;
286
172
    while ( my ($biblionumber) = $sth->fetchrow ) {
287
  if ($html)
173
        my $result = $checker->check_biblio( $biblionumber );  
288
   {
174
        next unless $result;  # No URL
289
    $wiorec = "<html>\n<body>\n";
175
        foreach my $url ( @$result ) {
290
    $wiorec .= '<h2 align="center">' . 'Check URL Start ' . $wdt0month . '/' . $wdt0day . '/' . $wdt4year . ' ' . $wdthour .
176
            if ( ! $url->{ is_success } || $verbose ) {
291
               ':' . $wdtminute . '</h2>' . "\n";
177
                print $html
292
178
                      ? "<tr>\n<td>" . bibediturl( $biblionumber ) . 
293
    $wiorec .= "<table border=\"1\" link=\"#ff0000\" alink=\"#0000ff\" vlink=\"#0000ff\"> \n";
179
                        "</td>\n<td>" . $url->{url} . "</td>\n<td>" . 
294
    $wiorec .= "<tr>\n";
180
                        $url->{status} . "</td>\n</tr>\n\n"
295
    $wiorec .= $cOpenCell1 . "Biblio" . $cCloseCell . "\n";
181
                      : "$biblionumber\t" . $url->{ url } . "\t" .
296
    $wiorec .= $cOpenCell1 . "URL" . $cCloseCell . "\n";
182
                        $url->{ status } . "\n";
297
    $wiorec .= $cOpenCell1 . "Status" . $cCloseCell . "\n";
183
            }
298
    $wiorec .= "</tr>\n";
184
        }
299
185
    }
300
    if ($htmldir ne '')
186
    print "</table>\n</body>\n</html>\n" if $html;
301
     {
302
      WriteHTMLOutput();
303
     }
304
    else
305
     {
306
      print $wiorec;
307
     }
308
   }
309
310
  my $intLoopCount = 0;
311
312
  while ( my ($biblionumber) = $sth->fetchrow )
313
   {
314
    my $result = $checker->check_biblio( $biblionumber );  
315
    next unless $result;  # No URL
316
317
    foreach my $url ( @$result )
318
     {
319
      if ( ! $url->{ is_success } || $verbose )
320
       {
321
        if ($html)
322
         {
323
          $intRemainder = $intLoopCount % 2;
324
325
          if ($intRemainder > 0)
326
           {
327
            $wiorec = $cOpenRow1 . "\n";
328
           }
329
          else
330
           {
331
            $wiorec = $cOpenRow2 . "\n";
332
           }
333
334
          $wiorec .= $cOpenCell2 . bibediturl( $biblionumber ) . $cCloseCell . "\n";
335
          $wiorec .= $cOpenCell3 . $url->{url} . $cCloseCell . "\n";
336
          $wiorec .= $cOpenCell2 . $url->{status} . $cCloseCell . "\n";
337
          $wiorec .= "</tr>\n\n";
338
339
          if ($htmldir ne '')
340
           {
341
            WriteHTMLOutput();
342
           }
343
          else
344
           {
345
            print $wiorec;
346
           }
347
         }
348
        else
349
         {
350
          print "$biblionumber\t" . $url->{url} . "\t" . $url->{status} . "\n";
351
         }
352
       }
353
     }
354
355
    ++$intLoopCount;
356
357
#    if ($intLoopCount > 40)
358
#     {
359
#      last;
360
#     }
361
362
   }
363
364
  if ($html)
365
   {
366
    setdatetime();
367
    $wiorec = "</table>\n";
368
    $wiorec .= '<h2 align="center">' . 'Check URL End ' . $wdt0month . '/' . $wdt0day . '/' . $wdt4year . '  ' . $wdthour .
369
              ':' . $wdtminute . '</h2>' . "\n";
370
    $wiorec .= "</body>\n</html>\n";
371
372
    if ($htmldir ne '')
373
     {
374
      WriteHTMLOutput();
375
     }
376
    else
377
     {
378
      print $wiorec;
379
     }
380
   }
187
}
381
}
188
382
383
####################################################################
384
#              O p e n   H T M L   O u p u t   F i l e             #
385
####################################################################
386
387
sub OpenHTMLOutput
388
 {
389
  if (open(HTMLOutput, ">$OutFileHTML"))
390
   {
391
   }
392
  else
393
   { 
394
    print "Error: Unable to open output file: $OutFileHTML\n";
395
    exit;
396
   } 
397
 }
398
399
###################################################################
400
#                W r i t e   H T M L    R e c o r d               #
401
###################################################################
402
403
sub WriteHTMLOutput
404
 {
405
  print HTMLOutput ($wiorec);
406
 }
407
408
###################################################################
409
#                    C l o s e   H T M L    F i l e               #
410
###################################################################
411
412
sub CloseHTMLOutput
413
 {
414
  close (HTMLOutput);
415
 }
416
417
##################################################################
418
#                     S e t   D a t e - T i m e                  #
419
##################################################################
420
421
sub setdatetime
422
 {
423
  my @tbldttim = localtime(time);
189
424
190
# BEGIN
425
  $wdtsecond = $tbldttim[0];
426
  $wdtminute = $tbldttim[1];
427
  $wdthour = $tbldttim[2];
428
429
  $wdtday = $tbldttim[3];                    # Day 1, 2, 3.....
430
  $wdtmonth = $tbldttim[4] + 1;              # Month 1, 2, 3....
431
  $wdtyear = $tbldttim[5] + 1900;            # Year 2000, 2001, 2003......
432
433
  $wdt0day = $tbldttim[3];                   # Day 01, 02, 03, ....
434
  $wdt0month = $tbldttim[4] + 1;             # Month 01, 02, 03....
435
  $wdt4year = $tbldttim[5] + 1900;           # Year 2000, 2001, 2003......
436
437
  if ($wdtminute < 10)
438
   {
439
    $wdtminute = '0' . $tbldttim[1];
440
   }
441
442
  if ($wdtday < 10)
443
   {
444
    $wdt0day = '0' . $wdtday;
445
   }
446
447
  if ($wdtmonth < 10)
448
   {
449
   $wdt0month = '0' . $wdtmonth;
450
   }
451
 }
452
453
################################################################ 
454
#                           B e g i n                          #
455
################################################################
191
456
192
usage() if $help;          
457
usage() if $help;          
193
458
Lines 201-209 if ( $html && !$host_pro ) { Link Here
201
    }
466
    }
202
}
467
}
203
468
204
check_all_url(); 
469
if ($html && $htmldir ne '')
470
 {
471
  $OutFileHTML = $htmldir . $htmlfile;
472
  OpenHTMLOutput();
473
 }
205
474
475
setdatetime();
476
check_all_url(); 
206
477
478
if ($html && $htmldir ne '')
479
 {
480
  CloseHTMLOutput();
481
 }
207
482
208
=head1 NAME
483
=head1 NAME
209
484
210
- 

Return to bug 2959