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 #------------------------------------------------
94 $dbh, # FIXME - Unused argument
95 $srvid, # server id number
102 $dbh = C4::Context->dbh;
104 # FIXME - Fix indentation
105 my $sti=$dbh->prepare("select name
108 $sti->execute($srvid);
110 ($longname)=$sti->fetchrow;
113 $longname="$default";
116 } # sub z3950servername
118 #---------------------------------------
124 # FIXME - Unused argument
125 $query, # value to look up
126 $type, # type of value ("isbn", "lccn", etc).
127 $requestid, # Unique value to prevent duplicate searches from multiple HTML form submits
128 @z3950list, # list of z3950 servers to query
141 my $pidfile='/var/log/koha/processz3950queue.pid';
145 $dbh = C4::Context->dbh;
147 # FIXME - Fix indentation
149 # list of servers: entry can be a fully qualified URL-type entry
150 # or simply just a server ID number.
152 foreach $server (@z3950list) {
153 if ($server =~ /:/ ) {
154 push @serverlist, $server;
155 } elsif ($server eq 'DEFAULT' || $server eq 'CHECKED' ) {
156 $sth=$dbh->prepare("select host,port,db,userid,password ,name
158 where checked <> 0 ");
160 while ( my ($host, $port, $db, $userid, $password,$servername)
162 push @serverlist, "$servername/$host\:$port/$db/$userid/$password";
165 $sth=$dbh->prepare("select host,port,db,userid,password
168 $sth->execute($server);
169 my ($host, $port, $db, $userid, $password) = $sth->fetchrow;
170 push @serverlist, "$server/$host\:$port/$db/$userid/$password";
175 foreach (@serverlist) {
180 if ( $serverlist !~ /^ +$/ ) {
181 # Don't allow reinsertion of the same request identifier.
182 $sth=$dbh->prepare("select identifier from z3950queue
183 where identifier=?");
184 $sth->execute($requestid);
186 $sth=$dbh->prepare("insert into z3950queue
187 (term,type,servers, identifier)
188 values (?, ?, ?, ?)");
189 $sth->execute($query, $type, $serverlist, $requestid);
191 my $pid=`cat $pidfile`;
193 my $processcount=kill 1, $pid;
194 if ($processcount==0) {
195 $error.="Z39.50 search daemon error: no process signalled. ";
198 $error.="No Z39.50 search daemon running: no file $pidfile. ";
201 $error.="Duplicate request ID $requestid. ";
204 # server list is empty
205 $error.="No Z39.50 search servers specified. ";
206 } # if serverlist empty
210 } # sub addz3950queue
212 #--------------------------------------
214 # Revision 1.4 2002/10/11 12:35:35 arensb
215 # Replaced &requireDBI with C4::Context->dbh
217 # Revision 1.3 2002/08/14 18:12:52 tonnesen
218 # Added copyright statement to all .pl and .pm files
220 # Revision 1.2 2002/07/02 20:31:33 tonnesen
221 # module added from rel-1-2 branch
223 # Revision 1.1.2.5 2002/06/29 17:33:47 amillar
224 # Allow DEFAULT as input to addz3950search.
225 # Check for existence of pid file (cat crashed otherwise).
226 # Return error messages in addz3950search.
228 # Revision 1.1.2.4 2002/06/28 18:07:27 tonnesen
229 # marcimport.pl will print an error message if it can not signal the
230 # processz3950queue program. The message contains instructions for starting the
233 # Revision 1.1.2.3 2002/06/28 17:45:39 tonnesen
234 # z3950queue now listens for a -HUP signal before processing the queue. Z3950.pm
235 # sends the -HUP signal when queries are added to the queue.
237 # Revision 1.1.2.2 2002/06/26 20:54:31 tonnesen
238 # use warnings breaks on perl 5.005...
240 # Revision 1.1.2.1 2002/06/26 07:26:41 amillar
241 # New module for Z39.50 searching