&XMLmoditemonefield
&XMLkoha2marc
&XML_separate
-
+&XML_record_header
&ZEBRAdelbiblio
&ZEBRAgetrecord
&ZEBRAop
&ZEBRAopserver
&ZEBRA_readyXML
&ZEBRA_readyXML_noheader
-
+&ZEBRAopcommit
&newbiblio
&modbiblio
&DisplayISBN
my $biblio=$xml->{'datafield'};
my $controlfield=$xml->{'controlfield'};
($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
-my $updated=0;
+my $updated;
if ($tag>9){
foreach my $data (@$biblio){
if ($data->{'tag'} eq $tag){
} ;
}
}## created now
- }else{
- foreach my $control(@$controlfield){
+ }elsif ($tag>0){
+ foreach my $control (@$controlfield){
if ($control->{'tag'} eq $tag){
$control->{'content'}=$newvalue;
$updated=1;
sub XML_xml2hash_onerecord{
##make a perl hash from xml file
my ($xml)=@_;
+return undef unless $xml;
my $hashed = XMLin( $xml ,KeyAttr =>['leader','controlfield','datafield'],ForceArray => ['leader','controlfield','datafield','subfield'],KeepRoot=>0);
return $hashed;
}
}
}else{
- my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like 'biblios' and tagfield is not null" );
+ my $sth2=$dbh->prepare("SELECT kohafield from koha_attr where recordtype like 'biblios' and tagfield is not null" );
$sth2->execute();
my $field;
while ($field=$sth2->fetchrow) {
push @items, $itemresult;
}
}else{
- my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like 'holdings' and tagfield is not null" );
+ my $sth2=$dbh->prepare("SELECT kohafield from koha_attr where recordtype like 'holdings' and tagfield is not null" );
foreach my $holding (@$holdings){
$sth2->execute();
my $field;
$result->{$field}=$val if $val;
}
}else{
- my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like ? and tagfield is not null" );
+ my $sth2=$dbh->prepare("SELECT kohafield from koha_attr where recordtype like ? and tagfield is not null" );
$sth2->execute($related_record);
my $field;
while ($field=$sth2->fetchrow) {
$year=substr($year,2,2);
my $accdate=sprintf("%2d%02d%02d",$year,$mon,$mday);
my ($titletag,$titlesubf)=MARCfind_marc_from_kohafield("title","biblios");
-my $xml="<record><leader> naa a22 7ar4500</leader><controlfield tag='005'>$timestamp</controlfield><controlfield tag='008'>$accdate</controlfield><datafield ind1='' ind2='' tag='$titletag'></datafield></record>";
+##create a dummy record
+my $xml="<record><leader> naa a22 7ar4500</leader><controlfield tag='xxx'></controlfield><datafield ind1='' ind2='' tag='$titletag'></datafield></record>";
## Now build XML
my $record = XML_xml2hash($xml);
- my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where tagfield is not null and recordtype=?");
+ my $sth2=$dbh->prepare("SELECT kohafield from koha_attr where tagfield is not null and recordtype=?");
$sth2->execute($recordtype);
my $field;
while (($field)=$sth2->fetchrow) {
-warn $field;
$record=XML_writeline($record,$field,$result->{$field},$recordtype) if $result->{$field};
}
return $record;
$sth->execute($frameworkcode);
my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
- while ( my ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
+ while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
$res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
$res->{$tab}->{tab} = ""; # XXX
$res->{$tag}->{mandatory} = $mandatory;
sub MARChtml2xml {
# warn "MARChtml2xml ";
- my ($tags,$subfields,$values,$indicator,$ind_tag) = @_;
-# use MARC::File::XML;
- my $xml= marc_record_header('UTF-8'); #### we do not need a collection wrapper
+ my ($tags,$subfields,$values,$indicator,$ind_tag,$tagindex) = @_;
+ my $xml= "<record>";
my $prevvalue;
my $prevtag=-1;
@$values[$i] =~ s/"/"/g;
@$values[$i] =~ s/'/'/g;
- if ((@$tags[$i] ne $prevtag)){
- my $tag=substr(@$tags[$i],0,3);
+ if ((@$tags[$i].@$tagindex[$i] ne $prevtag)){
+ my $tag=@$tags[$i];
$j++ unless ($tag eq "");
## warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i];
if (!$first){
}
} else { # @$tags[$i] eq $prevtag
unless (@$values[$i] eq "") {
- my $tag=substr(@$tags[$i],0,3);
+ my $tag=@$tags[$i];
if ($first){
my $ind1 = substr(@$indicator[$j],0,1);
my $ind2 = substr(@$indicator[$j],1,1);
$xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
}
}
- $prevtag = @$tags[$i];
+ $prevtag = @$tags[$i].@$tagindex[$i];
}
$xml.="</record>";
# warn $xml;
$xml=Encode::decode('utf8',$xml);
return $xml;
}
-sub marc_record_header {
+sub XML_record_header {
#### this one is for <record>
my $format = shift;
my $enc = shift || 'UTF-8';
##Add biblionumber to $record
$xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"holdings");
-# MARCkoha2marcOnefield($record,"biblionumber",$biblionumber,"holdings");
my $sth=$dbh->prepare("select notforloan from itemtypes where itemtype='$itemtype'");
$sth->execute();
my $notforloan=$sth->fetchrow;
my $itemcallnumber=XML_readline_onerecord($xmlhash,"itemcallnumber","holdings");
if ($itemcallnumber){
my ($cutterextra)=itemcalculator($dbh,$biblionumber,$itemcallnumber);
-warn $cutterextra;
$xmlhash=XML_writeline($xmlhash,"cutterextra",$cutterextra,"holdings");
}
$sth->execute($itemnumber);
my $biblionumber=$sth->fetchrow;
OLDdelitem( $dbh, $itemnumber ) ;
-ZEBRAop($dbh,$biblionumber,"recordDelete","biblioserver");
+ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
}
my $author=XML_readline_onerecord($xmlhash,"author","biblios");
my $xml=XML_hash2xml($xmlhash);
-#my $marc=MARC::Record->new_from_xml($xml,'UTF-8');## this will be depreceated
$isbn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g;
$issn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g;
$isbn=~s/^\s+|\s+$//g;
sub ZEBRAop {
### Puts the zebra update in queue writes in zebraserver table
my ($dbh,$biblionumber,$op,$server)=@_;
-my ($record);
+if (!$biblionumber){
+warn "Zebra received no biblionumber";
+}else{
my $sth=$dbh->prepare("insert into zebraqueue (biblio_auth_number ,server,operation) values(?,?,?)");
$sth->execute($biblionumber,$server,$op);
}
-
+}
sub ZEBRAopserver{
###Accepts a $server variable thus we can use it to update biblios, authorities or other zebra dbs
-my ($record,$op,$server)=@_;
-my @Zconnbiblio;
+my ($record,$op,$server,$biblionumber)=@_;
+
my @port;
-my $Zpackage;
+
my $tried=0;
my $recon=0;
my $reconnect=0;
-$record=Encode::encode("utf8",$record);
+$record=Encode::encode("UTF-8",$record);
my $shadow=$server."shadow";
reconnect:
-$Zconnbiblio[0]=C4::Context->Zconnauth($server);
+ my $Zconnbiblio=C4::Context->Zconnauth($server);
if ($record){
-my $Zpackage = $Zconnbiblio[0]->package();
+my $Zpackage = $Zconnbiblio->package();
$Zpackage->option(action => $op);
$Zpackage->option(record => $record);
+ $Zpackage->option(recordIdOpaque => $biblionumber);
retry:
$Zpackage->send("update");
-my $i;
-my $event;
-while (($i = ZOOM::event(\@Zconnbiblio)) != 0) {
- $event = $Zconnbiblio[0]->last_event();
- last if $event == ZOOM::Event::ZEND;
-}
- my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio[0]->error_x();
+ my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio->error_x();
if ($error==10007 && $tried<3) {## timeout --another 30 looonng seconds for this update
sleep 1; ## wait a sec!
$tried=$tried+1;
sleep 1; ## wait a sec!
$recon=1;
$Zpackage->destroy();
- $Zconnbiblio[0]->destroy();
+ $Zconnbiblio->destroy();
goto "reconnect";
}elsif ($error){
# warn "Error-$server $op /errcode:, $error, /MSG:,$errmsg,$addinfo \n";
$Zpackage->destroy();
- $Zconnbiblio[0]->destroy();
- # ZEBRAopfiles($dbh,$biblionumber,$record,$op,$server);
+ $Zconnbiblio->destroy();
return 0;
}
- ## System preference batchMode=1 means wea are bulk importing
- ## DO NOT COMMIT while in batchMode for faster operation
- my $batchmode=C4::Context->preference('batchMode');
- if (C4::Context->$shadow >0 && !$batchmode){
- $Zpackage->send('commit');
- while (($i = ZOOM::event(\@Zconnbiblio)) != 0) {
- $event = $Zconnbiblio[0]->last_event();
- last if $event == ZOOM::Event::ZEND;
- }
- my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio[0]->error_x();
- if ($error) { ## This is serious ZEBRA server is not updating
- $Zpackage->destroy();
- $Zconnbiblio[0]->destroy();
- return 0;
- }
- }##commit
-#
+
$Zpackage->destroy();
-$Zconnbiblio[0]->destroy();
+$Zconnbiblio->destroy();
return 1;
}
return 0;
}
+
+sub ZEBRAopcommit {
+my $server=shift;
+
+my $Zconnbiblio=C4::Context->Zconnauth($server);
+
+my $Zpackage = $Zconnbiblio->package();
+ $Zpackage->send('commit');
+
+ my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio->error_x();
+ if ($error) { ## This is serious ZEBRA server is not updating
+ $Zpackage->destroy();
+ $Zconnbiblio->destroy();
+ return 0;
+ }
+$Zpackage->destroy();
+$Zconnbiblio->destroy();
+return 1;
+}
sub ZEBRA_readyXML{
my ($dbh,$biblionumber)=@_;
my $biblioxml=XMLgetbiblio($dbh,$biblionumber);
my @itemxml=XMLgetallitems($dbh,$biblionumber);
my $zebraxml=collection_header();
-$zebraxml.="<koharecord>\n";
+$zebraxml.="<koharecord>";
$zebraxml.=$biblioxml;
-$zebraxml.="<holdings>\n";
+$zebraxml.="<holdings>";
foreach my $item(@itemxml){
- $zebraxml.=$item;
+ $zebraxml.=$item if $item;
}
-$zebraxml.="</holdings>\n";
-$zebraxml.="</koharecord>\n";
-$zebraxml.="</kohacollection>\n";
-
+$zebraxml.="</holdings>";
+$zebraxml.="</koharecord>";
+$zebraxml.="</kohacollection>";
return $zebraxml;
}
sub getkohafields{
#returns MySQL like fieldnames to emulate searches on sql like fieldnames
-my $type=@_;
+my $type=shift;
## Either opac or intranet to select appropriate fields
## Assumes intranet
$type="intra" unless $type;
my $i=0;
my @results;
$type=$type."show";
-my $sth=$dbh->prepare("SELECT * FROM koha_attr where $type=1 order by liblibrarian");
+my $sth=$dbh->prepare("SELECT * FROM koha_attr where $type=1 order by label");
$sth->execute();
while (my $data=$sth->fetchrow_hashref){
$results[$i]=$data;
projects / koha-ffzg.git / blobdiff