package C4::Biblio;
-# New subs added by tgarip@neu.edu.tr 05/11/05
+# New XML API added by tgarip@neu.edu.tr 25/08/06
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
use strict;
require Exporter;
use C4::Context;
-use MARC::Record;
-use MARC::File::USMARC;
-use MARC::File::XML;
use XML::Simple;
use Encode;
+use utf8;
use vars qw($VERSION @ISA @EXPORT);
&NEWdelitem
&NEWmodbiblioframework
-&MARCgetallitems
+
&MARCfind_marc_from_kohafield
&MARCfind_frameworkcode
&MARCfind_itemtype
&MARCgettagslib
&MARCitemsgettagslib
-&MARCmoditemonefield
-&MARCkoha2marc
-&MARCmarc2koha
-&MARCkoha2marcOnefield
+
&MARCfind_attr_from_kohafield
-&MARChtml2marc
&MARChtml2xml
-&MARChtml2marcxml
-&MARCgetbiblio
-&MARCgetitem
+
&XMLgetbiblio
+&XMLgetbibliohash
&XMLgetitem
+&XMLgetitemhash
&XMLgetallitems
&XML_xml2hash
+&XML_xml2hash_onerecord
&XML_hash2xml
&XMLmarc2koha
+&XMLmarc2koha_onerecord
&XML_readline
+&XML_readline_onerecord
+&XML_readline_asarray
&XML_writeline
-
+&XML_writeline_id
+&XMLmoditemonefield
+&XMLkoha2marc
+&XML_separate
+&XML_record_header
+&ZEBRAdelbiblio
&ZEBRAgetrecord
-&ZEBRAgetallitems
-&ZEBRAop &ZEBRAopserver
+&ZEBRAop
+&ZEBRAopserver
&ZEBRA_readyXML
&ZEBRA_readyXML_noheader
-
+&ZEBRAopcommit
&newbiblio
&modbiblio
&DisplayISBN
#################### XML XML XML XML ###################
### XML Read- Write functions
+sub XML_readline_onerecord{
+my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
+#$xml represents one record of MARCXML as perlhashed
+### $recordtype is needed for mapping the correct field
+ ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
+
+if ($tag){
+my $biblio=$xml->{'datafield'};
+my $controlfields=$xml->{'controlfield'};
+my $leader=$xml->{'leader'};
+ if ($tag>9){
+ foreach my $data (@$biblio){
+ if ($data->{'tag'} eq $tag){
+ foreach my $subfield ( $data->{'subfield'}){
+ foreach my $code ( @$subfield){
+ if ($code->{'code'} eq $subf){
+ return $code->{'content'};
+ }
+ }
+ }
+ }
+ }
+ }else{
+ if ($tag eq "000" || $tag eq "LDR"){
+ return $leader->[0] if $leader->[0];
+ }else{
+ foreach my $control (@$controlfields){
+ if ($control->{'tag'} eq $tag){
+ return $control->{'content'} if $control->{'content'};
+ }
+ }
+ }
+ }##tag
+}## if tag is mapped
+return "";
+}
+sub XML_readline_asarray{
+my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
+#$xml represents one record of MARCXML as perlhashed
+## returns an array of read fields--useful for readind repeated fields
+### $recordtype is needed for mapping the correct field if supplied
+### If only $tag is give reads the whole tag
+my @value;
+ ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
+if ($tag){
+my $biblio=$xml->{'datafield'};
+my $controlfields=$xml->{'controlfield'};
+my $leader=$xml->{'leader'};
+ if ($tag>9){
+ foreach my $data (@$biblio){
+ if ($data->{'tag'} eq $tag){
+ foreach my $subfield ( $data->{'subfield'}){
+ foreach my $code ( @$subfield){
+ if ($code->{'code'} eq $subf || !$subf){
+ push @value, $code->{'content'};
+ }
+ }
+ }
+ }
+ }
+ }else{
+ if ($tag eq "000" || $tag eq "LDR"){
+ push @value, $leader->[0] if $leader->[0];
+ }else{
+ foreach my $control (@$controlfields){
+ if ($control->{'tag'} eq $tag){
+ push @value, $control->{'content'} if $control->{'content'};
+ }
+ }
+ }
+ }##tag
+}## if tag is mapped
+return @value;
+}
sub XML_readline{
-my ($xml,$kohafield,$recordtype)=@_;
+my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
#$xml represents one record node hashed of holdings or a complete xml koharecord
### $recordtype is needed for reading the child records( like holdings records) .Otherwise main record is assumed ( like biblio)
## holding records are parsed and sent here one by one
-my ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype);
+# If kohafieldname given find tag
+
+($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
my @itemresults;
if ($tag){
if ($recordtype eq "holdings"){
foreach my $subfield ( $data->{'subfield'}){
foreach my $code ( @$subfield){
if ($code->{'code'} eq $subf){
- return Encode::decode("UTF-8",$code->{content});
+ return $code->{content};
}
}
}
}else{
foreach my $control (@$hcontrolfield){
if ($control->{'tag'} eq $tag){
- return Encode::decode("UTF-8",$control->{'content'});
+ return $control->{'content'};
}
}
}##tag
foreach my $subfield ( $data->{'subfield'}){
foreach my $code ( @$subfield){
if ($code->{'code'} eq $subf){
- return Encode::decode("UTF-8",$code->{'content'});
+ return $code->{'content'};
}
}
}
foreach my $control (@$controlfields){
if ($control->{'tag'} eq $tag){
- return Encode::decode("UTF-8",$control->{'content'}) if $control->{'content'};
+ return $control->{'content'}if $control->{'content'};
}
}
}##tag
}
sub XML_writeline{
-## This routine modifies one line of marcxml record mainly useful for updating circulation data
-my ($xml,$kohafield,$newvalue,$recordtype)=@_;
-my $biblio=$xml->{'record'}->[0]->{'datafield'};
-my $controlfield=$xml->{'record'}->[0]->{'controlfield'};
-my ($tag,$subf)=MARCfind_kohafield($kohafield,$recordtype);
-my $updated=0;
+## This routine modifies one line of marcxml record hash
+my ($xml,$kohafield,$newvalue,$recordtype,$tag,$subf)=@_;
+$newvalue= Encode::decode('utf8',$newvalue) if $newvalue;
+my $biblio=$xml->{'datafield'};
+my $controlfield=$xml->{'controlfield'};
+ ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
+my $updated;
if ($tag>9){
foreach my $data (@$biblio){
if ($data->{'tag'} eq $tag){
my @subfields=$data->{'subfield'};
+ my @newsubs;
foreach my $subfield ( @subfields){
foreach my $code ( @$subfield){
if ($code->{'code'} eq $subf){
- $code->{content}=$newvalue;
+ $code->{'content'}=$newvalue;
$updated=1;
}
+ push @newsubs,$code;
}
}
if (!$updated){
- push @subfields,{code=>$subf,content=>$newvalue};
- $data->{subfield}= \@subfields;
-
+ push @newsubs,{code=>$subf,content=>$newvalue};
+ $data->{subfield}= \@newsubs;
+ $updated=1;
}
}
}
- ## Tag did not exist
- if (!$updated){
- push @$biblio,{datafield=>[{
- 'ind1' => ' ',
- 'ind2' => ' ',
- 'subfield' => [
- {
- 'content' => $newvalue,
- 'code' => $subf
- }
- ],
- 'tag' => $tag
- }]
- };
- }## created now
- }else{
- foreach my $control(@$controlfield){
+ ## Tag did not exist
+ if (!$updated){
+ if ($subf){
+ push @$biblio,
+ {
+ 'ind1' => ' ',
+ 'ind2' => ' ',
+ 'subfield' => [
+ {
+ 'content' =>$newvalue,
+ 'code' => $subf
+ }
+ ],
+ 'tag' =>$tag
+ } ;
+ }else{
+ push @$biblio,
+ {
+ 'ind1' => ' ',
+ 'ind2' => ' ',
+ 'tag' =>$tag
+ } ;
+ }
+ }## created now
+ }elsif ($tag>0){
+ foreach my $control (@$controlfield){
if ($control->{'tag'} eq $tag){
$control->{'content'}=$newvalue;
$updated=1;
return $xml;
}
+sub XML_writeline_id {
+### This routine is similar to XML_writeline but replaces a given value and do not create a new field
+## Useful for repeating fields
+## Currently usedin authorities
+my ($xml,$oldvalue,$newvalue,$tag,$subf)=@_;
+$newvalue= Encode::decode('utf8',$newvalue) if $newvalue;
+my $biblio=$xml->{'datafield'};
+my $controlfield=$xml->{'controlfield'};
+ if ($tag>9){
+ foreach my $data (@$biblio){
+ if ($data->{'tag'} eq $tag){
+ my @subfields=$data->{'subfield'};
+ foreach my $subfield ( @subfields){
+ foreach my $code ( @$subfield){
+ if ($code->{'code'} eq $subf && $code->{'content'} eq $oldvalue){
+ $code->{'content'}=$newvalue;
+ }
+ }
+ }
+ }
+ }
+ }else{
+ foreach my $control(@$controlfield){
+ if ($control->{'tag'} eq $tag && $control->{'content'} eq $oldvalue ){
+ $control->{'content'}=$newvalue;
+ }
+ }
+ }
+return $xml;
+}
+
sub XML_xml2hash{
##make a perl hash from xml file
my ($xml)=@_;
return $hashed;
}
+sub XML_separate{
+##Separates items from biblio
+my $hashed=shift;
+my $biblio=$hashed->{record}->[0];
+my @items;
+my $items=$hashed->{holdings}->[0]->{record};
+foreach my $item (@$items){
+ push @items,$item;
+}
+return ($biblio,@items);
+}
+
+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;
+}
sub XML_hash2xml{
## turn a hash back to xml
my ($hashed,$root)=@_;
$root="record" unless $root;
-my $xml= XMLout($hashed,KeyAttr=>['collection','record','leader','controlfıeld','datafield'],NoSort => 1,AttrIndent => 0,KeepRoot=>0,SuppressEmpty => 1,RootName=>$root);
+my $xml= XMLout($hashed,KeyAttr=>['leader','controlfıeld','datafield'],NoSort => 1,AttrIndent => 0,KeepRoot=>0,SuppressEmpty => 1,RootName=>$root );
return $xml;
}
+
sub XMLgetbiblio {
# Returns MARC::XML of the biblionumber passed in parameter.
my ( $dbh, $biblionumber ) = @_;
my $sth = $dbh->prepare("select marcxml from biblio where biblionumber=? " );
$sth->execute( $biblionumber);
my ($marcxml)=$sth->fetchrow;
+ $marcxml=Encode::decode('utf8',$marcxml);
return ($marcxml);
}
+sub XMLgetbibliohash{
+## Utility to return s hashed MARCXML
+my ($dbh,$biblionumber)=@_;
+my $xml=XMLgetbiblio($dbh,$biblionumber);
+my $xmlhash=XML_xml2hash_onerecord($xml);
+return $xmlhash;
+}
+
sub XMLgetitem {
# Returns MARC::XML of the item passed in parameter uses either itemnumber or barcode
my ( $dbh, $itemnumber,$barcode ) = @_;
$sth->execute($barcode);
}
my ($marcxml)=$sth->fetchrow;
+$marcxml=Encode::decode('utf8',$marcxml);
return ($marcxml);
}
+sub XMLgetitemhash{
+## Utility to return s hashed MARCXML
+ my ( $dbh, $itemnumber,$barcode ) = @_;
+my $xml=XMLgetitem( $dbh, $itemnumber,$barcode);
+my $xmlhash=XML_xml2hash_onerecord($xml);
+return $xmlhash;
+}
+
sub XMLgetallitems {
# warn "XMLgetallitems";
$sth->execute($biblionumber);
while(my ($marcxml)=$sth->fetchrow_array){
+$marcxml=Encode::decode('utf8',$marcxml);
push @results,$marcxml;
}
return @results;
sub XMLmarc2koha {
# warn "XMLmarc2koha";
-##Returns two hashes from KOHA_XML record
+##Returns two hashes from KOHA_XML record hashed
## A biblio hash and and array of item hashes
my ($dbh,$xml,$related_record,@fields) = @_;
my ($result,@items);
}
}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;
return ($result,@items);
}
+sub XMLmarc2koha_onerecord {
+# warn "XMLmarc2koha_onerecord";
+##Returns a koha hash from MARCXML hash
+
+ my ($dbh,$xml,$related_record,@fields) = @_;
+ my ($result);
+
+## if @fields is given do not bother about the rest of fields just parse those
+
+ if (@fields){
+ foreach my $field(@fields){
+ my $val=&XML_readline_onerecord($xml,$field,$related_record);
+ $result->{$field}=$val if $val;
+ }
+ }else{
+ 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) {
+ $result->{$field}=&XML_readline_onerecord($xml,$field,$related_record);
+ }
+ }
+ return ($result);
+}
+
+sub XMLmodLCindex{
+# warn "XMLmodLCindex";
+my ($dbh,$xmlhash)=@_;
+my ($lc)=XML_readline_onerecord($xmlhash,"classification","biblios");
+my ($cutter)=XML_readline_onerecord($xmlhash,"subclass","biblios");
+
+ if ($lc){
+ $lc.=$cutter;
+ my ($lcsort)=calculatelc($lc);
+ $xmlhash=XML_writeline($xmlhash,"lcsort",$lcsort,"biblios");
+ }
+return $xmlhash;
+}
+
+sub XMLmoditemonefield{
+# This routine takes itemnumber and biblionumber and updates XMLmarc;
+### the ZEBR DB update can wait depending on $donotupdate flag
+my ($dbh,$biblionumber,$itemnumber,$itemfield,$newvalue,$donotupdate)=@_;
+my ($record) = XMLgetitem($dbh,$itemnumber);
+ my $recordhash=XML_xml2hash_onerecord($record);
+ XML_writeline( $recordhash, $itemfield, $newvalue,"holdings" );
+ if($donotupdate){
+ ## Prevent various update calls to zebra wait until all changes finish
+ $record=XML_hash2xml($recordhash);
+ my $sth=$dbh->prepare("update items set marcxml=? where itemnumber=?");
+ $sth->execute($record,$itemnumber);
+ $sth->finish;
+ }else{
+ NEWmoditem($dbh,$recordhash,$biblionumber,$itemnumber);
+ }
+
+}
+
+sub XMLkoha2marc {
+# warn "MARCkoha2marc";
+## This routine is still used for acqui management
+##Returns a XML recordhash from a kohahash
+ my ($dbh,$result,$recordtype) = @_;
+###create a basic MARCXML
+# find today's date
+my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
+ $year += 1900;
+ $mon += 1;
+ my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",
+ $year,$mon,$mday,$hour,$min,$sec);
+$year=substr($year,2,2);
+ my $accdate=sprintf("%2d%02d%02d",$year,$mon,$mday);
+my ($titletag,$titlesubf)=MARCfind_marc_from_kohafield("title","biblios");
+##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 kohafield from koha_attr where tagfield is not null and recordtype=?");
+ $sth2->execute($recordtype);
+ my $field;
+ while (($field)=$sth2->fetchrow) {
+ $record=XML_writeline($record,$field,$result->{$field},$recordtype) if $result->{$field};
+ }
+return $record;
+}
#
#
# MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
#
-## Script to deal with MARC read write operations
+## Script to deal with MARCXML related tables
##Sub to match kohafield to Z3950 -attributes
-sub MARCgetbiblio {
- # Returns MARC::Record of the biblio passed in parameter.
- ### Takes a new parameter of $title_author =1 which parses the record obly on those fields and nothing else
- ### Its useful when Koha requires only title&author for performance issues
- my ( $dbh, $biblionumber, $title_author ) = @_;
- my $sth =
- $dbh->prepare("select marc from biblio where biblionumber=? " );
- $sth->execute( $biblionumber);
- my ($marc)=$sth->fetchrow;
-my $record;
- if ($title_author){
- $record = MARC::File::USMARC::decode($marc,\&func_title_author);
- }else{
- $record = MARC::File::USMARC::decode($marc);
- }
-$sth->finish;
- return $record;
-}
-
-
-
-
-
-sub MARCgetitem {
-# warn "MARCgetitem";
- # Returns MARC::Record of the item passed in parameter uses either itemnumber or barcode
- my ( $dbh, $itemnumber,$barcode ) = @_;
-my $sth;
-if ($itemnumber){
- $sth = $dbh->prepare("select i.marc from items i where i.itemnumber=?" );
- $sth->execute($itemnumber);
-}else{
- $sth = $dbh->prepare("select i.marc from items i where i.barcode=?" );
- $sth->execute($barcode);
-}
- my ($marc)=$sth->fetchrow;
- my $record = MARC::File::USMARC::decode($marc);
-
- return ($record);
-}
-
-sub MARCgetallitems {
-# warn "MARCgetallitems";
- # Returns an array of MARC::Record of the items passed in parameter as biblionumber
- my ( $dbh, $biblionumber ) = @_;
-my @results;
-my $sth = $dbh->prepare("select marc from items where biblionumber =?" );
- $sth->execute($biblionumber);
-
- while(my ($marc)=$sth->fetchrow_array){
- my $record = MARC::File::USMARC::decode($marc);
- push @results,$record;
-}
-return @results;
-}
-
-sub MARCmoditemonefield{
-# This routine will be depraeciated as soon as mysql dependency on items is removed;
-## this function is different to MARCkoha2marcOnefield this one does not need the record but the itemnumber
-my ($dbh,$biblionumber,$itemnumber,$itemfield,$newvalue,$donotupdate)=@_;
-my ($record) = MARCgetitem($dbh,$itemnumber);
- MARCkoha2marcOnefield( $record, $itemfield, $newvalue,"holdings" );
- if($donotupdate){
- ## Prevent various update calls to zebra wait until all changes finish
- ## Fix to pass this record around to prevent Mysql update as well
- my $sth=$dbh->prepare("update items set marc=? where itemnumber=?");
- $sth->execute($record->as_usmarc,$itemnumber);
- $sth->finish;
- }else{
- NEWmoditem($dbh,$record,$biblionumber,$itemnumber);
-}
-
-}
-
-
-
sub MARCfind_frameworkcode {
# warn "MARCfind_frameworkcode";
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)){
- $j++ unless (@$tags[$i] eq "");
+ 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){
$xml.="</datafield>\n";
- if ((@$tags[$i] > 10) && (@$values[$i] ne "")){
+ if (($tag> 10) && (@$values[$i] ne "")){
my $ind1 = substr(@$indicator[$j],0,1);
my $ind2 = substr(@$indicator[$j],1,1);
- $xml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
+ $xml.="<datafield tag=\"$tag\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
$xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
$first=0;
} else {
$first=1;
}
- } else {
+ } else {
if (@$values[$i] ne "") {
# leader
- if (@$tags[$i] eq "000") {
+ if ($tag eq "000") {
+ ##Force the leader to UTF8
+ substr(@$values[$i],9,1)="a";
$xml.="<leader>@$values[$i]</leader>\n";
$first=1;
# rest of the fixed fields
- } elsif (@$tags[$i] < 10) {
- $xml.="<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
+ } elsif ($tag < 10) {
+ $xml.="<controlfield tag=\"$tag\">@$values[$i]</controlfield>\n";
$first=1;
} else {
my $ind1 = substr(@$indicator[$j],0,1);
my $ind2 = substr(@$indicator[$j],1,1);
- $xml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
+ $xml.="<datafield tag=\"$tag\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
$xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
$first=0;
}
}
}
} else { # @$tags[$i] eq $prevtag
- if (@$values[$i] eq "") {
- }
- else {
+ unless (@$values[$i] eq "") {
+ my $tag=@$tags[$i];
if ($first){
my $ind1 = substr(@$indicator[$j],0,1);
my $ind2 = substr(@$indicator[$j],1,1);
- $xml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
+ $xml.="<datafield tag=\"$tag\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
$first=0;
}
$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';
+##
return( <<MARC_XML_HEADER );
<?xml version="1.0" encoding="$enc"?>
-<record
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+<record xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
xmlns="http://www.loc.gov/MARC21/slim">
MARC_XML_HEADER
KOHA_XML_HEADER
}
-sub MARChtml2marc {
-# warn "MARChtml2marc";
- my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
- my $prevtag = -1;
- my $record = MARC::Record->new();
-# my %subfieldlist=();
- my $prevvalue; # if tag <10
- my $field; # if tag >=10
- for (my $i=0; $i< @$rtags; $i++) {
- next unless @$rvalues[$i];
- # rebuild MARC::Record
-# # warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
- if (@$rtags[$i] ne $prevtag) {
- if ($prevtag < 10) {
- if ($prevvalue) {
-
- if ($prevtag ne '000') {
- $record->insert_fields_ordered((sprintf "%03s",$prevtag),$prevvalue);
- } else {
-
- $record->leader($prevvalue);
-
- }
- }
- } else {
- if ($field) {
- $record->insert_fields_ordered($field);
- }
- }
- $indicators{@$rtags[$i]}.=' ';
- if (@$rtags[$i] <10) {
- $prevvalue= @$rvalues[$i];
- undef $field;
- } else {
- undef $prevvalue;
- $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
-# # warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
- }
- $prevtag = @$rtags[$i];
- } else {
- if (@$rtags[$i] <10) {
- $prevvalue=@$rvalues[$i];
- } else {
- if (length(@$rvalues[$i])>0) {
- $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
-# # warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
- }
- }
- $prevtag= @$rtags[$i];
- }
- }
- # the last has not been included inside the loop... do it now !
- $record->insert_fields_ordered($field) if $field;
-# # warn "HTML2MARC=".$record->as_formatted;
- $record->encoding( 'UTF-8' );
-# $record->MARC::File::USMARC::update_leader();
- return $record;
-}
-sub MARCkoha2marc {
-# warn "MARCkoha2marc";
-## This routine most probably will be depreaceated -- it is still used for acqui management
-##Returns a MARC record from a hash
- my ($dbh,$result,$recordtype) = @_;
- my $record = MARC::Record->new();
- my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where tagfield is not null and recordtype=?");
- $sth2->execute($recordtype);
- my $field;
- while (($field)=$sth2->fetchrow) {
- $record=&MARCkoha2marcOnefield($record,$field,$result->{$field},$recordtype) if $result->{$field};
- }
-return $record;
-}
-sub MARCmarc2koha {
-# warn "MARCmarc2koha";
-##Returns a hash from MARC record
- my ($dbh,$record,$related_record) = @_;
- my $result;
-if (!$related_record){$related_record="biblios";}
- my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like ? and tagfield is not null" );
- $sth2->execute($related_record);
- my $field;
- while ($field=$sth2->fetchrow) {
- $result=&MARCmarc2kohaOneField($field,$record,$result,$related_record);
- }
-## we only need the following for biblio data
-if ($related_record eq "biblios"){
-# modify copyrightdate to keep only the 1st year found
- my $temp = $result->{'copyrightdate'};
- $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
- if ($1>0) {
- $result->{'copyrightdate'} = $1;
- } else { # if no cYYYY, get the 1st date.
- $temp =~ m/(\d\d\d\d)/;
- $result->{'copyrightdate'} = $1;
- }
-# modify publicationyear to keep only the 1st year found
- $temp = $result->{'publicationyear'};
- $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
- if ($1>0) {
- $result->{'publicationyear'} = $1;
- } else { # if no cYYYY, get the 1st date.
- $temp =~ m/(\d\d\d\d)/;
- $result->{'publicationyear'} = $1;
- }
-}
- return $result;
-}
-
-sub MARCkoha2marcOnefield {
-##Updates or creates one field in MARC record
- my ( $record, $kohafieldname, $value,$recordtype ) = @_;
-my ( $tagfield, $tagsubfield ) = MARCfind_marc_from_kohafield($kohafieldname,$recordtype);
-if ($tagfield){
-my $tag = $record->field($tagfield);
- if ( $tagfield>9) {
- if ($tag) {
- if ($value){## We may be trying to delete a subfield value
- $tag->update( $tagsubfield=> $value );
- }else{
- $tag->delete_subfield(code=>$tagsubfield);
- }
- $record->delete_field($tag);
- $record->insert_fields_ordered($tag);
- }else {
- my $newtag=MARC::Field->new( $tagfield, " ", " ", $tagsubfield => $value);
- $record->insert_fields_ordered($newtag);
- }
- }else {
- if ($tag) {
- if ($value){
- $tag->update( $value );
- $record->delete_field($tag);
- $record->insert_fields_ordered($tag);
- }else{
- $record->delete_field($tag);
- }
- }else {
- my $newtag=MARC::Field->new( $tagfield => $value);
- $record->insert_fields_ordered($newtag);
- }
- }
-}## $tagfield defined
- return $record;
-}
-
-sub MARCmarc2kohaOneField {
- my ( $kohafield, $record, $result,$recordtype ) = @_;
- # # warn "kohatable / $kohafield / $result / ";
- my $res = "";
-
- my ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield($kohafield,$recordtype);
-if ($tagfield){
- foreach my $field ( $record->field($tagfield) ) {
- if ($field->tag()<10) {
- if ($result->{$kohafield}) {
- $result->{$kohafield} .= " | ".$field->data();
- } else {
- $result->{$kohafield} = $field->data();
- }
- } else {
- if ( $field->subfields ) {
- my @subfields = $field->subfields();
- foreach my $subfieldcount ( 0 .. $#subfields ) {
- if ($subfields[$subfieldcount][0] eq $subfield) {
- if ( $result->{$kohafield} ) {
- $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
- }
- else {
- $result->{$kohafield} = $subfields[$subfieldcount][1];
- }
- }
- }
- }
- }
- }
-}
- return $result;
-}
-sub MARCmodLCindex{
-# warn "MARCmodLCindex";
-my ($dbh,$record)=@_;
-my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield("classification","biblios");
-my ($tagfield2,$tagsubfieldsub) = MARCfind_marc_from_kohafield("subclass","biblios");
-my $tag=$record->field($tagfield);
-if ($tag){
-my ($lcsort)=calculatelc($tag->subfield($tagsubfield)).$tag->subfield($tagsubfieldsub);
- &MARCkoha2marcOnefield( $record, "lcsort", $lcsort,"biblios");
-}
-return $record;
-}
##########################NEW NEW NEW#############################
sub NEWnewbiblio {
- my ( $dbh, $record, $frameworkcode) = @_;
- my $biblionumber;
+ my ( $dbh, $xml, $frameworkcode) = @_;
$frameworkcode="" unless $frameworkcode;
- my $olddata = MARCmarc2koha( $dbh, $record,"biblios" );
+my $biblionumber=XML_readline_onerecord($xml,"biblionumber","biblios");
## In case reimporting records with biblionumbers keep them
-if ($olddata->{'biblionumber'}){
-$biblionumber=NEWmodbiblio( $dbh, $olddata->{'biblionumber'},$record,$frameworkcode );
+if ($biblionumber){
+$biblionumber=NEWmodbiblio( $dbh, $biblionumber,$xml,$frameworkcode );
}else{
- $biblionumber = NEWaddbiblio( $dbh, $record,$frameworkcode );
+ $biblionumber = NEWaddbiblio( $dbh, $xml,$frameworkcode );
}
return ( $biblionumber );
sub NEWdelbiblio {
-
my ( $dbh, $biblionumber ) = @_;
-my $sth=$dbh->prepare("SELECT itemnumber FROM items where biblionumber=?");
-
-$sth->execute($biblionumber);
- while (my $itemnumber =$sth->fetchrow){
- OLDdelitem($dbh,$itemnumber) ;
- }
-
- ZEBRAop($dbh,$biblionumber,"recordDelete","biblioserver");
-OLDdelbiblio($dbh,$biblionumber) ;
-
+ZEBRAop($dbh,$biblionumber,"recordDelete","biblioserver");
}
+
sub NEWnewitem {
- my ( $dbh, $record, $biblionumber ) = @_;
+ my ( $dbh, $xmlhash, $biblionumber ) = @_;
my $itemtype= MARCfind_itemtype($dbh,$biblionumber);
- my $item = &MARCmarc2koha( $dbh, $record,"holdings" );
+
## In case we are re-importing marc records from bulk import do not change itemnumbers
-if ($item->{itemnumber}){
-NEWmoditem ( $dbh, $record, $biblionumber, $item->{itemnumber});
+my $itemnumber=XML_readline_onerecord($xmlhash,"itemnumber","holdings");
+if ($itemnumber){
+NEWmoditem ( $dbh, $xmlhash, $biblionumber, $itemnumber);
}else{
- $item->{'biblionumber'} =$biblionumber;
+
##Add biblionumber to $record
- MARCkoha2marcOnefield($record,"biblionumber",$biblionumber,"holdings");
+$xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"holdings");
my $sth=$dbh->prepare("select notforloan from itemtypes where itemtype='$itemtype'");
$sth->execute();
my $notforloan=$sth->fetchrow;
##Change the notforloan field if $notforloan found
if ($notforloan >0){
- $item->{'notforloan'}=$notforloan;
- &MARCkoha2marcOnefield($record,"notforloan",$notforloan,"holdings");
+ $xmlhash=XML_writeline($xmlhash,"notforloan",$notforloan,"holdings");
}
-if(!$item->{'dateaccessioned'}||$item->{'dateaccessioned'} eq ''){
+my $dateaccessioned=XML_readline_onerecord($xmlhash,"dateaccessioned","holdings");
+unless($dateaccessioned){
# find today's date
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time); $year +=1900; $mon +=1;
my $date = "$year-".sprintf ("%0.2d", $mon)."-".sprintf("%0.2d",$mday);
-$item->{'dateaccessioned'}=$date;
-&MARCkoha2marcOnefield($record,"dateaccessioned",$date,"holdings");
+
+$xmlhash=XML_writeline($xmlhash,"dateaccessioned",$date,"holdings");
}
-## Now calculate itempart of cutter
-my ($cutterextra)=itemcalculator($dbh,$item->{'biblionumber'},$item->{'itemcallnumber'});
-&MARCkoha2marcOnefield($record,"cutterextra",$cutterextra,"holdings");
+## Now calculate itempart of cutter-- This is NEU specific
+my $itemcallnumber=XML_readline_onerecord($xmlhash,"itemcallnumber","holdings");
+if ($itemcallnumber){
+my ($cutterextra)=itemcalculator($dbh,$biblionumber,$itemcallnumber);
+$xmlhash=XML_writeline($xmlhash,"cutterextra",$cutterextra,"holdings");
+}
##NEU specific add cataloguers cardnumber as well
-my ($tag,$cardtag)=MARCfind_marc_from_kohafield("circid","holdings");
- if ($tag && $cardtag){
- my $me= C4::Context->userenv;
- my $cataloguer=$me->{'cardnumber'} if ($me);
- my $newtag= $record->field($tag);
- $newtag->update($cardtag=>$cataloguer) if ($me);
- $record->delete_field($newtag);
- $record->insert_fields_ordered($newtag);
- }
+my $me= C4::Context->userenv;
+my $cataloger=$me->{'cardnumber'} if ($me);
+$xmlhash=XML_writeline($xmlhash,"circid",$cataloger,"holdings") if $cataloger;
+
##Add item to SQL
-my $itemnumber = &OLDnewitems( $dbh, $item->{barcode},$record );
+my $itemnumber = &OLDnewitems( $dbh, $xmlhash );
# add the item to zebra it will add the biblio as well!!!
ZEBRAop( $dbh, $biblionumber,"specialUpdate","biblioserver" );
sub NEWmoditem{
- my ( $dbh, $record, $biblionumber, $itemnumber ) = @_;
-##Get a hash of this record as well
-my $item=MARCmarc2koha($dbh,$record,"holdings");
-##Add itemnumber incase lost (old bug 090c was lost) --just incase
-my ( $tagfield, $tagsubfield ) =MARCfind_marc_from_kohafield("itemnumber","holdings");
- my $newfield;
-my $old_field = $record->field($tagfield);
-if ($tagfield<10){
- $newfield = MARC::Field->new($tagfield, $itemnumber);
-}else{
- if ($old_field){
- $old_field->update($tagsubfield=>$biblionumber);
- $newfield=$old_field->clone();
- }else{
- $newfield = MARC::Field->new($tagfield, '', '', "$tagsubfield" => $itemnumber);
- }
-}
- # drop old field and create new one...
-
- $record->delete_field($old_field);
- $record->insert_fields_ordered($newfield);
+ my ( $dbh, $xmlhash, $biblionumber, $itemnumber ) = @_;
+
+##Add itemnumber incase lost (old bug 090c was lost sometimes) --just incase
+$xmlhash=XML_writeline($xmlhash,"itemnumber",$itemnumber,"holdings");
##Add biblionumber incase lost on html
-my ( $tagfield, $tagsubfield ) =MARCfind_marc_from_kohafield("biblionumber","holdings");
- my $newfield;
-my $old_field = $record->field($tagfield);
-if ($tagfield<10){
- $newfield = MARC::Field->new($tagfield, $biblionumber);
-}else{
- if ($old_field){
- $old_field->update($tagsubfield=>$biblionumber);
- $newfield=$old_field->clone();
- }else{
- $newfield = MARC::Field->new($tagfield, '', '', "$tagsubfield" => $biblionumber);
- }
-}
- # drop old field and create new one...
- $record->delete_field($old_field);
- $record->insert_fields_ordered($newfield);
-
-###NEU specific add cataloguers cardnumber as well
-my ($tag,$cardtag)=MARCfind_marc_from_kohafield("circid","holdings");
-if ($tag && $cardtag){
+$xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"holdings");
+##Read barcode
+my $barcode=XML_readline_onerecord($xmlhash,"barcode","holdings");
+## Now calculate itempart of cutter-- This is NEU specific
+my $itemcallnumber=XML_readline_onerecord($xmlhash,"itemcallnumber","holdings");
+if ($itemcallnumber){
+my ($cutterextra)=itemcalculator($dbh,$biblionumber,$itemcallnumber);
+$xmlhash=XML_writeline($xmlhash,"cutterextra",$cutterextra,"holdings");
+}
+
+##NEU specific add cataloguers cardnumber as well
my $me= C4::Context->userenv;
my $cataloger=$me->{'cardnumber'} if ($me);
-my $oldtag=$record->field($tag);
- if (!$oldtag){
- my $newtag= MARC::Field->new($tag, '', '', $cardtag => $cataloger) if ($me);
- $record->insert_fields_ordered($newtag);
- }else{
- $oldtag->update($cardtag=>$cataloger) if ($me);
- $record->delete_field($oldtag);
- $record->insert_fields_ordered($oldtag);
- }
-}
-## We must add the indexing fields for LC Cutter in MARC record in case it changed
-my ($cutterextra)=itemcalculator($dbh,$biblionumber,$item->{'itemcallnumber'});
-MARCkoha2marcOnefield($record,"cutterextra",$cutterextra,"holdings");
- OLDmoditem( $dbh, $record,$biblionumber,$itemnumber,$item->{barcode} );
+$xmlhash=XML_writeline($xmlhash,"circid",$cataloger,"holdings") if $cataloger;
+my $xml=XML_hash2xml($xmlhash);
+ OLDmoditem( $dbh, $xml,$biblionumber,$itemnumber,$barcode );
ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
}
sub NEWdelitem {
- my ( $dbh, $itemnumber ) = @_;
-
+ my ( $dbh, $itemnumber ) = @_;
my $sth=$dbh->prepare("SELECT biblionumber from items where itemnumber=?");
$sth->execute($itemnumber);
my $biblionumber=$sth->fetchrow;
OLDdelitem( $dbh, $itemnumber ) ;
-ZEBRAop($dbh,$biblionumber,"recordDelete","biblioserver");
+ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
}
sub NEWaddbiblio {
- my ( $dbh, $record,$frameworkcode ) = @_;
+ my ( $dbh, $xmlhash,$frameworkcode ) = @_;
my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
$sth->execute;
my $data = $sth->fetchrow;
my $biblionumber = $data + 1;
$sth->finish;
- # we must add biblionumber MARC::Record...
- my ( $tagfield, $tagsubfield ) =MARCfind_marc_from_kohafield("biblionumber","biblios");
- my $newfield;
-if ($tagfield<10){
- $newfield = MARC::Field->new($tagfield, $biblionumber);
-}else{
- $newfield = MARC::Field->new($tagfield, '', '', "$tagsubfield" => "$biblionumber");
-}
- # drop old field and create new one..
- $record->delete_field($newfield);
- $record->insert_fields_ordered($newfield);
+ # we must add biblionumber
+my $record;
+$xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"biblios");
###NEU specific add cataloguers cardnumber as well
-my ($tag,$cardtag)=MARCfind_marc_from_kohafield("indexedby","biblios");
-if ($tag && $cardtag){
+
my $me= C4::Context->userenv;
my $cataloger=$me->{'cardnumber'} if ($me);
-my $oldtag=$record->field($tag);
- if (!$oldtag){
- my $newtag= MARC::Field->new($tag, '', '', $cardtag => $cataloger) if ($me);
- $record->insert_fields_ordered($newtag);
- }else{
- $oldtag->update($cardtag=>$cataloger) if ($me);
- $record->delete_field($oldtag);
- $record->insert_fields_ordered($oldtag);
- }
-}
+$xmlhash=XML_writeline($xmlhash,"indexedby",$cataloger,"biblios") if $cataloger;
+
## We must add the indexing fields for LC in MARC record--TG
- &MARCmodLCindex($dbh,$record);
+&XMLmodLCindex($dbh,$xmlhash);
##Find itemtype
- ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("itemtype","biblios");
-my $itemtype=$record->field($tagfield)->subfield($tagsubfield) if ($record->field($tagfield));
+my $itemtype=XML_readline_onerecord($xmlhash,"itemtype","biblios");
##Find ISBN
-($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("isbn","biblios") ;
-my $isbn=$record->field($tagfield)->subfield($tagsubfield) if ($record->field($tagfield));
+my $isbn=XML_readline_onerecord($xmlhash,"isbn","biblios");
##Find ISSN
-($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("issn","biblios") ;
-my $issn=$record->field($tagfield)->subfield($tagsubfield) if ($record->field($tagfield));
- $sth = $dbh->prepare("insert into biblio set biblionumber = ?, marc = ?, frameworkcode=?, itemtype=?,marcxml=?,title=?,author=?,isbn=?,issn=?" );
- $sth->execute( $biblionumber, $record->as_usmarc,$frameworkcode, $itemtype,MARC::File::XML::record( $record ) ,$record->title(),$record->author,$isbn,$issn );
+my $issn=XML_readline_onerecord($xmlhash,"issn","biblios");
+##Find Title
+my $title=XML_readline_onerecord($xmlhash,"title","biblios");
+##Find Author
+my $author=XML_readline_onerecord($xmlhash,"title","biblios");
+my $xml=XML_hash2xml($xmlhash);
+
+ $sth = $dbh->prepare("insert into biblio set biblionumber = ?,frameworkcode=?, itemtype=?,marcxml=?,title=?,author=?,isbn=?,issn=?" );
+ $sth->execute( $biblionumber,$frameworkcode, $itemtype,$xml ,$title,$author,$isbn,$issn );
$sth->finish;
### Do not add biblio to ZEBRA unless there is an item with it -- depends on system preference defaults to NO
}
sub NEWmodbiblio {
- my ( $dbh, $biblionumber,$record,$frameworkcode ) = @_;
+ my ( $dbh, $biblionumber,$xmlhash,$frameworkcode ) = @_;
##Add biblionumber incase lost on html
-my ( $tagfield, $tagsubfield ) =MARCfind_marc_from_kohafield("biblionumber","biblios");
- my $newfield;
-if ($tagfield<10){
- $newfield = MARC::Field->new($tagfield, $biblionumber);
-}else{
- $newfield = MARC::Field->new($tagfield, '', '', "$tagsubfield" => $biblionumber);
-}
- # drop old field and create new one...
- my $old_field = $record->field($tagfield);
- $record->delete_field($old_field);
- $record->insert_fields_ordered($newfield);
+
+$xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"biblios");
###NEU specific add cataloguers cardnumber as well
-my ($tag,$cardtag)=MARCfind_marc_from_kohafield("indexedby","biblios");
-if ($tag && $cardtag){
my $me= C4::Context->userenv;
my $cataloger=$me->{'cardnumber'} if ($me);
-my $oldtag=$record->field($tag);
- if (!$oldtag){
- my $newtag= MARC::Field->new($tag, '', '', $cardtag => $cataloger) if ($me);
- $record->insert_fields_ordered($newtag);
- }else{
- $oldtag->update($cardtag=>$cataloger) if ($me);
- $record->delete_field($oldtag);
- $record->insert_fields_ordered($oldtag);
- }
-}
+
+$xmlhash=XML_writeline($xmlhash,"indexedby",$cataloger,"biblios") if $cataloger;
+
## We must add the indexing fields for LC in MARC record--TG
- MARCmodLCindex($dbh,$record);
- OLDmodbiblio ($dbh,$record,$biblionumber,$frameworkcode);
+
+ XMLmodLCindex($dbh,$xmlhash);
+ OLDmodbiblio ($dbh,$xmlhash,$biblionumber,$frameworkcode);
my $ok=ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
return ($biblionumber);
}
sub OLDnewitems {
- my ( $dbh, $barcode,$record) = @_;
+ my ( $dbh, $xmlhash) = @_;
my $sth = $dbh->prepare("SELECT max(itemnumber) from items");
my $data;
my $itemnumber;
$data = $sth->fetchrow_hashref;
$itemnumber = $data->{'max(itemnumber)'} + 1;
$sth->finish;
- &MARCkoha2marcOnefield( $record, "itemnumber", $itemnumber,"holdings" );
- my ($biblionumbertag,$subf)=MARCfind_marc_from_kohafield( "biblionumber","holdings");
-
-my $biblionumber;
- if ($biblionumbertag <10){
- $biblionumber=$record->field($biblionumbertag)->data();
- }else{
- $biblionumber=$record->field($biblionumbertag)->subfield($subf);
- }
- $sth = $dbh->prepare( "Insert into items set itemnumber = ?, biblionumber = ?,barcode = ?,marc=? ,marcxml=?" );
- $sth->execute($itemnumber,$biblionumber,$barcode,$record->as_usmarc(),MARC::File::XML::record( $record));
+ $xmlhash=XML_writeline( $xmlhash, "itemnumber", $itemnumber,"holdings" );
+my $biblionumber=XML_readline_onerecord($xmlhash,"biblionumber","holdings");
+ my $barcode=XML_readline_onerecord($xmlhash,"barcode","holdings");
+my $xml=XML_hash2xml($xmlhash);
+ $sth = $dbh->prepare( "Insert into items set itemnumber = ?, biblionumber = ?,barcode = ?,marcxml=?" );
+ $sth->execute($itemnumber,$biblionumber,$barcode,$xml);
return $itemnumber;
}
sub OLDmoditem {
- my ( $dbh, $record,$biblionumber,$itemnumber,$barcode ) = @_;
- my $sth =$dbh->prepare("replace items set biblionumber=?,marc=?,marcxml=?,barcode=? , itemnumber=?");
- $sth->execute($biblionumber,$record->as_usmarc(),MARC::File::XML::record( $record),$barcode,$itemnumber);
+ my ( $dbh, $xml,$biblionumber,$itemnumber,$barcode ) = @_;
+ my $sth =$dbh->prepare("replace items set biblionumber=?,marcxml=?,barcode=? , itemnumber=?");
+ $sth->execute($biblionumber,$xml,$barcode,$itemnumber);
$sth->finish;
}
sub OLDmodbiblio {
# modifies the biblio table
-my ($dbh,$record,$biblionumber,$frameworkcode) = @_;
+my ($dbh,$xmlhash,$biblionumber,$frameworkcode) = @_;
if (!$frameworkcode){
$frameworkcode="";
}
-my ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("itemtype","biblios");
-my $itemtype=$record->field($tagfield)->subfield($tagsubfield) if ($record->field($tagfield));
-my ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("isbn","biblios");
-my $isbn=$record->field($tagfield)->subfield($tagsubfield) if ($record->field($tagfield));
-my ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("issn","biblios");
-my $issn=$record->field($tagfield)->subfield($tagsubfield) if ($record->field($tagfield));
+##Find itemtype
+my $itemtype=XML_readline_onerecord($xmlhash,"itemtype","biblios");
+##Find ISBN
+my $isbn=XML_readline_onerecord($xmlhash,"isbn","biblios");
+##Find ISSN
+my $issn=XML_readline_onerecord($xmlhash,"issn","biblios");
+##Find Title
+my $title=XML_readline_onerecord($xmlhash,"title","biblios");
+##Find Author
+my $author=XML_readline_onerecord($xmlhash,"author","biblios");
+my $xml=XML_hash2xml($xmlhash);
+
$isbn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g;
$issn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g;
$isbn=~s/^\s+|\s+$//g;
$isbn=substr($isbn,0,13);
- my $sth = $dbh->prepare("REPLACE biblio set biblionumber=?,marc=?,marcxml=?,frameworkcode=? ,itemtype=? , title=?,author=?,isbn=?,issn=?" );
- $sth->execute( $biblionumber,$record->as_usmarc() ,MARC::File::XML::record( $record), $frameworkcode,$itemtype, $record->title(),$record->author(),$isbn,$issn);
+ my $sth = $dbh->prepare("REPLACE biblio set biblionumber=?,marcxml=?,frameworkcode=? ,itemtype=? , title=?,author=?,isbn=?,issn=?" );
+ $sth->execute( $biblionumber ,$xml, $frameworkcode,$itemtype, $title,$author,$isbn,$issn);
$sth->finish;
return $biblionumber;
}
#
#
-sub ZEBRAopfiles{
-##Utility function to write an xml file to disk when the zebra server goes down
-my ($dbh,$biblionumber,$record,$folder,$server)=@_;
-#my $record = XMLgetbiblio($dbh,$biblionumber);
-my $op;
-my $zebradir = C4::Context->zebraconfig($server)->{directory}."/".$folder."/";
-my $zebraroot=C4::Context->zebraconfig($server)->{directory};
-my $serverbase=C4::Context->config($server);
- unless (opendir(DIR, "$zebradir")) {
-# warn "$zebradir not found";
- return;
- }
- closedir DIR;
- my $filename = $zebradir.$biblionumber;
-if ($record){
- open (OUTPUT,">", $filename.".xml");
- print OUTPUT $record;
- close OUTPUT;
+sub ZEBRAdelbiblio {
+## Zebra calls this routine to delete after it deletes biblio from ZEBRAddb
+ my ( $dbh, $biblionumber ) = @_;
+my $sth=$dbh->prepare("SELECT itemnumber FROM items where biblionumber=?");
+
+$sth->execute($biblionumber);
+ while (my $itemnumber =$sth->fetchrow){
+ OLDdelitem($dbh,$itemnumber) ;
+ }
+OLDdelbiblio($dbh,$biblionumber) ;
}
+sub ZEBRAgetrecord{
+my $biblionumber=shift;
+my @kohafield="biblionumber";
+my @value=$biblionumber;
+my ($count,@result)=C4::Search::ZEBRAsearch_kohafields(\@kohafield,\@value);
+
+ if ($count>0){
+ my ( $xmlrecord, @itemsrecord) = XML_separate($result[0]);
+ return ($xmlrecord, @itemsrecord);
+ }else{
+ return (undef,undef);
+ }
}
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;
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);
#
sub newbiblio {
-## Used in acqui management -- creates the biblio from hash rather than marc-record
+## Used in acqui management -- creates the biblio from koha hash
my ($biblio) = @_;
my $dbh = C4::Context->dbh;
-my $record=MARCkoha2marc($dbh,$biblio,"biblios");
-$record->encoding('UTF-8');
+my $record=XMLkoha2marc($dbh,$biblio,"biblios");
my $biblionumber=NEWnewbiblio($dbh,$record);
return ($biblionumber);
}
sub modbiblio {
-## Used in acqui management -- modifies the biblio from hash rather than marc-record
+## Used in acqui management -- modifies the biblio from koha hash rather than xml-hash
my ($biblio) = @_;
my $dbh = C4::Context->dbh;
-my $record=MARCkoha2marc($dbh,$biblio,"biblios");
+my $record=XMLkoha2marc($dbh,$biblio,"biblios");
my $biblionumber=NEWmodbiblio($dbh,$record,$biblio->{biblionumber});
return ($biblionumber);
}
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;
sub DisplayISBN {
## Old style ISBN handling should be modified to accept 13 digits
+
my ($isbn)=@_;
my $seg1;
if(substr($isbn, 0, 1) <=7) {
sub itemcalculator{
## Sublimentary function to obtain sorted LC for items. Not exported
my ($dbh,$biblionumber,$callnumber)=@_;
-my ($record,$frameworkcode)=MARCgetbiblio($dbh,$biblionumber);
-my $biblio=MARCmarc2koha($dbh,$record,$frameworkcode,"biblios");
-
-my $all=$biblio->{classification}." ".$biblio->{subclass};
+my $xmlhash=XMLgetbibliohash($dbh,$biblionumber);
+my $lc=XML_readline_onerecord($xmlhash,"classification","biblios");
+my $cutter=XML_readline_onerecord($xmlhash,"subclass","biblios");
+my $all=$lc." ".$cutter;
my $total=length($all);
my $cutterextra=substr($callnumber,$total);
-
return $cutterextra;
}
projects / koha-ffzg.git / blobdiff