2 # New XML API added by tgarip@neu.edu.tr 25/08/06
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
26 use vars qw($VERSION @ISA @EXPORT);
28 # set the version for version checking
33 # &itemcount removed, now resides in Search.pm
47 &NEWmodbiblioframework
50 &MARCfind_marc_from_kohafield
51 &MARCfind_frameworkcode
56 &MARCfind_attr_from_kohafield
66 &XML_xml2hash_onerecord
69 &XMLmarc2koha_onerecord
71 &XML_readline_onerecord
84 &ZEBRA_readyXML_noheader
92 #################### XML XML XML XML ###################
93 ### XML Read- Write functions
94 sub XML_readline_onerecord{
95 my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
96 #$xml represents one record of MARCXML as perlhashed
97 ### $recordtype is needed for mapping the correct field
98 ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
101 my $biblio=$xml->{'datafield'};
102 my $controlfields=$xml->{'controlfield'};
103 my $leader=$xml->{'leader'};
105 foreach my $data (@$biblio){
106 if ($data->{'tag'} eq $tag){
107 foreach my $subfield ( $data->{'subfield'}){
108 foreach my $code ( @$subfield){
109 if ($code->{'code'} eq $subf){
110 return $code->{'content'};
117 if ($tag eq "000" || $tag eq "LDR"){
118 return $leader->[0] if $leader->[0];
120 foreach my $control (@$controlfields){
121 if ($control->{'tag'} eq $tag){
122 return $control->{'content'} if $control->{'content'};
130 sub XML_readline_asarray{
131 my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
132 #$xml represents one record of MARCXML as perlhashed
133 ## returns an array of read fields--useful for readind repeated fields
134 ### $recordtype is needed for mapping the correct field if supplied
135 ### If only $tag is give reads the whole tag
137 ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
139 my $biblio=$xml->{'datafield'};
140 my $controlfields=$xml->{'controlfield'};
141 my $leader=$xml->{'leader'};
143 foreach my $data (@$biblio){
144 if ($data->{'tag'} eq $tag){
145 foreach my $subfield ( $data->{'subfield'}){
146 foreach my $code ( @$subfield){
147 if ($code->{'code'} eq $subf || !$subf){
148 push @value, $code->{'content'};
155 if ($tag eq "000" || $tag eq "LDR"){
156 push @value, $leader->[0] if $leader->[0];
158 foreach my $control (@$controlfields){
159 if ($control->{'tag'} eq $tag){
160 push @value, $control->{'content'} if $control->{'content'};
171 my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
172 #$xml represents one record node hashed of holdings or a complete xml koharecord
173 ### $recordtype is needed for reading the child records( like holdings records) .Otherwise main record is assumed ( like biblio)
174 ## holding records are parsed and sent here one by one
175 # If kohafieldname given find tag
177 ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
180 if ($recordtype eq "holdings"){
181 my $item=$xml->{'datafield'};
182 my $hcontrolfield=$xml->{'controlfield'};
184 foreach my $data (@$item){
185 if ($data->{'tag'} eq $tag){
186 foreach my $subfield ( $data->{'subfield'}){
187 foreach my $code ( @$subfield){
188 if ($code->{'code'} eq $subf){
189 return $code->{content};
196 foreach my $control (@$hcontrolfield){
197 if ($control->{'tag'} eq $tag){
198 return $control->{'content'};
203 }else{ ##Not a holding read biblio
204 my $biblio=$xml->{'record'}->[0]->{'datafield'};
205 my $controlfields=$xml->{'record'}->[0]->{'controlfield'};
207 foreach my $data (@$biblio){
208 if ($data->{'tag'} eq $tag){
209 foreach my $subfield ( $data->{'subfield'}){
210 foreach my $code ( @$subfield){
211 if ($code->{'code'} eq $subf){
212 return $code->{'content'};
220 foreach my $control (@$controlfields){
221 if ($control->{'tag'} eq $tag){
222 return $control->{'content'}if $control->{'content'};
232 ## This routine modifies one line of marcxml record hash
233 my ($xml,$kohafield,$newvalue,$recordtype,$tag,$subf)=@_;
234 $newvalue= Encode::decode('utf8',$newvalue) if $newvalue;
235 my $biblio=$xml->{'datafield'};
236 my $controlfield=$xml->{'controlfield'};
237 ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
240 foreach my $data (@$biblio){
241 if ($data->{'tag'} eq $tag){
242 my @subfields=$data->{'subfield'};
244 foreach my $subfield ( @subfields){
245 foreach my $code ( @$subfield){
246 if ($code->{'code'} eq $subf){
247 $code->{'content'}=$newvalue;
254 push @newsubs,{code=>$subf,content=>$newvalue};
255 $data->{subfield}= \@newsubs;
269 'content' =>$newvalue,
285 foreach my $control(@$controlfield){
286 if ($control->{'tag'} eq $tag){
287 $control->{'content'}=$newvalue;
292 push @$controlfield,{tag=>$tag,content=>$newvalue};
298 sub XML_writeline_id {
299 ### This routine is similar to XML_writeline but replaces a given value and do not create a new field
300 ## Useful for repeating fields
301 ## Currently usedin authorities
302 my ($xml,$oldvalue,$newvalue,$tag,$subf)=@_;
303 $newvalue= Encode::decode('utf8',$newvalue) if $newvalue;
304 my $biblio=$xml->{'datafield'};
305 my $controlfield=$xml->{'controlfield'};
307 foreach my $data (@$biblio){
308 if ($data->{'tag'} eq $tag){
309 my @subfields=$data->{'subfield'};
310 foreach my $subfield ( @subfields){
311 foreach my $code ( @$subfield){
312 if ($code->{'code'} eq $subf && $code->{'content'} eq $oldvalue){
313 $code->{'content'}=$newvalue;
320 foreach my $control(@$controlfield){
321 if ($control->{'tag'} eq $tag && $control->{'content'} eq $oldvalue ){
322 $control->{'content'}=$newvalue;
330 ##make a perl hash from xml file
332 my $hashed = XMLin( $xml ,KeyAttr =>['leader','controlfield','datafield'],ForceArray => ['leader','controlfield','datafield','subfield','holdings','record'],KeepRoot=>0);
337 ##Separates items from biblio
339 my $biblio=$hashed->{record}->[0];
341 my $items=$hashed->{holdings}->[0]->{record};
342 foreach my $item (@$items){
345 return ($biblio,@items);
348 sub XML_xml2hash_onerecord{
349 ##make a perl hash from xml file
351 my $hashed = XMLin( $xml ,KeyAttr =>['leader','controlfield','datafield'],ForceArray => ['leader','controlfield','datafield','subfield'],KeepRoot=>0);
355 ## turn a hash back to xml
356 my ($hashed,$root)=@_;
357 $root="record" unless $root;
358 my $xml= XMLout($hashed,KeyAttr=>['leader','controlfıeld','datafield'],NoSort => 1,AttrIndent => 0,KeepRoot=>0,SuppressEmpty => 1,RootName=>$root );
365 # Returns MARC::XML of the biblionumber passed in parameter.
366 my ( $dbh, $biblionumber ) = @_;
367 my $sth = $dbh->prepare("select marcxml from biblio where biblionumber=? " );
368 $sth->execute( $biblionumber);
369 my ($marcxml)=$sth->fetchrow;
370 $marcxml=Encode::decode('utf8',$marcxml);
374 sub XMLgetbibliohash{
375 ## Utility to return s hashed MARCXML
376 my ($dbh,$biblionumber)=@_;
377 my $xml=XMLgetbiblio($dbh,$biblionumber);
378 my $xmlhash=XML_xml2hash_onerecord($xml);
383 # Returns MARC::XML of the item passed in parameter uses either itemnumber or barcode
384 my ( $dbh, $itemnumber,$barcode ) = @_;
387 $sth = $dbh->prepare("select marcxml from items where itemnumber=?" );
388 $sth->execute($itemnumber);
390 $sth = $dbh->prepare("select marcxml from items where barcode=?" );
391 $sth->execute($barcode);
393 my ($marcxml)=$sth->fetchrow;
394 $marcxml=Encode::decode('utf8',$marcxml);
398 ## Utility to return s hashed MARCXML
399 my ( $dbh, $itemnumber,$barcode ) = @_;
400 my $xml=XMLgetitem( $dbh, $itemnumber,$barcode);
401 my $xmlhash=XML_xml2hash_onerecord($xml);
407 # warn "XMLgetallitems";
408 # Returns an array of MARC:XML of the items passed in parameter as biblionumber
409 my ( $dbh, $biblionumber ) = @_;
411 my $sth = $dbh->prepare("select marcxml from items where biblionumber =?" );
412 $sth->execute($biblionumber);
414 while(my ($marcxml)=$sth->fetchrow_array){
415 $marcxml=Encode::decode('utf8',$marcxml);
416 push @results,$marcxml;
422 # warn "XMLmarc2koha";
423 ##Returns two hashes from KOHA_XML record hashed
424 ## A biblio hash and and array of item hashes
425 my ($dbh,$xml,$related_record,@fields) = @_;
428 ## if @fields is given do not bother about the rest of fields just parse those
430 if ($related_record eq "biblios" || $related_record eq "" || !$related_record){
432 foreach my $field(@fields){
433 my $val=&XML_readline($xml,$field,'biblios');
434 $result->{$field}=$val if $val;
438 my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like 'biblios' and tagfield is not null" );
441 while ($field=$sth2->fetchrow) {
442 $result->{$field}=&XML_readline($xml,$field,'biblios');
446 ## we only need the following for biblio data
448 # modify copyrightdate to keep only the 1st year found
449 my $temp = $result->{'copyrightdate'};
450 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
452 $result->{'copyrightdate'} = $1;
453 } else { # if no cYYYY, get the 1st date.
454 $temp =~ m/(\d\d\d\d)/;
455 $result->{'copyrightdate'} = $1;
457 # modify publicationyear to keep only the 1st year found
458 $temp = $result->{'publicationyear'};
459 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
461 $result->{'publicationyear'} = $1;
462 } else { # if no cYYYY, get the 1st date.
463 $temp =~ m/(\d\d\d\d)/;
464 $result->{'publicationyear'} = $1;
467 if ($related_record eq "holdings" || $related_record eq "" || !$related_record){
468 my $holdings=$xml->{holdings}->[0]->{record};
472 foreach my $holding (@$holdings){
474 foreach my $field(@fields){
475 my $val=&XML_readline($holding,$field,'holdings');
476 $itemresult->{$field}=$val if $val;
478 push @items, $itemresult;
481 my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like 'holdings' and tagfield is not null" );
482 foreach my $holding (@$holdings){
486 while ($field=$sth2->fetchrow) {
487 $itemresult->{$field}=&XML_readline($xml,$field,'holdings');
489 push @items, $itemresult;
495 return ($result,@items);
497 sub XMLmarc2koha_onerecord {
498 # warn "XMLmarc2koha_onerecord";
499 ##Returns a koha hash from MARCXML hash
501 my ($dbh,$xml,$related_record,@fields) = @_;
504 ## if @fields is given do not bother about the rest of fields just parse those
507 foreach my $field(@fields){
508 my $val=&XML_readline_onerecord($xml,$field,$related_record);
509 $result->{$field}=$val if $val;
512 my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like ? and tagfield is not null" );
513 $sth2->execute($related_record);
515 while ($field=$sth2->fetchrow) {
516 $result->{$field}=&XML_readline_onerecord($xml,$field,$related_record);
523 # warn "XMLmodLCindex";
524 my ($dbh,$xmlhash)=@_;
525 my ($lc)=XML_readline_onerecord($xmlhash,"classification","biblios");
526 my ($cutter)=XML_readline_onerecord($xmlhash,"subclass","biblios");
530 my ($lcsort)=calculatelc($lc);
531 $xmlhash=XML_writeline($xmlhash,"lcsort",$lcsort,"biblios");
536 sub XMLmoditemonefield{
537 # This routine takes itemnumber and biblionumber and updates XMLmarc;
538 ### the ZEBR DB update can wait depending on $donotupdate flag
539 my ($dbh,$biblionumber,$itemnumber,$itemfield,$newvalue,$donotupdate)=@_;
540 my ($record) = XMLgetitem($dbh,$itemnumber);
541 my $recordhash=XML_xml2hash_onerecord($record);
542 XML_writeline( $recordhash, $itemfield, $newvalue,"holdings" );
544 ## Prevent various update calls to zebra wait until all changes finish
545 $record=XML_hash2xml($recordhash);
546 my $sth=$dbh->prepare("update items set marcxml=? where itemnumber=?");
547 $sth->execute($record,$itemnumber);
550 NEWmoditem($dbh,$recordhash,$biblionumber,$itemnumber);
556 # warn "MARCkoha2marc";
557 ## This routine is still used for acqui management
558 ##Returns a XML recordhash from a kohahash
559 my ($dbh,$result,$recordtype) = @_;
560 ###create a basic MARCXML
562 my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
565 my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",
566 $year,$mon,$mday,$hour,$min,$sec);
567 $year=substr($year,2,2);
568 my $accdate=sprintf("%2d%02d%02d",$year,$mon,$mday);
569 my ($titletag,$titlesubf)=MARCfind_marc_from_kohafield("title","biblios");
570 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>";
572 my $record = XML_xml2hash($xml);
573 my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where tagfield is not null and recordtype=?");
574 $sth2->execute($recordtype);
576 while (($field)=$sth2->fetchrow) {
578 $record=XML_writeline($record,$field,$result->{$field},$recordtype) if $result->{$field};
585 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
587 ## Script to deal with MARCXML related tables
590 ##Sub to match kohafield to Z3950 -attributes
592 sub MARCfind_attr_from_kohafield {
593 # warn "MARCfind_attr_from_kohafield";
595 my ( $kohafield ) = @_;
596 return 0, 0 unless $kohafield;
598 my $relations = C4::Context->attrfromkohafield;
599 return ($relations->{$kohafield});
604 # warn "MARCgettagslib";
605 my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
606 $frameworkcode = "" unless $frameworkcode;
608 my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
610 # check that framework exists
613 "select count(*) from biblios_tag_structure where frameworkcode=?");
614 $sth->execute($frameworkcode);
615 my ($total) = $sth->fetchrow;
616 $frameworkcode = "" unless ( $total > 0 );
619 "select tagfield,liblibrarian,libopac,mandatory,repeatable from biblios_tag_structure where frameworkcode=? order by tagfield"
621 $sth->execute($frameworkcode);
622 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
624 while ( my ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
625 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
626 $res->{$tab}->{tab} = ""; # XXX
627 $res->{$tag}->{mandatory} = $mandatory;
628 $res->{$tag}->{repeatable} = $repeatable;
633 "select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,seealso,hidden,isurl,link from biblios_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
635 $sth->execute($frameworkcode);
638 my $authorised_value;
648 ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
649 $mandatory, $repeatable, $authorised_value, $authtypecode,
650 $value_builder, $seealso, $hidden,
655 $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
656 $res->{$tag}->{$subfield}->{tab} = $tab;
657 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
658 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
659 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
660 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
661 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
662 $res->{$tag}->{$subfield}->{seealso} = $seealso;
663 $res->{$tag}->{$subfield}->{hidden} = $hidden;
664 $res->{$tag}->{$subfield}->{isurl} = $isurl;
665 $res->{$tag}->{$subfield}->{link} = $link;
669 sub MARCitemsgettagslib {
670 # warn "MARCitemsgettagslib";
671 my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
672 $frameworkcode = "" unless $frameworkcode;
674 my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
676 # check that framework exists
679 "select count(*) from holdings_tag_structure where frameworkcode=?");
680 $sth->execute($frameworkcode);
681 my ($total) = $sth->fetchrow;
682 $frameworkcode = "" unless ( $total > 0 );
685 "select tagfield,liblibrarian,libopac,mandatory,repeatable from holdings_tag_structure where frameworkcode=? order by tagfield"
687 $sth->execute($frameworkcode);
688 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
690 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
691 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
692 $res->{$tab}->{tab} = ""; # XXX
693 $res->{$tag}->{mandatory} = $mandatory;
694 $res->{$tag}->{repeatable} = $repeatable;
699 "select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,seealso,hidden,isurl,link from holdings_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
701 $sth->execute($frameworkcode);
704 my $authorised_value;
714 ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
715 $mandatory, $repeatable, $authorised_value, $authtypecode,
716 $value_builder, $seealso, $hidden,
721 $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
722 $res->{$tag}->{$subfield}->{tab} = $tab;
723 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
724 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
725 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
726 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
727 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
728 $res->{$tag}->{$subfield}->{seealso} = $seealso;
729 $res->{$tag}->{$subfield}->{hidden} = $hidden;
730 $res->{$tag}->{$subfield}->{isurl} = $isurl;
731 $res->{$tag}->{$subfield}->{link} = $link;
735 sub MARCfind_marc_from_kohafield {
736 # warn "MARCfind_marc_from_kohafield";
737 my ( $kohafield,$recordtype) = @_;
738 return 0, 0 unless $kohafield;
739 $recordtype="biblios" unless $recordtype;
740 my $relations = C4::Context->marcfromkohafield;
741 return ($relations->{$recordtype}->{$kohafield}->[0],$relations->{$recordtype}->{$kohafield}->[1]);
747 sub MARCfind_frameworkcode {
748 # warn "MARCfind_frameworkcode";
749 my ( $dbh, $biblionumber ) = @_;
751 $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
752 $sth->execute($biblionumber);
753 my ($frameworkcode) = $sth->fetchrow;
754 return $frameworkcode;
756 sub MARCfind_itemtype {
757 # warn "MARCfind_itemtype";
758 my ( $dbh, $biblionumber ) = @_;
760 $dbh->prepare("select itemtype from biblio where biblionumber=?");
761 $sth->execute($biblionumber);
762 my ($itemtype) = $sth->fetchrow;
769 # warn "MARChtml2xml ";
770 my ($tags,$subfields,$values,$indicator,$ind_tag) = @_;
771 # use MARC::File::XML;
772 my $xml= marc_record_header('UTF-8'); #### we do not need a collection wrapper
778 for (my $i=0;$i<=@$tags;$i++){
779 @$values[$i] =~ s/&/&/g;
780 @$values[$i] =~ s/</</g;
781 @$values[$i] =~ s/>/>/g;
782 @$values[$i] =~ s/"/"/g;
783 @$values[$i] =~ s/'/'/g;
785 if ((@$tags[$i] ne $prevtag)){
786 my $tag=substr(@$tags[$i],0,3);
787 $j++ unless ($tag eq "");
788 ## warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i];
790 $xml.="</datafield>\n";
791 if (($tag> 10) && (@$values[$i] ne "")){
792 my $ind1 = substr(@$indicator[$j],0,1);
793 my $ind2 = substr(@$indicator[$j],1,1);
794 $xml.="<datafield tag=\"$tag\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
795 $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
801 if (@$values[$i] ne "") {
804 ##Force the leader to UTF8
805 substr(@$values[$i],9,1)="a";
806 $xml.="<leader>@$values[$i]</leader>\n";
808 # rest of the fixed fields
809 } elsif ($tag < 10) {
810 $xml.="<controlfield tag=\"$tag\">@$values[$i]</controlfield>\n";
813 my $ind1 = substr(@$indicator[$j],0,1);
814 my $ind2 = substr(@$indicator[$j],1,1);
815 $xml.="<datafield tag=\"$tag\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
816 $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
821 } else { # @$tags[$i] eq $prevtag
822 unless (@$values[$i] eq "") {
823 my $tag=substr(@$tags[$i],0,3);
825 my $ind1 = substr(@$indicator[$j],0,1);
826 my $ind2 = substr(@$indicator[$j],1,1);
827 $xml.="<datafield tag=\"$tag\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
830 $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
833 $prevtag = @$tags[$i];
837 $xml=Encode::decode('utf8',$xml);
840 sub marc_record_header {
841 #### this one is for <record>
843 my $enc = shift || 'UTF-8';
845 return( <<MARC_XML_HEADER );
846 <?xml version="1.0" encoding="$enc"?>
847 <record xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
848 xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
849 xmlns="http://www.loc.gov/MARC21/slim">
854 sub collection_header {
855 #### this one is for koha collection
857 my $enc = shift || 'UTF-8';
858 return( <<KOHA_XML_HEADER );
859 <?xml version="1.0" encoding="$enc"?>
860 <kohacollection xmlns:marc="http://loc.gov/MARC21/slim" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:noNamespaceSchemaLocation="http://library.neu.edu.tr/kohanamespace/koharecord.xsd">
871 ##########################NEW NEW NEW#############################
873 my ( $dbh, $xml, $frameworkcode) = @_;
874 $frameworkcode="" unless $frameworkcode;
875 my $biblionumber=XML_readline_onerecord($xml,"biblionumber","biblios");
876 ## In case reimporting records with biblionumbers keep them
878 $biblionumber=NEWmodbiblio( $dbh, $biblionumber,$xml,$frameworkcode );
880 $biblionumber = NEWaddbiblio( $dbh, $xml,$frameworkcode );
883 return ( $biblionumber );
890 sub NEWmodbiblioframework {
891 my ($dbh,$biblionumber,$frameworkcode) =@_;
892 my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=$biblionumber");
893 $sth->execute($frameworkcode);
899 my ( $dbh, $biblionumber ) = @_;
900 ZEBRAop($dbh,$biblionumber,"recordDelete","biblioserver");
905 my ( $dbh, $xmlhash, $biblionumber ) = @_;
906 my $itemtype= MARCfind_itemtype($dbh,$biblionumber);
908 ## In case we are re-importing marc records from bulk import do not change itemnumbers
909 my $itemnumber=XML_readline_onerecord($xmlhash,"itemnumber","holdings");
911 NEWmoditem ( $dbh, $xmlhash, $biblionumber, $itemnumber);
914 ##Add biblionumber to $record
915 $xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"holdings");
916 # MARCkoha2marcOnefield($record,"biblionumber",$biblionumber,"holdings");
917 my $sth=$dbh->prepare("select notforloan from itemtypes where itemtype='$itemtype'");
919 my $notforloan=$sth->fetchrow;
920 ##Change the notforloan field if $notforloan found
922 $xmlhash=XML_writeline($xmlhash,"notforloan",$notforloan,"holdings");
924 my $dateaccessioned=XML_readline_onerecord($xmlhash,"dateaccessioned","holdings");
925 unless($dateaccessioned){
927 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
928 localtime(time); $year +=1900; $mon +=1;
929 my $date = "$year-".sprintf ("%0.2d", $mon)."-".sprintf("%0.2d",$mday);
931 $xmlhash=XML_writeline($xmlhash,"dateaccessioned",$date,"holdings");
934 ## Now calculate itempart of cutter-- This is NEU specific
935 my $itemcallnumber=XML_readline_onerecord($xmlhash,"itemcallnumber","holdings");
936 if ($itemcallnumber){
937 my ($cutterextra)=itemcalculator($dbh,$biblionumber,$itemcallnumber);
938 $xmlhash=XML_writeline($xmlhash,"cutterextra",$cutterextra,"holdings");
941 ##NEU specific add cataloguers cardnumber as well
942 my $me= C4::Context->userenv;
943 my $cataloger=$me->{'cardnumber'} if ($me);
944 $xmlhash=XML_writeline($xmlhash,"circid",$cataloger,"holdings") if $cataloger;
947 my $itemnumber = &OLDnewitems( $dbh, $xmlhash );
949 # add the item to zebra it will add the biblio as well!!!
950 ZEBRAop( $dbh, $biblionumber,"specialUpdate","biblioserver" );
959 my ( $dbh, $xmlhash, $biblionumber, $itemnumber ) = @_;
961 ##Add itemnumber incase lost (old bug 090c was lost sometimes) --just incase
962 $xmlhash=XML_writeline($xmlhash,"itemnumber",$itemnumber,"holdings");
963 ##Add biblionumber incase lost on html
964 $xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"holdings");
966 my $barcode=XML_readline_onerecord($xmlhash,"barcode","holdings");
967 ## Now calculate itempart of cutter-- This is NEU specific
968 my $itemcallnumber=XML_readline_onerecord($xmlhash,"itemcallnumber","holdings");
969 if ($itemcallnumber){
970 my ($cutterextra)=itemcalculator($dbh,$biblionumber,$itemcallnumber);
972 $xmlhash=XML_writeline($xmlhash,"cutterextra",$cutterextra,"holdings");
975 ##NEU specific add cataloguers cardnumber as well
976 my $me= C4::Context->userenv;
977 my $cataloger=$me->{'cardnumber'} if ($me);
978 $xmlhash=XML_writeline($xmlhash,"circid",$cataloger,"holdings") if $cataloger;
979 my $xml=XML_hash2xml($xmlhash);
980 OLDmoditem( $dbh, $xml,$biblionumber,$itemnumber,$barcode );
981 ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
985 my ( $dbh, $itemnumber ) = @_;
986 my $sth=$dbh->prepare("SELECT biblionumber from items where itemnumber=?");
987 $sth->execute($itemnumber);
988 my $biblionumber=$sth->fetchrow;
989 OLDdelitem( $dbh, $itemnumber ) ;
990 ZEBRAop($dbh,$biblionumber,"recordDelete","biblioserver");
998 my ( $dbh, $xmlhash,$frameworkcode ) = @_;
999 my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
1001 my $data = $sth->fetchrow;
1002 my $biblionumber = $data + 1;
1004 # we must add biblionumber
1006 $xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"biblios");
1008 ###NEU specific add cataloguers cardnumber as well
1010 my $me= C4::Context->userenv;
1011 my $cataloger=$me->{'cardnumber'} if ($me);
1012 $xmlhash=XML_writeline($xmlhash,"indexedby",$cataloger,"biblios") if $cataloger;
1014 ## We must add the indexing fields for LC in MARC record--TG
1015 &XMLmodLCindex($dbh,$xmlhash);
1018 my $itemtype=XML_readline_onerecord($xmlhash,"itemtype","biblios");
1020 my $isbn=XML_readline_onerecord($xmlhash,"isbn","biblios");
1022 my $issn=XML_readline_onerecord($xmlhash,"issn","biblios");
1024 my $title=XML_readline_onerecord($xmlhash,"title","biblios");
1026 my $author=XML_readline_onerecord($xmlhash,"title","biblios");
1027 my $xml=XML_hash2xml($xmlhash);
1029 $sth = $dbh->prepare("insert into biblio set biblionumber = ?,frameworkcode=?, itemtype=?,marcxml=?,title=?,author=?,isbn=?,issn=?" );
1030 $sth->execute( $biblionumber,$frameworkcode, $itemtype,$xml ,$title,$author,$isbn,$issn );
1033 ### Do not add biblio to ZEBRA unless there is an item with it -- depends on system preference defaults to NO
1034 if (C4::Context->preference('AddaloneBiblios')){
1035 ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
1037 return ($biblionumber);
1041 my ( $dbh, $biblionumber,$xmlhash,$frameworkcode ) = @_;
1042 ##Add biblionumber incase lost on html
1044 $xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"biblios");
1046 ###NEU specific add cataloguers cardnumber as well
1047 my $me= C4::Context->userenv;
1048 my $cataloger=$me->{'cardnumber'} if ($me);
1050 $xmlhash=XML_writeline($xmlhash,"indexedby",$cataloger,"biblios") if $cataloger;
1052 ## We must add the indexing fields for LC in MARC record--TG
1054 XMLmodLCindex($dbh,$xmlhash);
1055 OLDmodbiblio ($dbh,$xmlhash,$biblionumber,$frameworkcode);
1056 my $ok=ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
1057 return ($biblionumber);
1062 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1068 my ( $dbh, $xmlhash) = @_;
1069 my $sth = $dbh->prepare("SELECT max(itemnumber) from items");
1073 $data = $sth->fetchrow_hashref;
1074 $itemnumber = $data->{'max(itemnumber)'} + 1;
1076 $xmlhash=XML_writeline( $xmlhash, "itemnumber", $itemnumber,"holdings" );
1077 my $biblionumber=XML_readline_onerecord($xmlhash,"biblionumber","holdings");
1078 my $barcode=XML_readline_onerecord($xmlhash,"barcode","holdings");
1079 my $xml=XML_hash2xml($xmlhash);
1080 $sth = $dbh->prepare( "Insert into items set itemnumber = ?, biblionumber = ?,barcode = ?,marcxml=?" );
1081 $sth->execute($itemnumber,$biblionumber,$barcode,$xml);
1086 my ( $dbh, $xml,$biblionumber,$itemnumber,$barcode ) = @_;
1087 my $sth =$dbh->prepare("replace items set biblionumber=?,marcxml=?,barcode=? , itemnumber=?");
1088 $sth->execute($biblionumber,$xml,$barcode,$itemnumber);
1093 my ( $dbh, $itemnumber ) = @_;
1094 my $sth = $dbh->prepare("select * from items where itemnumber=?");
1095 $sth->execute($itemnumber);
1096 if ( my $data = $sth->fetchrow_hashref ) {
1098 my $query = "replace deleteditems set ";
1100 foreach my $temp ( keys %$data ) {
1101 $query .= "$temp = ?,";
1102 push ( @bind, $data->{$temp} );
1105 #replacing the last , by ",?)"
1107 $sth = $dbh->prepare($query);
1108 $sth->execute(@bind);
1110 $sth = $dbh->prepare("Delete from items where itemnumber=?");
1111 $sth->execute($itemnumber);
1118 # modifies the biblio table
1119 my ($dbh,$xmlhash,$biblionumber,$frameworkcode) = @_;
1120 if (!$frameworkcode){
1124 my $itemtype=XML_readline_onerecord($xmlhash,"itemtype","biblios");
1126 my $isbn=XML_readline_onerecord($xmlhash,"isbn","biblios");
1128 my $issn=XML_readline_onerecord($xmlhash,"issn","biblios");
1130 my $title=XML_readline_onerecord($xmlhash,"title","biblios");
1132 my $author=XML_readline_onerecord($xmlhash,"author","biblios");
1133 my $xml=XML_hash2xml($xmlhash);
1135 #my $marc=MARC::Record->new_from_xml($xml,'UTF-8');## this will be depreceated
1136 $isbn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g;
1137 $issn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g;
1138 $isbn=~s/^\s+|\s+$//g;
1139 $isbn=substr($isbn,0,13);
1140 my $sth = $dbh->prepare("REPLACE biblio set biblionumber=?,marcxml=?,frameworkcode=? ,itemtype=? , title=?,author=?,isbn=?,issn=?" );
1141 $sth->execute( $biblionumber ,$xml, $frameworkcode,$itemtype, $title,$author,$isbn,$issn);
1143 return $biblionumber;
1147 my ( $dbh, $biblionumber ) = @_;
1148 my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1149 $sth->execute($biblionumber);
1150 if ( my $data = $sth->fetchrow_hashref ) {
1152 my $query = "replace deletedbiblio set ";
1154 foreach my $temp ( keys %$data ) {
1155 $query .= "$temp = ?,";
1156 push ( @bind, $data->{$temp} );
1159 #replacing the last , by ",?)"
1161 $sth = $dbh->prepare($query);
1162 $sth->execute(@bind);
1164 $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1165 $sth->execute($biblionumber);
1179 sub ZEBRAdelbiblio {
1180 ## Zebra calls this routine to delete after it deletes biblio from ZEBRAddb
1181 my ( $dbh, $biblionumber ) = @_;
1182 my $sth=$dbh->prepare("SELECT itemnumber FROM items where biblionumber=?");
1184 $sth->execute($biblionumber);
1185 while (my $itemnumber =$sth->fetchrow){
1186 OLDdelitem($dbh,$itemnumber) ;
1188 OLDdelbiblio($dbh,$biblionumber) ;
1192 my $biblionumber=shift;
1193 my @kohafield="biblionumber";
1194 my @value=$biblionumber;
1195 my ($count,@result)=C4::Search::ZEBRAsearch_kohafields(\@kohafield,\@value);
1198 my ( $xmlrecord, @itemsrecord) = XML_separate($result[0]);
1199 return ($xmlrecord, @itemsrecord);
1201 return (undef,undef);
1206 ### Puts the zebra update in queue writes in zebraserver table
1207 my ($dbh,$biblionumber,$op,$server)=@_;
1209 my $sth=$dbh->prepare("insert into zebraqueue (biblio_auth_number ,server,operation) values(?,?,?)");
1210 $sth->execute($biblionumber,$server,$op);
1216 ###Accepts a $server variable thus we can use it to update biblios, authorities or other zebra dbs
1217 my ($record,$op,$server)=@_;
1224 $record=Encode::encode("utf8",$record);
1225 my $shadow=$server."shadow";
1228 $Zconnbiblio[0]=C4::Context->Zconnauth($server);
1230 my $Zpackage = $Zconnbiblio[0]->package();
1231 $Zpackage->option(action => $op);
1232 $Zpackage->option(record => $record);
1234 $Zpackage->send("update");
1238 while (($i = ZOOM::event(\@Zconnbiblio)) != 0) {
1239 $event = $Zconnbiblio[0]->last_event();
1240 last if $event == ZOOM::Event::ZEND;
1242 my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio[0]->error_x();
1243 if ($error==10007 && $tried<3) {## timeout --another 30 looonng seconds for this update
1244 sleep 1; ## wait a sec!
1247 }elsif ($error==2 && $tried<2) {## timeout --temporary zebra error !whatever that means
1248 sleep 2; ## wait two seconds!
1251 }elsif($error==10004 && $recon==0){##Lost connection -reconnect
1252 sleep 1; ## wait a sec!
1254 $Zpackage->destroy();
1255 $Zconnbiblio[0]->destroy();
1258 # warn "Error-$server $op /errcode:, $error, /MSG:,$errmsg,$addinfo \n";
1259 $Zpackage->destroy();
1260 $Zconnbiblio[0]->destroy();
1261 # ZEBRAopfiles($dbh,$biblionumber,$record,$op,$server);
1264 ## System preference batchMode=1 means wea are bulk importing
1265 ## DO NOT COMMIT while in batchMode for faster operation
1266 my $batchmode=C4::Context->preference('batchMode');
1267 if (C4::Context->$shadow >0 && !$batchmode){
1268 $Zpackage->send('commit');
1269 while (($i = ZOOM::event(\@Zconnbiblio)) != 0) {
1270 $event = $Zconnbiblio[0]->last_event();
1271 last if $event == ZOOM::Event::ZEND;
1273 my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio[0]->error_x();
1274 if ($error) { ## This is serious ZEBRA server is not updating
1275 $Zpackage->destroy();
1276 $Zconnbiblio[0]->destroy();
1281 $Zpackage->destroy();
1282 $Zconnbiblio[0]->destroy();
1289 my ($dbh,$biblionumber)=@_;
1290 my $biblioxml=XMLgetbiblio($dbh,$biblionumber);
1291 my @itemxml=XMLgetallitems($dbh,$biblionumber);
1292 my $zebraxml=collection_header();
1293 $zebraxml.="<koharecord>\n";
1294 $zebraxml.=$biblioxml;
1295 $zebraxml.="<holdings>\n";
1296 foreach my $item(@itemxml){
1299 $zebraxml.="</holdings>\n";
1300 $zebraxml.="</koharecord>\n";
1301 $zebraxml.="</kohacollection>\n";
1306 sub ZEBRA_readyXML_noheader{
1307 my ($dbh,$biblionumber)=@_;
1308 my $biblioxml=XMLgetbiblio($dbh,$biblionumber);
1309 my @itemxml=XMLgetallitems($dbh,$biblionumber);
1310 my $zebraxml="<koharecord>";
1311 $zebraxml.=$biblioxml;
1312 $zebraxml.="<holdings>";
1313 foreach my $item(@itemxml){
1314 $zebraxml.=$item if $item;
1316 $zebraxml.="</holdings>";
1317 $zebraxml.="</koharecord>";
1323 # various utility subs and those not complying to new rules
1328 ## Used in acqui management -- creates the biblio from koha hash
1330 my $dbh = C4::Context->dbh;
1331 my $record=XMLkoha2marc($dbh,$biblio,"biblios");
1332 my $biblionumber=NEWnewbiblio($dbh,$record);
1333 return ($biblionumber);
1336 ## Used in acqui management -- modifies the biblio from koha hash rather than xml-hash
1338 my $dbh = C4::Context->dbh;
1339 my $record=XMLkoha2marc($dbh,$biblio,"biblios");
1340 my $biblionumber=NEWmodbiblio($dbh,$record,$biblio->{biblionumber});
1341 return ($biblionumber);
1345 ## Used in acqui management -- creates the item from hash rather than marc-record
1346 my ( $item, @barcodes ) = @_;
1347 my $dbh = C4::Context->dbh;
1351 foreach my $barcode (@barcodes) {
1352 $item->{barcode}=$barcode;
1353 my $record=MARCkoha2marc($dbh,$item,"holdings");
1354 my $itemnumber= NEWnewitem($dbh,$record,$item->{biblionumber});
1357 return $itemnumber ;
1364 my $dbh = C4::Context->dbh;
1365 my $query = "select * from itemtypes order by description";
1366 my $sth = $dbh->prepare($query);
1368 # || die "Cannot prepare $query" . $dbh->errstr;
1372 # || die "Cannot execute $query\n" . $sth->errstr;
1373 while ( my $data = $sth->fetchrow_hashref ) {
1374 $results[$count] = $data;
1379 return ( $count, @results );
1380 } # sub getitemtypes
1385 #returns MySQL like fieldnames to emulate searches on sql like fieldnames
1387 ## Either opac or intranet to select appropriate fields
1389 $type="intra" unless $type;
1390 if ($type eq "intranet"){ $type="intra";}
1391 my $dbh = C4::Context->dbh;
1395 my $sth=$dbh->prepare("SELECT * FROM koha_attr where $type=1 order by liblibrarian");
1397 while (my $data=$sth->fetchrow_hashref){
1402 return ($i,@results);
1410 ## Old style ISBN handling should be modified to accept 13 digits
1414 if(substr($isbn, 0, 1) <=7) {
1415 $seg1 = substr($isbn, 0, 1);
1416 } elsif(substr($isbn, 0, 2) <= 94) {
1417 $seg1 = substr($isbn, 0, 2);
1418 } elsif(substr($isbn, 0, 3) <= 995) {
1419 $seg1 = substr($isbn, 0, 3);
1420 } elsif(substr($isbn, 0, 4) <= 9989) {
1421 $seg1 = substr($isbn, 0, 4);
1423 $seg1 = substr($isbn, 0, 5);
1425 my $x = substr($isbn, length($seg1));
1427 if(substr($x, 0, 2) <= 19) {
1428 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
1429 $seg2 = substr($x, 0, 2);
1430 } elsif(substr($x, 0, 3) <= 699) {
1431 $seg2 = substr($x, 0, 3);
1432 } elsif(substr($x, 0, 4) <= 8399) {
1433 $seg2 = substr($x, 0, 4);
1434 } elsif(substr($x, 0, 5) <= 89999) {
1435 $seg2 = substr($x, 0, 5);
1436 } elsif(substr($x, 0, 6) <= 9499999) {
1437 $seg2 = substr($x, 0, 6);
1439 $seg2 = substr($x, 0, 7);
1441 my $seg3=substr($x,length($seg2));
1442 $seg3=substr($seg3,0,length($seg3)-1) ;
1443 my $seg4 = substr($x, -1, 1);
1444 return "$seg1-$seg2-$seg3-$seg4";
1447 ## Function to create padded LC call number for sorting items with their LC code. Not exported
1448 my ($classification)=@_;
1449 $classification=~s/^\s+|\s+$//g;
1453 for ($i=0; $i<length($classification);$i++){
1454 my $c=(substr($classification,$i,1));
1455 if ($c ge '0' && $c le '9'){
1457 $lc2=substr($classification,$i);
1460 $lc1.=substr($classification,$i,1);
1465 my $other=length($lc1);
1466 if(!$lc1){$other=0;}
1469 for (1..(4-$other)){
1478 ##Find the decimal part of $lc2
1479 my $pos=index($lc2,".");
1480 if ($pos<0){$pos=length($lc2);}
1481 if ($pos>=0 && $pos<5){
1482 ##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort as numeric
1493 ## Sublimentary function to obtain sorted LC for items. Not exported
1494 my ($dbh,$biblionumber,$callnumber)=@_;
1495 my $xmlhash=XMLgetbibliohash($dbh,$biblionumber);
1496 my $lc=XML_readline_onerecord($xmlhash,"classification","biblios");
1497 my $cutter=XML_readline_onerecord($xmlhash,"subclass","biblios");
1498 my $all=$lc." ".$cutter;
1499 my $total=length($all);
1500 my $cutterextra=substr($callnumber,$total);
1501 return $cutterextra;
1506 #### This function allows decoding of only title and author out of a MARC record
1507 sub func_title_author {
1508 my ($tagno,$tagdata) = @_;
1509 my ($titlef,$subf)=&MARCfind_marc_from_kohafield("title","biblios");
1510 my ($authf,$subf)=&MARCfind_marc_from_kohafield("author","biblios");
1511 return ($tagno == $titlef || $tagno == $authf);
1516 END { } # module clean-up code here (global destructor)
1522 Koha Developement team <info@koha.org>