7 # Routines for handling Z39.50 lookups
9 # Koha library project www.koha.org
11 # Licensed under the GPL
15 # standard or CPAN modules used
27 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
29 # set the version for version checking
37 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
39 # your exported package globals go here,
40 # as well as any optionally exported functions
42 @EXPORT_OK = qw($Var1 %Hashit);
44 # non-exported package globals go here
45 use vars qw(@more $stuff);
47 # initalize package globals, first exported ones
52 # then the others (which are still accessible as $Some::Module::stuff)
56 # all file-scoped lexicals must be created before
57 # the functions below that use them.
59 # file-private lexicals go here
63 # here's a file-private function as a closure,
64 # callable as &$priv_func; it cannot be prototyped.
69 # make all your functions, whether exported or not;
70 #------------------------------------------------
77 $srvid, # server id number
84 requireDBI($dbh,"z3950servername");
86 my $sti=$dbh->prepare("select name
89 $sti->execute($srvid);
91 ($longname)=$sti->fetchrow;
97 } # sub z3950servername
99 #---------------------------------------
105 $query, # value to look up
106 $type, # type of value ("isbn", "lccn", etc).
107 $requestid, # Unique value to prevent duplicate searches from multiple HTML form submits
108 @z3950list, # list of z3950 servers to query
121 my $pidfile='/var/log/koha/processz3950queue.pid';
125 requireDBI($dbh,"addz3950queue");
127 # list of servers: entry can be a fully qualified URL-type entry
128 # or simply just a server ID number.
130 foreach $server (@z3950list) {
131 if ($server =~ /:/ ) {
132 push @serverlist, $server;
133 } elsif ($server eq 'DEFAULT' || $server eq 'CHECKED' ) {
134 $sth=$dbh->prepare("select host,port,db,userid,password ,name
136 where checked <> 0 ");
138 while ( my ($host, $port, $db, $userid, $password,$servername)
140 push @serverlist, "$servername/$host\:$port/$db/$userid/$password";
143 $sth=$dbh->prepare("select host,port,db,userid,password
146 $sth->execute($server);
147 my ($host, $port, $db, $userid, $password) = $sth->fetchrow;
148 push @serverlist, "$server/$host\:$port/$db/$userid/$password";
153 foreach (@serverlist) {
158 if ( $serverlist !~ /^ +$/ ) {
159 # Don't allow reinsertion of the same request identifier.
160 $sth=$dbh->prepare("select identifier from z3950queue
161 where identifier=?");
162 $sth->execute($requestid);
164 $sth=$dbh->prepare("insert into z3950queue
165 (term,type,servers, identifier)
166 values (?, ?, ?, ?)");
167 $sth->execute($query, $type, $serverlist, $requestid);
169 my $pid=`cat $pidfile`;
171 my $processcount=kill 1, $pid;
172 if ($processcount==0) {
173 $error.="Z39.50 search daemon error: no process signalled. ";
176 $error.="No Z39.50 search daemon running: no file $pidfile. ";
179 $error.="Duplicate request ID $requestid. ";
182 # server list is empty
183 $error.="No Z39.50 search servers specified. ";
184 } # if serverlist empty
188 } # sub addz3950queue
190 #--------------------------------------
192 # Revision 1.2 2002/07/02 20:31:33 tonnesen
193 # module added from rel-1-2 branch
195 # Revision 1.1.2.5 2002/06/29 17:33:47 amillar
196 # Allow DEFAULT as input to addz3950search.
197 # Check for existence of pid file (cat crashed otherwise).
198 # Return error messages in addz3950search.
200 # Revision 1.1.2.4 2002/06/28 18:07:27 tonnesen
201 # marcimport.pl will print an error message if it can not signal the
202 # processz3950queue program. The message contains instructions for starting the
205 # Revision 1.1.2.3 2002/06/28 17:45:39 tonnesen
206 # z3950queue now listens for a -HUP signal before processing the queue. Z3950.pm
207 # sends the -HUP signal when queries are added to the queue.
209 # Revision 1.1.2.2 2002/06/26 20:54:31 tonnesen
210 # use warnings breaks on perl 5.005...
212 # Revision 1.1.2.1 2002/06/26 07:26:41 amillar
213 # New module for Z39.50 searching