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