module added from rel-1-2 branch

diff --git a/C4/Z3950.pm b/C4/Z3950.pm
new file mode 100755 (executable)
index 0000000..0c7123f
--- /dev/null
+++ b/C4/Z3950.pm
@@ -0,0 +1,214 @@
+#!/usr/bin/perl
+
+# $Id$
+
+package C4::Z3950; 
+
+# Routines for handling Z39.50 lookups
+
+# Koha library project  www.koha.org
+
+# Licensed under the GPL
+
+use strict;
+
+# 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 @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(
+        &z3950servername 
+        &addz3950queue 
+);
+%EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
+
+# your exported package globals go here,
+# as well as any optionally exported functions
+
+@EXPORT_OK   = qw($Var1 %Hashit);
+
+# non-exported package globals go here
+use vars qw(@more $stuff);
+
+# initalize package globals, first exported ones
+
+my $Var1   = '';
+my %Hashit = ();
+
+# then the others (which are still accessible as $Some::Module::stuff)
+my $stuff  = '';
+my @more   = ();
+
+# all file-scoped lexicals must be created before
+# the functions below that use them.
+
+# file-private lexicals go here
+my $priv_var    = '';
+my %secret_hash = ();
+
+# 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;
+#------------------------------------------------
+
+
+sub z3950servername {
+    # inputs
+    my (
+       $dbh,
+       $srvid,         # server id number 
+       $default,
+    )=@_;
+    # return
+    my $longname;
+    #----
+
+    requireDBI($dbh,"z3950servername");
+
+       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
+
+#---------------------------------------
+sub addz3950queue {
+    use strict;
+    # input
+    my (
+       $dbh,           # DBI handle
+       $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="";
+
+    requireDBI($dbh,"addz3950queue");
+
+       # 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";
+           }
+       }
+
+       my $serverlist='';
+       foreach (@serverlist) {
+           $serverlist.="$_ ";
+       } # foreach
+       chop $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. ";
+                   }
+               } else {
+                   $error.="No Z39.50 search daemon running: no file $pidfile. ";
+               } # if $pidfile
+           } else {
+               $error.="Duplicate request ID $requestid. ";
+           } # if rows
+       } else {
+           # server list is empty
+           $error.="No Z39.50 search servers specified. ";
+       } # if serverlist empty
+       
+       return $error;
+
+} # sub addz3950queue
+
+#--------------------------------------
+# $Log$
+# 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
+#