z3950/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::AuthoritiesMarc;
  10 use XML::Simple;
  11 use utf8;
  12 ### ZEBRA SERVER UPDATER
  13 ##Uses its own database handle
  14 my $dbh=C4::Context->dbh;
  15 my $readsth=$dbh->prepare("select id,biblio_auth_number,operation,server from zebraqueue");
  16 my $delsth=$dbh->prepare("delete from zebraqueue where id =?");
  17
  18
  19 AGAIN:
  20 my $wait=C4::Context->preference('zebrawait');
  21  $wait=120 unless $wait;
  22 my ($id,$biblionumber,$operation,$server,$marcxml);
  23 $readsth->execute;
  24 while (($id,$biblionumber,$operation,$server)=$readsth->fetchrow){
  25 if ($server eq "biblioserver"){
  26         ($marcxml) =ZEBRA_readyXML($dbh,$biblionumber);
  27         }elsif($server eq "authorityserver"){
  28         $marcxml =C4::AuthoritiesMarc::XMLgetauthority($dbh,$biblionumber);
  29         }
  30
  31 eval {
  32 my $hashed=XMLin($marcxml);
  33 }; ### is it a proper xml? broken xml may crash ZEBRA- slow but safe
  34
  35 if ($@){
  36 warn $@;
  37 ## Broken XML-- Should not reach here-- but if it does -lets protect ZEBRA
  38 $delsth->execute($id);
  39 next;
  40 }
  41 my $ok;
  42 eval{
  43  $ok=ZEBRAopserver($marcxml,$operation,$server);
  44 };
  45  ## If a delete operation delete the SQL DB as well
  46         if ($operation eq "recordDelete" && $ok==1){
  47                 if ($server eq "biblioserver"){
  48                 ZEBRAdelbiblio($dbh,$biblionumber);
  49                 }elsif ($server eq "authorityserver"){
  50                 ZEBRAdelauthority($dbh,$biblionumber);
  51                 }
  52         }
  53 $delsth->execute($id) if ($ok==1);
  54 }
  55
  56 sleep $wait;
  57 goto AGAIN;