From a3c119a3567ccf6d1ec44200465d080a0a7c9b09 Mon Sep 17 00:00:00 2001 From: tipaul Date: Tue, 29 Apr 2003 08:09:42 +0000 Subject: [PATCH] z3950 support is coming... * adding a syntax column in z3950 table = this column will say wether the z3950 must be called with PerferedRecordsyntax => USMARC or PerferedRecordsyntax => UNIMARC. I tried some french UNIMARC z3950 servers, and some only send USMARC, some only UNIMARC, some can answer with both. Note this is a 1st draft. More to follow (today ? I hope). --- C4/Z3950.pm | 247 +++++++++++++++++++++------------------- updater/updatedatabase | 7 ++ z3950/processz3950queue | 97 ++++++---------- 3 files changed, 174 insertions(+), 177 deletions(-) diff --git a/C4/Z3950.pm b/C4/Z3950.pm index 6185d9fb68..a6d2586691 100755 --- a/C4/Z3950.pm +++ b/C4/Z3950.pm @@ -66,11 +66,37 @@ entering Z39.50 lookup requests. @ISA = qw(Exporter); @EXPORT = qw( - &z3950servername - &addz3950queue + &getz3950servers + &z3950servername + &addz3950queue ); #------------------------------------------------ +=item getz3950servers + + @servers= &getz3950servers(checked); + +Returns the list of declared z3950 servers + +C<$checked> should always be true (1) => returns only active servers. +If 0 => returns all servers + +=cut +sub getz3950servers { + my ($checked) = @_; + my $dbh = C4::Context->dbh; + my $sth; + if ($checked) { + $sth = $dbh->prepare("select * from z3950servers where checked=1"); + } else { + $sth = $dbh->prepare("select * from z3950servers"); + } + my @result; + while ( my ($host, $port, $db, $userid, $password,$servername) = $sth->fetchrow ) { + push @result, "$servername/$host\:$port/$db/$userid/$password"; + } # while + return @result; +} =item z3950servername @@ -87,42 +113,35 @@ C<$dbh> is ignored. #' sub z3950servername { - # inputs - my ( - $srvid, # server id number - $default, - )=@_; - # return - my $longname; - #---- - - $dbh = C4::Context->dbh; - - my $sti=$dbh->prepare(" - select name - from z3950servers - where id=?"); - - $sti->execute($srvid); - if ( ! $sti->err ) { - ($longname)=$sti->fetchrow; - } - if (! $longname) { - $longname="$default"; - } - return $longname; + # inputs + my ($srvid, # server id number + $default,)=@_; + # return + my $longname; + #---- + + my $dbh = C4::Context->dbh; + + my $sti=$dbh->prepare("select name from z3950servers where id=?"); + + $sti->execute($srvid); + if ( ! $sti->err ) { + ($longname)=$sti->fetchrow; + } + if (! $longname) { + $longname="$default"; + } + return $longname; } # sub z3950servername #--------------------------------------- =item addz3950queue - $errmsg = &addz3950queue($dbh, $query, $type, $request_id, @servers); + $errmsg = &addz3950queue($query, $type, $request_id, @servers); Adds a Z39.50 search query for the Z39.50 server to look up. -C<$dbh> is obsolete and is ignored. - C<$query> is the term to search for. C<$type> is the query type, e.g. C, C, etc. @@ -148,63 +167,53 @@ error message is the empty string. =cut #' sub addz3950queue { - use strict; - # input - my ( - $query, # value to look up - $type, # type of value ("isbn", "lccn", etc). - # FIXME - What other values are legal? - $requestid, # Unique value to prevent duplicate searches from multiple HTML form submits - @z3950list, # list of z3950 servers to query - )=@_; - # Returns: - my $error; - - my ( - $sth, - @serverlist, - $server, - $failed, - $servername, - ); - - # FIXME - Should be configurable, probably in /etc/koha.conf. - my $pidfile='/var/log/koha/processz3950queue.pid'; - - $error=""; - - $dbh = C4::Context->dbh; - - # FIXME - Fix indentation - + use strict; + # input + my ( + $query, # value to look up + $type, # type of value ("isbn", "lccn", "title", "author", "keyword") + $requestid, # Unique value to prevent duplicate searches from multiple HTML form submits + @z3950list, # list of z3950 servers to query + )=@_; + # Returns: + my $error; + + my ( + $sth, + @serverlist, + $server, + $failed, + $servername, + ); + + # FIXME - Should be configurable, probably in /etc/koha.conf. + my $pidfile='/var/log/koha/processz3950queue.pid'; + + $error=""; + + my $dbh = C4::Context->dbh; # list of servers: entry can be a fully qualified URL-type entry - # or simply just a server ID number. - - foreach $server (@z3950list) { - if ($server =~ /:/ ) { - push @serverlist, $server; - } elsif ($server eq 'DEFAULT' || $server eq 'CHECKED' ) { - $sth=$dbh->prepare("select host,port,db,userid,password ,name - from z3950servers - where checked <> 0 "); - $sth->execute; - while ( my ($host, $port, $db, $userid, $password,$servername) - = $sth->fetchrow ) { - push @serverlist, "$servername/$host\:$port/$db/$userid/$password"; - } # while - } else { - $sth=$dbh->prepare("select host,port,db,userid,password - from z3950servers - where id=? "); - $sth->execute($server); - my ($host, $port, $db, $userid, $password) = $sth->fetchrow; - push @serverlist, "$server/$host\:$port/$db/$userid/$password"; - } + # or simply just a server ID number. + foreach $server (@z3950list) { + if ($server =~ /:/ ) { + push @serverlist, $server; + } elsif ($server eq 'DEFAULT' || $server eq 'CHECKED' ) { + $sth=$dbh->prepare("select host,port,db,userid,password ,name from z3950servers where checked <> 0 "); + $sth->execute; + while ( my ($host, $port, $db, $userid, $password,$servername) = $sth->fetchrow ) { + push @serverlist, "$servername/$host\:$port/$db/$userid/$password"; + } # while + } else { + $sth=$dbh->prepare("select host,port,db,userid,password from z3950servers where id=? "); + $sth->execute($server); + my ($host, $port, $db, $userid, $password) = $sth->fetchrow; + push @serverlist, "$server/$host\:$port/$db/$userid/$password"; + } } my $serverlist=''; - - $severlist = join(" ", @serverlist); + + $serverlist = join(" ", @serverlist); chop $serverlist; # FIXME - Is this test supposed to test whether @serverlist is @@ -214,44 +223,43 @@ sub addz3950queue { # of one or more spaces, which is never the case, not even # when there are 0 or 1 elements in @serverlist. if ( $serverlist !~ /^ +$/ ) { - # Don't allow reinsertion of the same request identifier. - $sth=$dbh->prepare("select identifier from z3950queue - where identifier=?"); - $sth->execute($requestid); - if ( ! $sth->rows) { - $sth=$dbh->prepare("insert into z3950queue - (term,type,servers, identifier) - values (?, ?, ?, ?)"); - $sth->execute($query, $type, $serverlist, $requestid); - if ( -r $pidfile ) { - # FIXME - Perl is good at opening files. No need to - # spawn a separate 'cat' process. - my $pid=`cat $pidfile`; - chomp $pid; - # Kill -HUP the Z39.50 daemon to tell it to process - # this query. - my $processcount=kill 1, $pid; - if ($processcount==0) { - $error.="Z39.50 search daemon error: no process signalled. "; - } + # Don't allow reinsertion of the same request identifier. + $sth=$dbh->prepare("select identifier from z3950queue + where identifier=?"); + $sth->execute($requestid); + if ( ! $sth->rows) { + $sth=$dbh->prepare("insert into z3950queue (term,type,servers, identifier) values (?, ?, ?, ?)"); + $sth->execute($query, $type, $serverlist, $requestid); + if ( -r $pidfile ) { + # FIXME - Perl is good at opening files. No need to + # spawn a separate 'cat' process. + my $pid=`cat $pidfile`; + chomp $pid; + warn "PID : $pid"; + # Kill -HUP the Z39.50 daemon to tell it to process + # this query. + my $processcount=kill 1, $pid; + if ($processcount==0) { + $error.="Z39.50 search daemon error: no process signalled. "; + } + } else { + # FIXME - Error-checking like this should go close + # to the test. + $error.="No Z39.50 search daemon running: no file $pidfile. "; + } # if $pidfile } else { - # FIXME - Error-checking like this should go close - # to the test. - $error.="No Z39.50 search daemon running: no file $pidfile. "; - } # if $pidfile - } else { - # FIXME - Error-checking like this should go close - # to the test. - $error.="Duplicate request ID $requestid. "; - } # if rows + # FIXME - Error-checking like this should go close + # to the test. + $error.="Duplicate request ID $requestid. "; + } # if rows } else { - # FIXME - Error-checking like this should go close to the - # test. I.e., - # return "No Z39.50 search servers specified. " - # if @serverlist eq (); + # FIXME - Error-checking like this should go close to the + # test. I.e., + # return "No Z39.50 search servers specified. " + # if @serverlist eq (); - # server list is empty - $error.="No Z39.50 search servers specified. "; + # server list is empty + $error.="No Z39.50 search servers specified. "; } # if serverlist empty return $error; @@ -271,6 +279,11 @@ Koha Developement team #-------------------------------------- # $Log$ +# Revision 1.8 2003/04/29 08:09:45 tipaul +# z3950 support is coming... +# * adding a syntax column in z3950 table = this column will say wether the z3950 must be called with PerferedRecordsyntax => USMARC or PerferedRecordsyntax => UNIMARC. I tried some french UNIMARC z3950 servers, and some only send USMARC, some only UNIMARC, some can answer with both. +# Note this is a 1st draft. More to follow (today ? I hope). +# # Revision 1.7 2003/02/19 01:01:06 wolfpac444 # Removed the unecessary $dbh argument from being passed. # Resolved a few minor FIXMEs. diff --git a/updater/updatedatabase b/updater/updatedatabase index 04faef6c06..94acf17081 100755 --- a/updater/updatedatabase +++ b/updater/updatedatabase @@ -232,6 +232,7 @@ my %requirefields=( #added so that reference items are not available for reserves... itemtypes=>{'notforloan' => 'smallint(6)'}, systempreferences =>{'explanation' => 'char(80)'}, + z3950servers =>{'syntax' => 'char(80)'}, ); my %dropable_table=( @@ -281,6 +282,7 @@ my %tabledata=( { uniquefieldrequired => 'variable', variable => 'marcflavour', value => 'MARC21', explanation => 'your MARC flavor (MARC21 or UNIMARC) used for character encoding' }, { uniquefieldrequired => 'variable', variable => 'checkdigit', value => 'katipo', explanation => 'none= no check on member cardnumber. katipo= katipo check' }, { uniquefieldrequired => 'variable', variable => 'dateformat', value => 'ISO', explanation => 'date format (US mm/dd/yyyy, metric dd/mm/yyy, ISO yyyy/mm/dd) ' }, + { uniquefieldrequired => 'variable', variable => 'KohaAdminEmailAddress', value => 'your.mail@here', explanation => 'the email adress where borrowers modifs are sent' }, ], ); @@ -546,6 +548,11 @@ $sth->finish; exit; # $Log$ +# Revision 1.41 2003/04/29 08:09:44 tipaul +# z3950 support is coming... +# * adding a syntax column in z3950 table = this column will say wether the z3950 must be called with PerferedRecordsyntax => USMARC or PerferedRecordsyntax => UNIMARC. I tried some french UNIMARC z3950 servers, and some only send USMARC, some only UNIMARC, some can answer with both. +# Note this is a 1st draft. More to follow (today ? I hope). +# # Revision 1.40 2003/04/22 10:48:27 wolfpac444 # Added "father" column to bibliothesaurus table # diff --git a/z3950/processz3950queue b/z3950/processz3950queue index bb347f85a4..e0953e1e18 100755 --- a/z3950/processz3950queue +++ b/z3950/processz3950queue @@ -4,7 +4,7 @@ use C4::Context; use DBI; -#use strict; +use strict; use C4::Biblio; use C4::Output; use C4::Breeding; @@ -19,7 +19,7 @@ if ($< == 0) { close PID; } # Get real apacheuser from koha.conf or reparsing httpd.conf - my $apacheuser='www-data'; + my $apacheuser='paul'; my $uid=0; unless ($uid = (getpwnam($apacheuser))[2]) { die "Attempt to run daemon as non-existent or superuser\n"; @@ -27,8 +27,6 @@ if ($< == 0) { $>=$uid; $<=$uid; } - - my $dbh = C4::Context->dbh; my $sth=$dbh->prepare("update z3950results set active=0"); @@ -52,15 +50,14 @@ my $lastrun=0; while (1) { if ((time-$lastrun)>5) { print "starting loop\n"; - if ($checkqueue) { - print "checkqueue=1\n"; + if ($checkqueue) { # everytime a SIG{HUP} is recieved $checkqueue=0; my $sth=$dbh->prepare("select id,term,type,servers from z3950queue order by id"); $sth->execute; while (my ($id, $term, $type, $servers) = $sth->fetchrow) { if ($forkcounter<12) { my $now=time(); - $stk=$dbh->prepare("select id,server,startdate,enddate,numrecords,active from z3950results where queryid=$id"); + my $stk=$dbh->prepare("select id,server,startdate,enddate,numrecords,active from z3950results where queryid=$id"); ($stk->execute) || (next); my %serverdone; unless ($stk->rows) { @@ -91,21 +88,20 @@ while (1) { $attr='1=1016'; } $term='"'.$term.'"'; - $query="\@attr $attr $term"; + my $query="\@attr $attr $term"; my $totalrecords=0; my $serverinfo; my $stillprocessing=0; + my $globalname; foreach $serverinfo (split(/\s+/, $servers)) { (next) if ($serverdone{$serverinfo} == 1); my $stillprocessing=1; if (my $pid=fork()) { $forkcounter++; } else { - #$sth->finish; - #$sti->finish; - #$dbh->disconnect; my $dbi = C4::Context->dbh; my ($name, $server, $database, $user, $password) = split(/\//, $serverinfo, 5); + $globalname=$name; $server=~/(.*)\:(\d+)/; my $servername=$1; my $port=$2; @@ -117,14 +113,17 @@ while (1) { my $stj=$dbi->prepare("select id from z3950results where server=$q_serverinfo and queryid=$id"); $stj->execute; ($resultsid) = $stj->fetchrow; + $stj->finish; } else { my $stj=$dbi->prepare("select id from z3950results where server=$q_serverinfo and queryid=$id"); $stj->execute; ($resultsid) = $stj->fetchrow; + $stj->finish; unless ($resultsid) { - my $stj=$dbi->prepare("insert into z3950results (server, queryid, startdate) values ($q_serverinfo, $id, $now)"); + $stj=$dbi->prepare("insert into z3950results (server, queryid, startdate) values ($q_serverinfo, $id, $now)"); $stj->execute; $resultsid=$dbi->{'mysql_insertid'}; + $stj->finish; } } my $stj=$dbh->prepare("update z3950results set active=1 where id=$resultsid"); @@ -148,23 +147,27 @@ while (1) { } } if ($noconnection || $error) { + warn "no connection at $globalname "; } else { - eval { $conn->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC);}; - if ($@) { - print "ERROR: $@\n"; - } else { - print "Q: $query\n"; + eval { $conn->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC);}; + if ($@) { + print "$globalname ERROR: $@\n"; + } else { + print "Q: $query\n"; my $rs=$conn->search($query); - pe(); + pe(); my $numresults=$rs->size(); - pe(); + pe(); my $i; my $result=''; my $scantimerstart=time(); for ($i=1; $i<=(($numresults<80) ? ($numresults) : (80)); $i++) { my $rec=$rs->record($i); - my $marcdata=$rec->rawdata(); + my $marcdata=$rec->render(); + my $marcrecord = MARC::File::USMARC::decode($rec->render()); + warn "$globalname ==> ".$marcrecord->as_formatted(); $result.=$marcdata; + my ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported) = ImportBreeding($marcdata,1,"Z3950-$globalname"); } my $scantimerend=time(); my $numrecords; @@ -172,16 +175,20 @@ while (1) { my $elapsed=$scantimerend-$scantimerstart; if ($elapsed) { my $speed=int($numresults/$elapsed*100)/100; - print " SPEED: $speed $server done $numrecords\n"; + print "$globalname SPEED: $speed $server done $numrecords\n"; } - my $q_result=$dbi->quote($result); ($q_result) || ($q_result='""'); $now=time(); - my $task="update z3950results set numrecords=$numresults,numdownloaded=$numrecords,highestseen=0,results=$q_result,enddate=$now where id=$resultsid"; - my $stj=$dbi->prepare($task); - $stj->execute; - ImportBreeding($q_result,1,"Z3950"); + if ($numresults >0) { + my $task="update z3950results set numrecords=$numresults,numdownloaded=$numrecords,highestseen=0,results=$q_result,enddate=$now where id=$resultsid"; + my $stj=$dbi->prepare($task); + $stj->execute; + } else { # no results... + my $task="update z3950results set numrecords=$numresults,numdownloaded=$numrecords,highestseen=0,results='',enddate=$now where id=$resultsid"; + my $stj=$dbi->prepare($task); + $stj->execute; + } my $counter=0; while ($counter<60 && $numrecords<$numresults) { $counter++; @@ -214,7 +221,7 @@ while (1) { } sleep 5; } - } + } } # FIXME - There's already a $stj in this scope my $stj=$dbi->prepare("update z3950results set active=0 where id=$resultsid"); @@ -223,7 +230,7 @@ while (1) { print " $server done.\n"; exit; sub pe { - return 0; +# return 0; my $code=$conn->errcode(); my $msg=$conn->errmsg(); my $ai=$conn->addinfo(); @@ -232,8 +239,8 @@ CODE: $code MSG: $msg ADDTL: $ai EOF - return 0; - } + return 0; +} } } unless ($stillprocessing) { @@ -251,36 +258,6 @@ EOF } } -# sub getrecord { -# my $server=shift; -# my $base=shift; -# my $query=shift; -# my $auth=shift; -# my $id=shift; -# open (M, "|yaz-client -m yaz-$id.mrc >>yaz.out 2>>yaz.err"); -# select M; -# $|=1; -# select STDOUT; -# ($auth) && ($auth="authentication $auth\n"); -# print M << "EOF"; -# $auth\open $server -# base $base -# setnames -# $query -# s -# s -# s -# s -# s -# s -# s -# s -# s -# s -# quit -# EOF -# close M; -# } sub reap { $forkcounter--; wait; -- 2.39.5