X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;ds=sidebyside;f=C4%2FZ3950.pm;h=e5130d6df3aa5ed23657a3235b96effb748653cb;hb=e294defc299e97fe5e1ecfdeb648e8f8f080f5f5;hp=a6d2586691f63e69243232144cae9f187a5e288e;hpb=a3c119a3567ccf6d1ec44200465d080a0a7c9b09;p=koha_fer diff --git a/C4/Z3950.pm b/C4/Z3950.pm old mode 100755 new mode 100644 index a6d2586691..e5130d6df3 --- a/C4/Z3950.pm +++ b/C4/Z3950.pm @@ -1,14 +1,12 @@ package C4::Z3950; -# $Id$ # 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. @@ -22,28 +20,34 @@ 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; -#------------------ - -require Exporter; - use vars qw($VERSION @ISA @EXPORT); -# set the version for version checking -$VERSION = 0.01; +BEGIN { + # set the version for version checking + $VERSION = 3.07.00.049; + require Exporter; + @ISA = qw(Exporter); + @EXPORT = qw( + &getz3950servers + &z3950servername + &addz3950queue + &checkz3950searchdone + ); +} =head1 NAME @@ -62,16 +66,6 @@ entering Z39.50 lookup requests. =over 2 -=cut - -@ISA = qw(Exporter); -@EXPORT = qw( - &getz3950servers - &z3950servername - &addz3950queue -); - -#------------------------------------------------ =item getz3950servers @servers= &getz3950servers(checked); @@ -82,6 +76,7 @@ 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; @@ -110,6 +105,7 @@ C<$server_id> is the Z39.50 server ID to look up. C<$dbh> is ignored. =cut + #' sub z3950servername { @@ -165,6 +161,7 @@ C<&addz3950queue> returns an error message. If it was successful, the error message is the empty string. =cut + #' sub addz3950queue { use strict; @@ -198,23 +195,23 @@ sub addz3950queue { 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=$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) = $sth->fetchrow ) { - push @serverlist, "$servername/$host\:$port/$db/$userid/$password"; + 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 from z3950servers where id=? "); + $sth=$dbh->prepare("select host,port,db,userid,password,syntax from z3950servers where id=? "); $sth->execute($server); - my ($host, $port, $db, $userid, $password) = $sth->fetchrow; - push @serverlist, "$server/$host\:$port/$db/$userid/$password"; + my ($host, $port, $db, $userid, $password,$syntax) = $sth->fetchrow; + push @serverlist, "$server/$host\:$port/$db/$userid/$password/$syntax"; } } my $serverlist=''; - $serverlist = join(" ", @serverlist); - 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 @@ -235,7 +232,6 @@ sub addz3950queue { # 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; @@ -266,6 +262,33 @@ sub addz3950queue { } # sub addz3950queue +=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__ @@ -273,58 +296,6 @@ __END__ =head1 AUTHOR -Koha Developement team +Koha Development Team =cut - -#-------------------------------------- -# $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. -# -# Revision 1.6 2002/10/13 08:30:53 arensb -# Deleted unused variables. -# Removed trailing whitespace. -# -# Revision 1.5 2002/10/13 06:13:23 arensb -# Removed bogus #! line (this isn't a script!) -# Removed unused global variables. -# Added POD. -# Added some explanatory comments. -# Added some FIXME comments. -# -# 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 -#