|
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 |
- |