File: vbk.pl

package info (click to toggle)
bookmarker 1.6-4
  • links: PTS
  • area: main
  • in suites: potato
  • size: 580 kB
  • ctags: 260
  • sloc: php: 3,063; sql: 97; sh: 68; perl: 51; makefile: 35; awk: 2; sed: 1
file content (88 lines) | stat: -rw-r--r-- 2,084 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
#!/usr/local/bin/perl -w
#
# bookmarker verification perl script
# see vbk.sh for a handy shell script to run this
# via nohup
#
# make sure and update the database connection
# variables for your installation below.
#
use strict;

# use DBI.pm generic database interface
use DBI;

# use LWP for HTTP automation
use LWP::UserAgent;

# CGI.pm module
# set to -no_debug since we run from command line
# use standard HTML plus HTML 3 additions
# use Pretty formatted HTML so it is readable
# send errors to HTML output
use CGI qw(-no_debug :standard :html3);
use CGI::Pretty;
use CGI::Carp 'fatalsToBrowser';

my $ua = new LWP::UserAgent;
$ua->agent("bookmarker/1.0");
$ua->timeout(20);

my $driver = 'mysql';
my $database = 'db';
my $options = '';
my $user = 'user';
my $password = 'password';

my $title = 'Bookmarker URL Verification Report';

print start_html(-title=>$title,
                   -dtd=>1,
		   -BGCOLOR=>'white');

print h2 ($title);

my $dsn = "DBI:$driver:database=$database;$options";
 
my $dbh = DBI->connect($dsn, $user, $password) || die "Connect Failed: $DBI::errstr \n ";
 
my $sth = $dbh->prepare('select id, url, name from bookmark order by id')  || die "Select Failed: $DBI::errstr \n ";

$sth->execute || die "Execute Failed: $DBI::errstr \n ";

my ($id, $url, $name, $request, $response, $msg, $errs);

my @headings = ('ID','Bookmark', 'Response');
my @rows = th(\@headings);
     
$errs = 0;
while ( ($id, $url, $name) = $sth->fetchrow_array ) {

  $request = new HTTP::Request('HEAD',$url);
  $response = $ua->request($request); # fetch!
      
  if ($response->is_error) {
    $errs += 1;
    $msg = $response->code . ": " . $response->message;
    push(@rows, td([ a({-href=>"maintain.php3?id=$id"},$id)
                    ,a({-href=>$url},$name)
		    ,$msg]
		 ));
  }

}        	     
$sth->finish();
$dbh->disconnect;

if ( $errs > 0 ) {
  print strong ("$errs Failed URL Requests:");
  print table({-border=>'1',-width=>'90%'},
             Tr(\@rows)
             );
} else {
  print strong ('No Failed Requests!');
}

print end_html;

exit 0;