#! /usr/bin/perl -w
# Copyright 2003 Neil Williams
# This file is part of isbnsearch-devel
# isbnsearch-devel is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
# verify.pl = tests each server in @servers in turn
# with a sample query.
# See README for information on preparation and configuration.
use IO::Socket;
use LWP::Simple;
use strict;
use Net::Z3950;
use MARC::Record;
use DBI;
use vars qw( $server $sql $subject $dbh $sth $ref $zq $mgr $conn $rs $index $zrec $mrec $port $fulltitle $shorttitle $publisher $edition $author $publication_date $temp $count $numrec $host $user $password $dbase $z3950 $max $servertable $database $ii $isbn @servers @line $reason $errors $c $d $bug $starttime $endtime @bugstring $timeout @errorstring $serverid $socket $rport $init $endit $colour $timestring );
####################Configuration ###########
$host = '';
$user = '';
$password = '';
$dbase = '';
$servertable = '';
##################End Configuration ##########
$dbh = DBI->connect("DBI:mysql:database=$dbase;host=$host",$user,$password, {'RaiseError'=>0});
$errors = 0;
$bug = 0;
$timeout = 0;
@bugstring = ( 'success', 'unknown error', 'No DNS record - DEAD', 'Failed to initialise Z39.50 - FAIL',
'Z39.50 error - see message', 'Script crash - see mailing list', 'Unable to connect to server - see above',
'Undefined result set', 'Unusable result set - SIRSI? (listed as Pending).', 'Connection request timed out',
'reserved - ask on mailing list', 'Connection refused: ECONNREFUSED' );
@errorstring = ( "OK", "UNK", "DNS", "FAIL", "Z39.50", "CRASH", "CONN", "RS", "ZREC", "TIME", "-", "REFUSE");
#################### Bug Table ###########
# 0 - OK - success
# 1 - UNK - unknown error
# 2 - DNS - No DNS record: DEAD
# 3 - FAIL - Failed to initialise Z39.50
# 4 - Z39.50 - Catch-all for other Z39.50 errors
# 5 - CRASH - Catch-all for script crashes
# 6 - CONN - Unable to connect to server
# 7 - RS - Undefined result set
# 8 - ZREC - Unusable result set (Pending)
# 9 - TIME - Connection request timed out
# 10 - - - reserved
# 11 - REFUSE - Connection refused.
############## end bug table #############
sub colour {
$init = "echo '\033[";
$endit = "\033[0m'";
if($_[1] eq "blue") { $colour = "0;34m"; }
if($_[1] eq "red") { $colour = "0;31m"; }
if($_[1] eq "yellow") { $colour = "1;33m"; }
if($_[1] eq "green") { $colour = "0;32m"; }
if($_[1] eq "cyan") { $colour = "0;36m"; }
if($_[1] eq "purple") { $colour = "0;35m"; }
if($_[1] eq "grey" ) { $colour = "0;37m"; }
system("$init$colour$_[0]$endit");
};
sub report {
$errors++;
$sql = qq/update $servertable set error = "$errorstring[$bug]" where /;
$sql .= "id = $serverid;";
$sth = $dbh->prepare("$sql");
$sth->execute();
print STDERR qq/\n\t\t\t### isbnsearch task report: $errors ###\n/;
print STDERR qq/\t\t\t--- ERROR: $bug $bugstring[$bug] ---\n/;
print STDERR qq/\t\t\tServer details: $database - $server : $port\n/;
print STDERR qq/\t\t\tReason: $reason\n\n/;
};
local $SIG{__WARN__} = sub{ @_ = ''; };
local $SIG{__DIE__} = sub{
@_ = '';
$reason = $!;
my $aa; my $bb; my $cc; my $dd;
$aa=''; $bb=''; $cc=''; $dd='';
my $ip;
if($! =~ /Connection.refused/) { $bug = 11; }
if($! == -1 ) { $bug = 3; }
if($! =~ /Interrupted.system.call/) { $bug = 9; }
if($! =~ /Connection.timed.out/) { $bug = 9; }
if($server !~ /[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}/) {
$ip = gethostbyname("$server");
($aa, $bb, $cc, $dd) = unpack('C4', $ip);
if(!$aa) { $bug = 2; }
}
if(defined($conn)) {
$bug = 4;
my $number = $conn->errcode();
my $msg = $conn->errmsg();
$msg .= "\n";
$msg .= $conn->errop();
$msg .= "\n";
$msg .= $conn->addinfo();
report;
$conn->close();
}
if($bug != 4) { report; }
$! = '';
$bug = 0;
die("\n");
};
$sql = qq/select id,name,port,z3950 from $servertable where error = "?";/;
$sth = $dbh->prepare("$sql");
$sth->execute();
while( $ref = $sth->fetchrow_hashref() ) {
$a = $ref->{'name'};
$b = $ref->{'port'};
$c = $ref->{'z3950'};
$d = $ref->{'id'};
push(@servers, qq/$a $b $c $d/ );
}
$count=@servers;
if($count == 0) {
$sql = qq/select id,name,port,z3950 from $servertable where error = "?";/;
$sth = $dbh->prepare("$sql");
$sth->execute();
while( $ref = $sth->fetchrow_hashref() ) {
$a = $ref->{'name'};
$b = $ref->{'port'};
$c = $ref->{'z3950'};
$d = $ref->{'id'};
push(@servers, qq/$a $b $c $d/ );
}
$count=@servers;
}
print qq#Content-type: text/plain\n\n#;
print qq/Server count: $count\n/;
$mgr = Net::Z3950::Manager->new();
$mgr->option( elementSetName => 'f' );
$mgr->option( preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC );
my $ip; my $aa; my $bb; my $cc; my $dd;
for($ii=0;$ii<$count;$ii++) {
$bug = 5;
$aa=''; $bb=''; $cc=''; $dd='';
@line = split (" ", $servers[$ii]);
$server = $line[0];
$port = $line[1];
$database = $line[2];
$serverid = $line[3];
# timeout is checked later.
# Set reserved error
$sql = qq/update $servertable set error = "$errorstring[10]" where /;
$sql .= "id = $serverid;";
$sth = $dbh->prepare("$sql");
$sth->execute();
$starttime = time();
if($server !~ /[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}/) {
$ip = gethostbyname("$server");
($aa, $bb, $cc, $dd) = unpack('C4', $ip);
if(!$aa) {
colour(qq/No DNS record found\tOmitting $server./, "blue");
$endtime = time();
printf "Time:\t%-1u seconds\n\n", $endtime - $starttime;
$bug = 2;
report;
next;
}
colour(qq/IP:\t$aa.$bb.$cc.$dd/,"yellow");
}
colour(qq/Server:\t$server,\tport:\t$port,\tdatabase:\t$database/,"yellow");
# IO::Socket method
$socket = new IO::Socket::INET(
PeerAddr => $server,
PeerPort => $port,
Proto => 'tcp',
Reuse => 1,
Timeout => '5');
if($socket) {
$ip = $socket->peerhost;
$rport = $socket->peerport;
colour("\tSocket opened successfully on\t$server, $ip \@ $rport.","green");
$socket->close();
}
else {
colour(qq/\tNo socket could be created before the timeout, omitting $server./,"red");
$endtime = time();
# printf "Time:\t%-1u seconds.\n\n", $endtime - $starttime;
$bug = 9;
report;
next;
}
$mgr->option( databaseName => "$database" );
$conn = $mgr->connect("$server", "$port");
if (!defined($conn)) {
colour(qq/\tZ39.50 unable to connect to \t$server @ $port. Omitting $server./,"red");
$endtime = time();
$timestring = sprintf("Time:\t%-1u seconds", $endtime - $starttime);
colour($timestring,"grey");
if($bug == 11) { last; }
$bug = 6;
report;
next;
}
$conn->option(querytype => 'prefix');
colour(qq/\tZ39.50 connected to $server @ $port and $database/,"green");
$rs = $conn->search( '@attr 1=7 1565922867' );
if(!$rs) {
$conn->close();
colour(qq/\tundefined result set.\t$server will be ignored./,"red");
$endtime = time();
$timestring = sprintf "Time:\t%-1u seconds", $endtime - $starttime;
colour($timestring,"grey");
$bug = 7;
report;
next;
}
$numrec = $rs->size();
if(!$numrec) {
$conn->close();
colour("\tZ39.50 connected OK but nothing found:\t$server using $port:$database","green");
$endtime = time();
$timestring = sprintf "Time:\t%-1u seconds", $endtime - $starttime;
colour($timestring,"grey");
$sql = qq/update $servertable set error = "OK" where /;
$sql .= "id = $serverid;";
$sth = $dbh->prepare("$sql");
$sth->execute();
next;
}
$zrec = $rs->record(1);
if(!(defined($zrec))) {
colour(qq/\tUnusable Z39.50 result set\tOmitting $server./,"red");
$endtime = time();
$timestring = sprintf "Time:\t%-1u seconds", $endtime - $starttime;
colour($timestring,"grey");
$bug = 8;
report;
if(defined($conn)) { $conn->close(); }
next;
}
$mrec = MARC::Record->new_from_usmarc($zrec->rawdata());
if(!(defined($mrec))) { $conn->close(); next;}
$isbn = $mrec->subfield("020","a");
if(!(defined($isbn))) { $conn->close(); next;}
$subject = join(' ', $mrec->subfield(650,"a"),
$mrec->subfield(650,"x"),
$mrec->subfield(650,"v"));
$isbn =~ /([0-9]{9,10}[x|X]?)/;
$isbn = uc($1);
if(!(defined($isbn))) { $conn->close(); next;}
$fulltitle = $mrec->title();
$shorttitle = $mrec->title_proper();
$publisher = $mrec->subfield(260,"b");
$edition = $mrec->edition();
$author = $mrec->author()
? $mrec->author()
: $mrec->subfield(245,"c");
$publication_date = $mrec->subfield(260,"c");
print "\tISBN: $isbn $author $shorttitle\n";
print "\t$fulltitle\n\t$publisher $edition $publication_date\n";
$endtime = time();
$timestring = sprintf "Time:\t%-1u seconds", $endtime - $starttime;
colour($timestring,"grey");
$sql = qq/update $servertable set error = "OK" where /;
$sql .= "id = $serverid;";
$sth = $dbh->prepare("$sql");
$sth->execute();
$conn->close();
$numrec=0;
}
if ($numrec) {$conn->close(); }
$sth->finish();
$dbh->disconnect();