3 # daemon to watch the zebraqueue and update zebra as needed
7 # find Koha's Perl modules
8 # test carefully before changing this
10 eval { require "$FindBin::Bin/kohalib.pl" };
12 use POE qw(Wheel::SocketFactory Wheel::ReadWrite Filter::Stream Driver::SysRW);
13 use Unix::Syslog qw(:macros);
18 use C4::AuthoritiesMarc;
23 my $dbh=C4::Context->dbh;
24 my $ident = "Koha Zebraqueue ";
27 Unix::Syslog::openlog $ident, LOG_PID, LOG_LOCAL0;
29 Unix::Syslog::syslog LOG_INFO, "Starting Zebraqueue log at " . scalar localtime(time) . "\n";
33 # Starts session. Only ever called once only really used to set an alias
35 my ( $kernel, $heap, $session ) = @_[ KERNEL, HEAP, SESSION ];
37 my $time = localtime(time);
38 Unix::Syslog::syslog LOG_INFO, "$time POE Session ", $session->ID, " has started.\n";
41 # $kernel->yield('status_check');
42 $kernel->yield('sleep');
47 # can be used to slow down loop execution if needed
48 my ( $kernel, $heap, $session ) = @_[ KERNEL, HEAP, SESSION ];
51 $kernel->yield('status_check');
55 # check if we need to do anything, at the moment just checks the zebraqueue, it could check other things too
56 my ( $kernel, $heap, $session ) = @_[ KERNEL, HEAP, SESSION ];
57 my $dbh=C4::Context->dbh;
58 my $sth = $dbh->prepare("SELECT count(*) AS opcount FROM zebraqueue WHERE done = 0");
60 my $data = $sth->fetchrow_hashref();
61 if ($data->{'opcount'} > 0){
62 Unix::Syslog::syslog LOG_INFO, "$data->{'opcount'} operations waiting to be run\n";
64 $kernel->yield('do_ops');
68 $kernel->yield('sleep');
73 # execute operations waiting in the zebraqueue
74 my ( $kernel, $heap, $session ) = @_[ KERNEL, HEAP, SESSION ];
75 my $dbh=C4::Context->dbh;
76 my $readsth=$dbh->prepare("SELECT id,biblio_auth_number,operation,server FROM zebraqueue WHERE done=0");
78 Unix::Syslog::syslog LOG_INFO, "Executing zebra operations\n";
79 while (my $data = $readsth->fetchrow_hashref()){
82 if ($data->{'operation'} =~ /delete/ ){
83 # 1st read the record in zebra, we have to get it from zebra as its no longer in the db
84 my $Zconn=C4::Context->Zconn($data->{'server'}, 0, 1,'','xml');
85 my $query = $Zconn->search_pqf( '@attr 1=Local-Number '.$data->{'biblio_auth_number'});
86 # then, delete the record
87 $ok=zebrado($query->record(0)->render(),$data->{'operation'},$data->{'server'},$data->{'biblio_auth_number'});
93 if ($data->{'server'} eq "biblioserver") {
94 my $marc = GetMarcBiblio($data->{'biblio_auth_number'});
95 $marcxml = $marc->as_xml_record() if $marc;
97 elsif ($data->{'server'} eq "authorityserver") {
98 $marcxml =C4::AuthoritiesMarc::GetAuthorityXML($data->{'biblio_auth_number'});
100 # check it's XML, just in case
102 my $hashed=XMLin($marcxml);
103 }; ### is it a proper xml? broken xml may crash ZEBRA- slow but safe
104 ## it's Broken XML-- Should not reach here-- but if it does -lets protect ZEBRA
106 Unix::Syslog::syslog LOG_ERR, "$@";
107 my $delsth=$dbh->prepare("UPDATE zebraqueue SET done=1 WHERE id =?");
108 $delsth->execute($data->{'id'});
111 # ok, we have everything, do the operation in zebra !
112 $ok=zebrado($marcxml,$data->{'operation'},$data->{'server'},$data->{'biblio_auth_number'});
115 $dbh=C4::Context->dbh;
117 # if it's a deletion, we can delete every request on this biblio : in case the user
118 # did a modif (or item deletion) just before biblio deletion, there are some specialUpdate
119 # that are pending and can't succeed, as we don't have the XML anymore
120 # so, delete everything for this biblionumber
121 if ($data->{'operation'} eq 'delete_record') {
122 $delsth =$dbh->prepare("UPDATE zebraqueue SET done=1 WHERE biblio_auth_number =?");
123 $delsth->execute($data->{'biblio_auth_number'});
124 # if it's not a deletion, delete every pending specialUpdate for this biblionumber
125 # in case the user add biblio, then X items, before this script runs
126 # this avoid indexing X+1 times where just 1 is enough.
128 $delsth =$dbh->prepare("UPDATE zebraqueue SET done=1 WHERE biblio_auth_number =? and operation='specialUpdate'");
129 $delsth->execute($data->{'biblio_auth_number'});
134 Unix::Syslog::syslog LOG_ERR, "$@";
138 $kernel->yield('status_check');
143 ###Accepts a $server variable thus we can use it to update biblios, authorities or other zebra dbs
144 my ($record,$op,$server,$biblionumber)=@_;
151 # $record=Encode::encode("UTF-8",$record);
152 my $shadow=$server."shadow";
154 $op = 'recordDelete' if $op eq 'delete_record';
157 my $Zconn=C4::Context->Zconn($server, 0, 1);
159 my $Zpackage = $Zconn->package();
160 $Zpackage->option(action => $op);
161 $Zpackage->option(record => $record);
162 # $Zpackage->option(recordIdOpaque => $biblionumber) if $biblionumber;
164 $Zpackage->send("update");
165 my($error, $errmsg, $addinfo, $diagset) = $Zconn->error_x();
166 if ($error==10007 && $tried<3) {## timeout --another 30 looonng seconds for this update
167 sleep 1; ## wait a sec!
170 }elsif ($error==2 && $tried<2) {## timeout --temporary zebra error !whatever that means
171 sleep 2; ## wait two seconds!
174 }elsif($error==10004 && $recon==0){##Lost connection -reconnect
175 sleep 1; ## wait a sec!
177 $Zpackage->destroy();
181 $Zpackage->destroy();
185 $Zpackage->send('commit');
194 my $time = localtime(time);
195 Unix::Syslog::syslog LOG_INFO, "$time Session ", $_[SESSION]->ID, " has stopped.\n";
196 delete $heap->{session};
199 POE::Session->create(
201 _start => \&handler_start,
202 sleep => \&handler_sleep,
203 status_check => \&handler_check,
205 _stop => \&handler_stop,
212 Unix::Syslog::closelog;