7 # Routines for handling Z39.50 lookups
9 # Koha library project www.koha.org
11 # Licensed under the GPL
14 # Copyright 2000-2002 Katipo Communications
16 # This file is part of Koha.
18 # Koha is free software; you can redistribute it and/or modify it under the
19 # terms of the GNU General Public License as published by the Free Software
20 # Foundation; either version 2 of the License, or (at your option) any later
23 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
24 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
25 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
27 # You should have received a copy of the GNU General Public License along with
28 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
29 # Suite 330, Boston, MA 02111-1307 USA
33 # standard or CPAN modules used
45 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
47 # set the version for version checking
55 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
57 # your exported package globals go here,
58 # as well as any optionally exported functions
60 @EXPORT_OK = qw($Var1 %Hashit);
62 # non-exported package globals go here
63 use vars qw(@more $stuff);
65 # initalize package globals, first exported ones
70 # then the others (which are still accessible as $Some::Module::stuff)
74 # all file-scoped lexicals must be created before
75 # the functions below that use them.
77 # file-private lexicals go here
81 # here's a file-private function as a closure,
82 # callable as &$priv_func; it cannot be prototyped.
87 # make all your functions, whether exported or not;
88 #------------------------------------------------
95 $srvid, # server id number
102 requireDBI($dbh,"z3950servername");
104 my $sti=$dbh->prepare("select name
107 $sti->execute($srvid);
109 ($longname)=$sti->fetchrow;
112 $longname="$default";
115 } # sub z3950servername
117 #---------------------------------------
123 $query, # value to look up
124 $type, # type of value ("isbn", "lccn", etc).
125 $requestid, # Unique value to prevent duplicate searches from multiple HTML form submits
126 @z3950list, # list of z3950 servers to query
139 my $pidfile='/var/log/koha/processz3950queue.pid';
143 requireDBI($dbh,"addz3950queue");
145 # list of servers: entry can be a fully qualified URL-type entry
146 # or simply just a server ID number.
148 foreach $server (@z3950list) {
149 if ($server =~ /:/ ) {
150 push @serverlist, $server;
151 } elsif ($server eq 'DEFAULT' || $server eq 'CHECKED' ) {
152 $sth=$dbh->prepare("select host,port,db,userid,password ,name
154 where checked <> 0 ");
156 while ( my ($host, $port, $db, $userid, $password,$servername)
158 push @serverlist, "$servername/$host\:$port/$db/$userid/$password";
161 $sth=$dbh->prepare("select host,port,db,userid,password
164 $sth->execute($server);
165 my ($host, $port, $db, $userid, $password) = $sth->fetchrow;
166 push @serverlist, "$server/$host\:$port/$db/$userid/$password";
171 foreach (@serverlist) {
176 if ( $serverlist !~ /^ +$/ ) {
177 # Don't allow reinsertion of the same request identifier.
178 $sth=$dbh->prepare("select identifier from z3950queue
179 where identifier=?");
180 $sth->execute($requestid);
182 $sth=$dbh->prepare("insert into z3950queue
183 (term,type,servers, identifier)
184 values (?, ?, ?, ?)");
185 $sth->execute($query, $type, $serverlist, $requestid);
187 my $pid=`cat $pidfile`;
189 my $processcount=kill 1, $pid;
190 if ($processcount==0) {
191 $error.="Z39.50 search daemon error: no process signalled. ";
194 $error.="No Z39.50 search daemon running: no file $pidfile. ";
197 $error.="Duplicate request ID $requestid. ";
200 # server list is empty
201 $error.="No Z39.50 search servers specified. ";
202 } # if serverlist empty
206 } # sub addz3950queue
208 #--------------------------------------
210 # Revision 1.3 2002/08/14 18:12:52 tonnesen
211 # Added copyright statement to all .pl and .pm files
213 # Revision 1.2 2002/07/02 20:31:33 tonnesen
214 # module added from rel-1-2 branch
216 # Revision 1.1.2.5 2002/06/29 17:33:47 amillar
217 # Allow DEFAULT as input to addz3950search.
218 # Check for existence of pid file (cat crashed otherwise).
219 # Return error messages in addz3950search.
221 # Revision 1.1.2.4 2002/06/28 18:07:27 tonnesen
222 # marcimport.pl will print an error message if it can not signal the
223 # processz3950queue program. The message contains instructions for starting the
226 # Revision 1.1.2.3 2002/06/28 17:45:39 tonnesen
227 # z3950queue now listens for a -HUP signal before processing the queue. Z3950.pm
228 # sends the -HUP signal when queries are added to the queue.
230 # Revision 1.1.2.2 2002/06/26 20:54:31 tonnesen
231 # use warnings breaks on perl 5.005...
233 # Revision 1.1.2.1 2002/06/26 07:26:41 amillar
234 # New module for Z39.50 searching