15 processz3950queue. The script that does z3950 searches.
19 This script can be used on a console (as normal user) or by the daemon-launch script.
21 Don't forget to EXPORT PERL5LIB=/PATH/to/KOHA before executing it if you use console mode.
24 1- extracts z3950 requests from z3950queue table,
25 2- creates entries in z3950results to store the result
26 3- launch z3950 queries in asynchronous mode, using Unix fork()
27 4- store results in marc_breeding table.
29 The z3950 results queries are managed in z3950/search.pl script (poped-up window in MARC editor).
33 =head2 table z3950servers
35 This table stores the differents z3950 servers.
36 A server is used if checked=1. The rank is NOT used as searches are now asynchronous.
38 =head2 table z3950queue
40 Table use to manage queries. A single line is created in this table for each z3950 search request.
41 If more than 1 server is called, the C<servers> field containt all of them separated by |.
43 z3950 search requests are done by z3950/search.pl script.
44 At this stage, the fields are created with C<startdate> and C<done> empty
46 Then, the processz3950queue finds this entry and :
47 1- store date (time()) in C<startdate>
50 when the requests are all sent :
52 3- set C<enddate> (FIXME: always equal to startdate for me)
54 entries are deleted when :
55 - C<startdate> is more than 1 day ago.
58 - results, numrecords fields are unused
60 =head2 table z3950results
62 1 entry is created for each request, for each server called.
64 * C<startdate> is filled
66 * active is set to 0. when active is 0, it means the request has not been sent. when set to 1, it means it's on the way.
68 When a search is ended, C<enddate> is set, and C<active> is set to -1
70 =head1 How it's written
74 * for each entry in z3950queue table that is not done=1 {
75 for each search request {
80 - existing and already running on another process (active=1)
81 - existing & finished (active=-1)
82 - non existent => create it and run the request.
92 # Running as root, switch privs
94 open PID, ">/var/run/processz3950queue.pid";
98 # Get real apacheuser from koha.conf or reparsing httpd.conf
99 my $apacheuser=C4::Context->config("httpduser");
101 unless ($uid = (getpwnam($apacheuser))[2]) {
102 die "Attempt to run daemon as non-existent or superuser\n";
107 my $db_driver = $context->{"config"}{"db_scheme"} || "mysql";
108 my $db_name = $context->{"config"}{"database"};
109 my $db_host = $context->{"config"}{"hostname"};
110 my $db_user = $context->{"config"}{"user"};
111 my $db_passwd = $context->{"config"}{"pass"};
112 my $dbh = DBI->connect("DBI:$db_driver:$db_name:$db_host",$db_user, $db_passwd);
114 # we begin the script, so "unactive" every pending request : they will never give anything, the script died :-(
115 my $sth=$dbh->prepare("update z3950results set active=0 where active<>-1");
119 $SIG{HUP}='checkqueue';
124 open PID, ">$logdir/processz3950queue.pid";
134 if ((time-$lastrun)>5) {
135 print "starting loop\n";
136 $checkqueue = 1; # FIXME during testing, this line forces the loop. REMOVE it to use SIG{HUP} when "daemonized" !
139 # delete z3950queue entries that are more than 1 day old
140 my $sth = $dbh->prepare("delete from z3950queue where ?-startdate > 86400");
142 # delete z3950results queries that are more than 1 hour old
143 $sth = $dbh->prepare("delete from z3950results where ?-startdate > 3600");
145 if ($checkqueue) { # everytime a SIG{HUP} is recieved
147 # parse every entry in QUEUE
148 $sth=$dbh->prepare("select id,term,type,servers,identifier from z3950queue where done<>1 or done is null order by id");
150 while (my ($id, $term, $type, $servers,$random) = $sth->fetchrow) {
151 # FIXME: there is no "else". So, if more than 12 requests at the same time => requests are lost !
152 if ($forkcounter<12) {
154 # search for results entries for this request
155 my $stk=$dbh->prepare("select id,server,startdate,enddate,numrecords,active from z3950results where queryid=?");
156 ($stk->execute($id)) || (next);
158 # if no results => set queue to done = -1, set startdate and begin creating z3950results table entries & z3950 queries
159 unless ($stk->rows) {
160 my $sti=$dbh->prepare("update z3950queue set done=-1,startdate=? where id=?");
161 $sti->execute($now,$id);
163 # check which servers calls have already been created (before a crash)
164 while (my ($r_id, $r_server,$r_startdate,$r_enddate,$r_numrecords,$active) = $stk->fetchrow) {
165 if ($r_enddate >0) { # result entry exist & finished
166 $serverdone{$r_server}=1;
167 } elsif ($active) { # result entry exists & on the way (active=1) or already done (active=-1)
168 $serverdone{$r_server}=1;
170 $serverdone{$r_server}=-1;
172 # note that is the entry doesn't exist, the $serverdone{$r_server} is 0 (important later !)
175 foreach my $serverinfo (split(/\|/, $servers)) {
176 (next) if ($serverdone{$serverinfo} == 1); #(otherwise, is 0 or -1)
181 # fork a process for this z3950 query
182 if (my $pid=fork()) {
185 # and connect to z3950 server
186 #FIXME: why do we need $dbi ? can't we use $dbh ?
187 my $db_driver = $context->{"config"}{"db_scheme"} || "mysql";
188 my $db_name = $context->{"config"}{"database"};
189 my $db_host = $context->{"config"}{"hostname"};
190 my $db_user = $context->{"config"}{"user"};
191 my $db_passwd = $context->{"config"}{"pass"};
192 my $dbi = DBI->connect("DBI:$db_driver:$db_name:$db_host",$db_user, $db_passwd);
193 my ($name, $server, $database, $user, $password,$syntax) = split(/\//, $serverinfo, 6);
195 $globalsyntax = $syntax;
196 $server=~/(.*)\:(\d+)/;
200 if ($type eq 'isbn') {
202 } elsif ($type eq 'title') {
204 } elsif ($type eq 'author') {
206 } elsif ($type eq 'lccn') {
208 } elsif ($type eq 'keyword') {
211 my $query="\@attr $attr \"$term\"";
212 print "$$/$id : Processing $type=$term at $name $server $database $syntax (".($forkcounter+1)." forks)\n";
217 # the z3950 query is builded. Launch it.
219 $conn= new Net::Z3950::Connection($servername, $port, databaseName => $database, user => $user, password => $password) || ($noconnection=1);
221 $conn= new Net::Z3950::Connection($servername, $port, databaseName => $database) || ($noconnection=1);
223 if ($noconnection || $error) {
224 # if connection impossible, don't go further !
225 print "$$/$id : no connection at $globalname\n";
226 my $result = MARC::Record->new();
227 my ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported) = ImportBreeding($result,-1,"$globalname server is NOT responding","",$random);
229 # else, build z3950 query and do it !
232 # create z3950results entries.
233 if ($serverdone{$serverinfo}==-1) { # if entry exist, just retrieve it
234 my $stj=$dbi->prepare("select id from z3950results where server=? and queryid=?");
235 $stj->execute($serverinfo,$id);
236 ($resultsid) = $stj->fetchrow;
238 print "$$/$id : 1 >> $resultsid\n";
239 } else { # else create it : (may be serverdone=1 or 0)
240 my $stj=$dbi->prepare("select id from z3950results where server=? and queryid=?");
241 $stj->execute($serverinfo,$id);
242 ($resultsid) = $stj->fetchrow;
244 print "$$/$id : 2 >> $resultsid\n";
245 unless ($resultsid) {
246 $stj=$dbi->prepare("insert into z3950results (server, queryid, startdate) values (?,?,?)");
247 $stj->execute($serverinfo, $id, $now);
248 $resultsid=$dbi->{'mysql_insertid'};
250 print "$$/$id : creating and ";
253 print "$$/$id : working on results entry $resultsid\n";
254 # set active to 1 => this request is on the way.
255 my $stj=$dbi->prepare("update z3950results set active=1 where id=?");
256 $stj->execute($resultsid);
258 print "$$/$id : connected to $globalname\n";
259 eval {$conn->option(elementSetName => 'F')};
260 eval { $conn->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC);} if ($globalsyntax eq "USMARC");
261 eval { $conn->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::UNIMARC);} if ($globalsyntax eq "UNIMARC");
263 print "$$/$id : $globalname ERROR: $@ for $resultsid\n";
264 # in case pb during connexion, set result to "empty" to avoid everlasting loops
265 my $stj=$dbi->prepare("update z3950results set numrecords=?,numdownloaded=?,highestseen=0,results='',enddate=? where id=?");
266 $stj->execute(0,0,$now,$resultsid);
268 my $rs=$conn->search($query);
270 # we have an answer for a query => get results & store them in marc_breeding table
271 my $numresults=$rs->size();
272 if ($numresults eq 0) {
273 print "$$/$id : $globalname : no records found\n";
275 print "$$/$id : $globalname : $numresults records found, retrieving them (max 80)\n";
280 my $scantimerstart=time();
281 for ($i=1; $i<=(($numresults<80) ? ($numresults) : (80)); $i++) {
282 my $rec=$rs->record($i);
284 # use render() or rawdata() depending on the type of the returned record
286 if (ref($rec) eq "Net::Z3950::Record::USMARC") {
287 $marcdata = $rec->rawdata();
288 $marcrecord = MARC::File::USMARC::decode($rec->rawdata())
290 if (ref($rec) eq "Net::Z3950::Record::UNIMARC") {
291 $marcdata = $rec->render();
292 $marcrecord = MARC::File::USMARC::decode($rec->render())
294 $globalencoding = ref($rec);
297 my @x=split /::/,$globalencoding;
298 my ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported) = ImportBreeding($result,-1,"Z3950-$globalname",$x[3],$random);
299 my $scantimerend=time();
301 ($numresults<80) ? ($numrecords=$numresults) : ($numrecords=80);
302 my $elapsed=$scantimerend-$scantimerstart;
304 my $speed=int($numresults/$elapsed*100)/100;
305 print "$$/$id : $globalname : $server records retrieved $numrecords SPEED: $speed\n";
307 my $q_result=$dbi->quote($result);
308 ($q_result) || ($q_result='""');
310 if ($numresults >0) {
311 my $stj=$dbi->prepare("update z3950results set numrecords=?,numdownloaded=?,highestseen=0,results=?,enddate=? where id=?");
312 $stj->execute($numresults,$numrecords,$q_result,$now,$resultsid);
313 } else { # no results...
314 my $stj=$dbi->prepare("update z3950results set numrecords=?,numdownloaded=?,highestseen=0,results='',enddate=? where id=?");
315 $stj->execute($numresults,$numrecords,$now,$resultsid);
318 $stj=$dbi->prepare("update z3950results set active=-1 where id=?");
319 $stj->execute($resultsid);
320 eval {my $stj->finish};
322 #OK, the search is done inactivate it..
323 print "$$/$id : $server search done.\n";
330 # delete z3950queue entry, as everything is done
331 my $sti=$dbh->prepare("update z3950queue set done=1,enddate=? where id=?");
333 $sti->execute($now,$id);