Bug 2505 - Add commented use warnings where missing in the misc/ directory
[koha.git] / misc / cronjobs / zebraqueue_start.pl
blobea8415679318a50b615aa6e1e157fbad1c417e29
1 #!/usr/bin/perl
2 # script that starts the zebraquee
3 # Written by TG on 01/08/2006
4 use strict;
5 #use warnings; FIXME - Bug 2505
6 BEGIN {
7 # find Koha's Perl modules
8 # test carefully before changing this
9 use FindBin;
10 eval { require "$FindBin::Bin/../kohalib.pl" };
13 use C4::Context;
14 use C4::Biblio;
15 use C4::Search;
16 use C4::AuthoritiesMarc;
17 use XML::Simple;
18 use utf8;
19 ### ZEBRA SERVER UPDATER
20 ##Uses its own database handle
21 my $dbh=C4::Context->dbh;
22 my $readsth=$dbh->prepare("SELECT id,biblio_auth_number,operation,server FROM zebraqueue WHERE done=0
23 ORDER BY id DESC"); # NOTE - going in reverse order to catch deletes that
24 # occur after a string of updates (e.g., user deletes
25 # the items attached to a bib, then the items.
26 # Having a specialUpdate occur after a recordDelete
27 # should not occur.
28 #my $delsth=$dbh->prepare("delete from zebraqueue where id =?");
31 #AGAIN:
33 #my $wait=C4::Context->preference('zebrawait') || 120;
34 my $verbose = 0;
35 print "starting with verbose=$verbose\n" if $verbose;
37 my ($id,$biblionumber,$operation,$server,$marcxml);
39 $readsth->execute;
40 while (($id,$biblionumber,$operation,$server)=$readsth->fetchrow){
41 print "read in queue : $id : biblio $biblionumber for $operation on $server\n" if $verbose;
42 my $ok;
43 eval{
44 # if the operation is a deletion, zebra requires that we give it the xml.
45 # as it is no more in the SQL db, retrieve it from zebra itself.
46 # may sound silly, but that's the way zebra works ;-)
47 if ($operation =~ /delete/i) { # NOTE depending on version, delete operation
48 # was coded 'delete_record' or 'recordDelete'.
49 # 'recordDelete' is the preferred one, as that's
50 # what the ZOOM API wants.
51 # 1st read the record in zebra
52 my $Zconn=C4::Context->Zconn($server, 0, 1,'','xml');
53 my $query = $Zconn->search_pqf( '@attr 1=Local-Number '.$biblionumber);
54 # then, delete the record
55 $ok=zebrado($query->record(0)->render(),$operation,$server,$biblionumber);
56 # if it's an add or a modif
57 } else {
58 # get the XML
59 if ($server eq "biblioserver") {
60 my $marc = GetMarcBiblio($biblionumber);
61 $marcxml = $marc->as_xml_record() if $marc;
62 } elsif ($server eq "authorityserver") {
63 $marcxml =C4::AuthoritiesMarc::GetAuthorityXML($biblionumber);
65 if ($verbose) {
66 if ($marcxml) {
67 print "XML read : $marcxml\n" if $verbose >1;
68 } else {
69 # workaround for zebra bug needing a XML even for deletion
70 $marcxml= "<dummy/>";
71 print "unable to read MARCxml\n" if $verbose;
74 # check it's XML, just in case
75 eval {
76 my $hashed=XMLin($marcxml);
77 }; ### is it a proper xml? broken xml may crash ZEBRA- slow but safe
78 ## it's Broken XML-- Should not reach here-- but if it does -lets protect ZEBRA
79 if ($@){
80 warn $@;
81 my $delsth=$dbh->prepare("UPDATE zebraqueue SET done=1 WHERE id =?");
82 $delsth->execute($id);
83 next;
85 # ok, we have everything, do the operation in zebra !
86 $ok=zebrado($marcxml,$operation,$server);
89 print "ZEBRAopserver returned : $ok \n" if $verbose;
90 if ($ok ==1) {
91 $dbh=C4::Context->dbh;
92 my $delsth;
93 # if it's a deletion, we can delete every request on this biblio : in case the user
94 # did a modif (or item deletion) just before biblio deletion, there are some specialUpdage
95 # that are pending and can't succeed, as we don't have the XML anymore
96 # so, delete everything for this biblionumber
97 my $reset_readsth = 0;
98 if ($operation eq 'recordDelete') {
99 print "deleting biblio deletion $biblionumber\n" if $verbose;
100 $delsth =$dbh->prepare("UPDATE zebraqueue SET done=1 WHERE biblio_auth_number =?");
101 $delsth->execute($biblionumber);
102 $reset_readsth = 1 if $delsth->rows() > 0;
103 # if it's not a deletion, delete every pending specialUpdate for this biblionumber
104 # in case the user add biblio, then X items, before this script runs
105 # this avoid indexing X+1 times where just 1 is enough.
106 } else {
107 print "deleting special date for $biblionumber\n" if $verbose;
108 $delsth =$dbh->prepare("UPDATE zebraqueue SET done=1 WHERE biblio_auth_number =? and operation='specialUpdate'");
109 $delsth->execute($biblionumber);
110 $reset_readsth = 1 if $delsth->rows() > 0;
112 if ($reset_readsth) {
113 # if we can ignore rows in zebraqueue because we've already
114 # touched a record, reset the query.
115 $readsth->finish();
116 $readsth->execute();
121 sub zebrado {
123 ###Accepts a $server variable thus we can use it to update biblios, authorities or other zebra dbs
124 my ($record,$op,$server,$biblionumber)=@_;
126 my @port;
128 my $tried=0;
129 my $recon=0;
130 my $reconnect=0;
131 # $record=Encode::encode("UTF-8",$record);
132 my $shadow=$server."shadow";
133 $op = 'recordDelete' if $op eq 'delete_record';
134 reconnect:
136 my $Zconn=C4::Context->Zconn($server, 0, 1);
137 if ($record){
138 print "updating $op on $biblionumber for server $server\n $record\n" if $verbose;
139 my $Zpackage = $Zconn->package();
140 $Zpackage->option(action => $op);
141 $Zpackage->option(record => $record);
142 # $Zpackage->option(recordIdOpaque => $biblionumber) if $biblionumber;
143 retry:
144 $Zpackage->send("update");
145 my($error, $errmsg, $addinfo, $diagset) = $Zconn->error_x();
146 if ($error==10007 && $tried<3) {## timeout --another 30 looonng seconds for this update
147 print "error 10007\n" if $verbose;
148 sleep 1; ## wait a sec!
149 $tried=$tried+1;
150 goto "retry";
151 }elsif ($error==2 && $tried<2) {## timeout --temporary zebra error !whatever that means
152 print "error 2\n" if $verbose;
153 sleep 2; ## wait two seconds!
154 $tried=$tried+1;
155 goto "retry";
156 }elsif($error==10004 && $recon==0){##Lost connection -reconnect
157 print "error 10004\n" if $verbose;
158 sleep 1; ## wait a sec!
159 $recon=1;
160 $Zpackage->destroy();
161 $Zconn->destroy();
162 goto "reconnect";
163 }elsif ($error){
164 # warn "Error-$server $op /errcode:, $error, /MSG:,$errmsg,$addinfo \n";
165 print "error $error\n" if $verbose;
166 $Zpackage->destroy();
167 $Zconn->destroy();
168 return 0;
170 $Zpackage->send('commit');
171 # $Zpackage->destroy();
172 # $Zconn->destroy();
173 return 1;
175 return 0;