Bugfixes & improvements (various and minor) :
[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");
17 #my $delsth=$dbh->prepare("delete from zebraqueue where id =?");
18
19
20 #AGAIN:
21
22 #my $wait=C4::Context->preference('zebrawait') || 120;
23 my $verbose = 0;
24 print "starting with verbose=$verbose\n" if $verbose;
25
26 my ($id,$biblionumber,$operation,$server,$marcxml);
27
28 $readsth->execute;
29 while (($id,$biblionumber,$operation,$server)=$readsth->fetchrow){
30     print "read in queue : $id : biblio $biblionumber for $operation on $server\n" if $verbose;
31     my $ok;
32     eval{
33         # if the operation is a deletion, zebra requires that we give it the xml.
34         # as it is no more in the SQL db, retrieve it from zebra itself.
35         # may sound silly, but that's the way zebra works ;-)
36             if ($operation =~ /delete/) {
37                # 1st read the record in zebra
38             my $Zconn=C4::Context->Zconn($server, 0, 1,'','xml');
39             my $query = $Zconn->search_pqf( '@attr 1=Local-Number '.$biblionumber);
40             # then, delete the record
41                 $ok=zebrado($query->record(0)->render(),$operation,$server,$biblionumber);
42         # if it's an add or a modif
43         } else {
44             # get the XML
45             if ($server eq "biblioserver") {
46                 my $marc = GetMarcBiblio($biblionumber);
47                 $marcxml = $marc->as_xml_record() if $marc;
48             } elsif ($server eq "authorityserver") {
49                 $marcxml =C4::AuthoritiesMarc::XMLgetauthority($dbh,$biblionumber);
50             }
51             if ($verbose) {
52                 if ($marcxml) {
53                     print "XML read : $marcxml\n" if $verbose >1;
54                 } else {
55                 # workaround for zebra bug needing a XML even for deletion
56                 $marcxml= "<dummy/>";
57                     print "unable to read MARCxml\n" if $verbose;
58                 }
59             }
60             # check it's XML, just in case
61             eval {
62                 my $hashed=XMLin($marcxml);
63             }; ### is it a proper xml? broken xml may crash ZEBRA- slow but safe
64             ## it's Broken XML-- Should not reach here-- but if it does -lets protect ZEBRA
65             if ($@){
66                 warn $@;
67                 my $delsth=$dbh->prepare("delete from zebraqueue where id =?");
68                 $delsth->execute($id);
69                 next;
70             }
71             # ok, we have everything, do the operation in zebra !
72             $ok=zebrado($marcxml,$operation,$server);
73         }
74     };
75     print "ZEBRAopserver returned : $ok \n" if $verbose;
76     if ($ok ==1) {
77         $dbh=C4::Context->dbh;
78         my $delsth;
79         # if it's a deletion, we can delete every request on this biblio : in case the user
80         # did a modif (or item deletion) just before biblio deletion, there are some specialUpdage
81         # that are pending and can't succeed, as we don't have the XML anymore
82         # so, delete everything for this biblionumber
83         if ($operation eq 'delete_record') {
84             print "deleting biblio deletion $biblionumber\n" if $verbose;
85             $delsth =$dbh->prepare("delete from zebraqueue where biblio_auth_number =?");
86             $delsth->execute($biblionumber);
87         # if it's not a deletion, delete every pending specialUpdate for this biblionumber
88         # in case the user add biblio, then X items, before this script runs
89         # this avoid indexing X+1 times where just 1 is enough.
90         } else {
91             print "deleting special date for $biblionumber\n" if $verbose;
92             $delsth =$dbh->prepare("delete from zebraqueue where biblio_auth_number =? and operation='specialUpdate'");
93             $delsth->execute($biblionumber);
94         }
95     }
96 }
97
98 sub zebrado {
99     
100     ###Accepts a $server variable thus we can use it to update  biblios, authorities or other zebra dbs
101     my ($record,$op,$server,$biblionumber)=@_;
102     
103     my @port;
104     
105     my $tried=0;
106     my $recon=0;
107     my $reconnect=0;
108 #    $record=Encode::encode("UTF-8",$record);
109     my $shadow=$server."shadow";
110     $op = 'recordDelete' if $op eq 'delete_record';
111 reconnect:
112     
113     my $Zconn=C4::Context->Zconn($server, 0, 1);
114     if ($record){
115         print "updating $op on $biblionumber for server $server\n $record\n" if $verbose;
116         my $Zpackage = $Zconn->package();
117         $Zpackage->option(action => $op);
118         $Zpackage->option(record => $record);
119 #           $Zpackage->option(recordIdOpaque => $biblionumber) if $biblionumber;
120 retry:
121         $Zpackage->send("update");
122         my($error, $errmsg, $addinfo, $diagset) = $Zconn->error_x();
123         if ($error==10007 && $tried<3) {## timeout --another 30 looonng seconds for this update
124             print "error 10007\n" if $verbose;
125             sleep 1;    ##  wait a sec!
126             $tried=$tried+1;
127             goto "retry";
128         }elsif ($error==2 && $tried<2) {## timeout --temporary zebra error !whatever that means
129             print "error 2\n" if $verbose;
130             sleep 2;    ##  wait two seconds!
131             $tried=$tried+1;
132             goto "retry";
133         }elsif($error==10004 && $recon==0){##Lost connection -reconnect
134             print "error 10004\n" if $verbose;
135             sleep 1;    ##  wait a sec!
136             $recon=1;
137             $Zpackage->destroy();
138             $Zconn->destroy();
139             goto "reconnect";
140         }elsif ($error){
141         #       warn "Error-$server   $op  /errcode:, $error, /MSG:,$errmsg,$addinfo \n";       
142             print "error $error\n" if $verbose;
143             $Zpackage->destroy();
144             $Zconn->destroy();
145             return 0;
146         }
147         $Zpackage->send('commit');
148 #     $Zpackage->destroy();
149 #     $Zconn->destroy();
150     return 1;
151     }
152     return 0;
153 }