Lines 1-176
Link Here
|
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" }; |
11 |
} |
12 |
|
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 =?"); |
29 |
|
30 |
|
31 |
#AGAIN: |
32 |
|
33 |
#my $wait=C4::Context->preference('zebrawait') || 120; |
34 |
my $verbose = 0; |
35 |
print "starting with verbose=$verbose\n" if $verbose; |
36 |
|
37 |
my ($id,$biblionumber,$operation,$server,$marcxml); |
38 |
|
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); |
64 |
} |
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; |
72 |
} |
73 |
} |
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; |
84 |
} |
85 |
# ok, we have everything, do the operation in zebra ! |
86 |
$ok=zebrado($marcxml,$operation,$server); |
87 |
} |
88 |
}; |
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; |
111 |
} |
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(); |
117 |
} |
118 |
} |
119 |
} |
120 |
|
121 |
sub zebrado { |
122 |
|
123 |
###Accepts a $server variable thus we can use it to update biblios, authorities or other zebra dbs |
124 |
my ($record,$op,$server,$biblionumber)=@_; |
125 |
|
126 |
my @port; |
127 |
|
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: |
135 |
|
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; |
169 |
} |
170 |
$Zpackage->send('commit'); |
171 |
# $Zpackage->destroy(); |
172 |
# $Zconn->destroy(); |
173 |
return 1; |
174 |
} |
175 |
return 0; |
176 |
} |
177 |
- |