#! /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();