X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FZ3950.pm;h=e1cb86ab64363d7c2d422ae4784276a506bf41d1;hb=b96c8b7ffa265251db3c0402adbfd68ec499cad9;hp=7b13e6f03b155902f6dfcc9689ec968be50f6c1b;hpb=81ec28f1272f036d3bd0290c024f125adc8bd24b;p=koha_gimpoz diff --git a/C4/Z3950.pm b/C4/Z3950.pm old mode 100755 new mode 100644 index 7b13e6f03b..e1cb86ab64 --- a/C4/Z3950.pm +++ b/C4/Z3950.pm @@ -1,16 +1,12 @@ -#!/usr/bin/perl +package C4::Z3950; -# $Id$ - -package C4::Z3950; # Routines for handling Z39.50 lookups -# Koha library project www.koha.org +# Koha library project www.koha-community.org # Licensed under the GPL - # Copyright 2000-2002 Katipo Communications # # This file is part of Koha. @@ -24,219 +20,282 @@ package C4::Z3950; # 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 -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use strict; +#use warnings; FIXME - Bug 2505 # standard or CPAN modules used use DBI; # Koha modules used -use C4::Database; use C4::Input; use C4::Biblio; -#------------------ +use vars qw($VERSION @ISA @EXPORT); + +BEGIN { + # set the version for version checking + $VERSION = 3.01; + require Exporter; + @ISA = qw(Exporter); + @EXPORT = qw( + &getz3950servers + &z3950servername + &addz3950queue + &checkz3950searchdone + ); +} + +=head1 NAME -require Exporter; +C4::Z3950 - Functions dealing with Z39.50 queries -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); +=head1 SYNOPSIS -# set the version for version checking -$VERSION = 0.01; + use C4::Z3950; -@ISA = qw(Exporter); -@EXPORT = qw( - &z3950servername - &addz3950queue -); -%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], +=head1 DESCRIPTION -# your exported package globals go here, -# as well as any optionally exported functions +This module contains functions for looking up Z39.50 servers, and for +entering Z39.50 lookup requests. -@EXPORT_OK = qw($Var1 %Hashit); +=head1 FUNCTIONS -# non-exported package globals go here -use vars qw(@more $stuff); +=over 2 -# initalize package globals, first exported ones +=item getz3950servers -my $Var1 = ''; -my %Hashit = (); + @servers= &getz3950servers(checked); -# then the others (which are still accessible as $Some::Module::stuff) -my $stuff = ''; -my @more = (); +Returns the list of declared z3950 servers -# all file-scoped lexicals must be created before -# the functions below that use them. +C<$checked> should always be true (1) => returns only active servers. +If 0 => returns all servers -# file-private lexicals go here -my $priv_var = ''; -my %secret_hash = (); +=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; +} -# here's a file-private function as a closure, -# callable as &$priv_func; it cannot be prototyped. -my $priv_func = sub { - # stuff goes here. - }; - -# make all your functions, whether exported or not; -#------------------------------------------------ +=item z3950servername + $name = &z3950servername($dbh, $server_id, $default_name); + +Looks up a Z39.50 server by ID number, and returns its full name. If +the server is not found, returns C<$default_name>. + +C<$server_id> is the Z39.50 server ID to look up. + +C<$dbh> is ignored. + +=cut + +#' sub z3950servername { - # inputs - my ( - $dbh, # FIXME - Unused argument - $srvid, # server id number - $default, - )=@_; - # return - my $longname; - #---- - - $dbh = C4::Context->dbh; - - # FIXME - Fix indentation - my $sti=$dbh->prepare("select name - from z3950servers - where id=?"); + # 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; + ($longname)=$sti->fetchrow; } if (! $longname) { - $longname="$default"; + $longname="$default"; } - return $longname; + return $longname; } # sub z3950servername #--------------------------------------- -sub addz3950queue { - use strict; - # input - my ( - $dbh, # DBI handle - # FIXME - Unused argument - $query, # value to look up - $type, # type of value ("isbn", "lccn", etc). - $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, - ); - - my $pidfile='/var/log/koha/processz3950queue.pid'; - - $error=""; - - $dbh = C4::Context->dbh; - - # FIXME - Fix indentation +=item addz3950queue + + $errmsg = &addz3950queue($query, $type, $request_id, @servers); + +Adds a Z39.50 search query for the Z39.50 server to look up. + +C<$query> is the term to search for. + +C<$type> is the query type, e.g. C, C, etc. + +C<$request_id> is a unique string that will identify this query. + +C<@servers> is a list of servers to query (obviously, this can be +given either as an array, or as a list of scalars). Each element may +be either a Z39.50 server ID from the z3950server table of the Koha +database, the string C or C, or a complete server +specification containing a colon. + +C and C are synonymous, and refer to those servers +in the z3950servers table whose 'checked' field is set and non-NULL. + +Once the query has been submitted to the Z39.50 daemon, +C<&addz3950queue> sends a SIGHUP to the daemon to tell it to process +this new request. + +C<&addz3950queue> returns an error message. If it was successful, the +error message is the empty string. + +=cut + +#' +sub addz3950queue { + 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,syntax from z3950servers where checked <> 0 "); + $sth->execute; + while ( my ($host, $port, $db, $userid, $password,$servername,$syntax) = $sth->fetchrow ) { + push @serverlist, "$servername/$host\:$port/$db/$userid/$password/$syntax"; + } # while + } else { + $sth=$dbh->prepare("select host,port,db,userid,password,syntax from z3950servers where id=? "); + $sth->execute($server); + my ($host, $port, $db, $userid, $password,$syntax) = $sth->fetchrow; + push @serverlist, "$server/$host\:$port/$db/$userid/$password/$syntax"; + } } my $serverlist=''; - foreach (@serverlist) { - $serverlist.="$_ "; - } # foreach - chop $serverlist; + $serverlist = join("|", @serverlist); +# chop $serverlist; + + # FIXME - Is this test supposed to test whether @serverlist is + # empty? If so, then a) there are better ways to do that in + # Perl (e.g., "if (@serverlist eq ())"), and b) it doesn't + # work anyway, since it checks whether $serverlist is composed + # 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 ) { - my $pid=`cat $pidfile`; - chomp $pid; - 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; + # 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 { - $error.="No Z39.50 search daemon running: no file $pidfile. "; - } # if $pidfile - } else { - $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 { - # server list is empty - $error.="No Z39.50 search servers specified. "; + # 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. "; } # if serverlist empty - + return $error; } # sub addz3950queue -#-------------------------------------- -# $Log$ -# Revision 1.4 2002/10/11 12:35:35 arensb -# Replaced &requireDBI with C4::Context->dbh -# -# Revision 1.3 2002/08/14 18:12:52 tonnesen -# Added copyright statement to all .pl and .pm files -# -# Revision 1.2 2002/07/02 20:31:33 tonnesen -# module added from rel-1-2 branch -# -# Revision 1.1.2.5 2002/06/29 17:33:47 amillar -# Allow DEFAULT as input to addz3950search. -# Check for existence of pid file (cat crashed otherwise). -# Return error messages in addz3950search. -# -# Revision 1.1.2.4 2002/06/28 18:07:27 tonnesen -# marcimport.pl will print an error message if it can not signal the -# processz3950queue program. The message contains instructions for starting the -# daemon. -# -# Revision 1.1.2.3 2002/06/28 17:45:39 tonnesen -# z3950queue now listens for a -HUP signal before processing the queue. Z3950.pm -# sends the -HUP signal when queries are added to the queue. -# -# Revision 1.1.2.2 2002/06/26 20:54:31 tonnesen -# use warnings breaks on perl 5.005... -# -# Revision 1.1.2.1 2002/06/26 07:26:41 amillar -# New module for Z39.50 searching -# +=item &checkz3950searchdone + + $numberpending= & &checkz3950searchdone($random); + +Returns the number of pending z3950 requests + +C<$random> is the random z3950 query number. + +=cut + +sub checkz3950searchdone { + my ($z3950random) = @_; + my $dbh = C4::Context->dbh; + # first, check that the deamon already created the requests... + my $sth = $dbh->prepare("select count(*) from z3950queue,z3950results where z3950queue.id = z3950results.queryid and z3950queue.identifier=?"); + $sth->execute($z3950random); + my ($result) = $sth->fetchrow; + if ($result eq 0) { # search not yet begun => should be searches to do ! + return "??"; + } + # second, count pending requests + $sth = $dbh->prepare("select count(*) from z3950queue,z3950results where z3950queue.id = z3950results.queryid and z3950results.enddate is null and z3950queue.identifier=?"); + $sth->execute($z3950random); + ($result) = $sth->fetchrow; + return $result; +} + +1; +__END__ + +=back + +=head1 AUTHOR + +Koha Development Team + +=cut