2 # New subs added by tgarip@neu.edu.tr 05/11/05
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
23 use MARC::File::USMARC;
29 use vars qw($VERSION @ISA @EXPORT);
31 # set the version for version checking
36 # &itemcount removed, now resides in Search.pm
50 &NEWmodbiblioframework
53 &MARCfind_marc_from_kohafield
54 &MARCfind_frameworkcode
60 &MARCkoha2marcOnefield
61 &MARCfind_attr_from_kohafield
73 &XML_xml2hash_onerecord
76 &XMLmarc2koha_onerecord
78 &XML_readline_onerecord
87 &ZEBRA_readyXML_noheader
95 #################### XML XML XML XML ###################
96 ### XML Read- Write functions
97 sub XML_readline_onerecord{
98 my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
99 #$xml represents one record of MARCXML as perlhashed
100 ### $recordtype is needed for mapping the correct field
101 ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
104 my $biblio=$xml->{'datafield'};
105 my $controlfields=$xml->{'controlfield'};
106 my $leader=$xml->{'leader'};
108 foreach my $data (@$biblio){
109 if ($data->{'tag'} eq $tag){
110 foreach my $subfield ( $data->{'subfield'}){
111 foreach my $code ( @$subfield){
112 if ($code->{'code'} eq $subf){
113 return $code->{'content'};
120 if ($tag eq "000" || $tag eq "LDR"){
121 return $leader->[0] if $leader->[0];
123 foreach my $control (@$controlfields){
124 if ($control->{'tag'} eq $tag){
125 return $control->{'content'} if $control->{'content'};
136 my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
137 #$xml represents one record node hashed of holdings or a complete xml koharecord
138 ### $recordtype is needed for reading the child records( like holdings records) .Otherwise main record is assumed ( like biblio)
139 ## holding records are parsed and sent here one by one
140 # If kohafieldname given find tag
142 ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
145 if ($recordtype eq "holdings"){
146 my $item=$xml->{'datafield'};
147 my $hcontrolfield=$xml->{'controlfield'};
149 foreach my $data (@$item){
150 if ($data->{'tag'} eq $tag){
151 foreach my $subfield ( $data->{'subfield'}){
152 foreach my $code ( @$subfield){
153 if ($code->{'code'} eq $subf){
154 return $code->{content};
161 foreach my $control (@$hcontrolfield){
162 if ($control->{'tag'} eq $tag){
163 return $control->{'content'};
168 }else{ ##Not a holding read biblio
169 my $biblio=$xml->{'record'}->[0]->{'datafield'};
170 my $controlfields=$xml->{'record'}->[0]->{'controlfield'};
172 foreach my $data (@$biblio){
173 if ($data->{'tag'} eq $tag){
174 foreach my $subfield ( $data->{'subfield'}){
175 foreach my $code ( @$subfield){
176 if ($code->{'code'} eq $subf){
177 return $code->{'content'};
185 foreach my $control (@$controlfields){
186 if ($control->{'tag'} eq $tag){
187 return $control->{'content'}if $control->{'content'};
197 ## This routine modifies one line of marcxml record hash
198 my ($xml,$kohafield,$newvalue,$recordtype,$tag,$subf)=@_;
199 $newvalue= Encode::decode('utf8',$newvalue) if $newvalue;
200 my $biblio=$xml->{'datafield'};
201 my $controlfield=$xml->{'controlfield'};
202 ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
205 foreach my $data (@$biblio){
206 if ($data->{'tag'} eq $tag){
207 my @subfields=$data->{'subfield'};
209 foreach my $subfield ( @subfields){
210 foreach my $code ( @$subfield){
211 if ($code->{'code'} eq $subf){
212 $code->{'content'}=$newvalue;
219 push @newsubs,{code=>$subf,content=>$newvalue};
220 $data->{subfield}= \@newsubs;
234 'content' =>$newvalue,
250 foreach my $control(@$controlfield){
251 if ($control->{'tag'} eq $tag){
252 $control->{'content'}=$newvalue;
257 push @$controlfield,{tag=>$tag,content=>$newvalue};
264 ##make a perl hash from xml file
266 my $hashed = XMLin( $xml ,KeyAttr =>['leader','controlfield','datafield'],ForceArray => ['leader','controlfield','datafield','subfield','holdings','record'],KeepRoot=>0);
271 ##Separates items from biblio
273 my $biblio=$hashed->{record}->[0];
275 my $items=$hashed->{holdings}->[0]->{record};
276 foreach my $item (@$items){
279 return ($biblio,@items);
282 sub XML_xml2hash_onerecord{
283 ##make a perl hash from xml file
285 my $hashed = XMLin( $xml ,KeyAttr =>['leader','controlfield','datafield'],ForceArray => ['leader','controlfield','datafield','subfield'],KeepRoot=>0);
289 ## turn a hash back to xml
290 my ($hashed,$root)=@_;
291 $root="record" unless $root;
292 my $xml= XMLout($hashed,KeyAttr=>['leader','controlfıeld','datafield'],NoSort => 1,AttrIndent => 0,KeepRoot=>0,SuppressEmpty => 1,RootName=>$root );
299 # Returns MARC::XML of the biblionumber passed in parameter.
300 my ( $dbh, $biblionumber ) = @_;
301 my $sth = $dbh->prepare("select marcxml from biblio where biblionumber=? " );
302 $sth->execute( $biblionumber);
303 my ($marcxml)=$sth->fetchrow;
304 $marcxml=Encode::decode('utf8',$marcxml);
308 sub XMLgetbibliohash{
309 ## Utility to return s hashed MARCXML
310 my ($dbh,$biblionumber)=@_;
311 my $xml=XMLgetbiblio($dbh,$biblionumber);
312 my $xmlhash=XML_xml2hash_onerecord($xml);
317 # Returns MARC::XML of the item passed in parameter uses either itemnumber or barcode
318 my ( $dbh, $itemnumber,$barcode ) = @_;
321 $sth = $dbh->prepare("select marcxml from items where itemnumber=?" );
322 $sth->execute($itemnumber);
324 $sth = $dbh->prepare("select marcxml from items where barcode=?" );
325 $sth->execute($barcode);
327 my ($marcxml)=$sth->fetchrow;
328 $marcxml=Encode::decode('utf8',$marcxml);
332 ## Utility to return s hashed MARCXML
333 my ( $dbh, $itemnumber,$barcode ) = @_;
334 my $xml=XMLgeitem( $dbh, $itemnumber,$barcode);
335 my $xmlhash=XML_xml2hash_onerecord($xml);
341 # warn "XMLgetallitems";
342 # Returns an array of MARC:XML of the items passed in parameter as biblionumber
343 my ( $dbh, $biblionumber ) = @_;
345 my $sth = $dbh->prepare("select marcxml from items where biblionumber =?" );
346 $sth->execute($biblionumber);
348 while(my ($marcxml)=$sth->fetchrow_array){
349 $marcxml=Encode::decode('utf8',$marcxml);
350 push @results,$marcxml;
356 # warn "XMLmarc2koha";
357 ##Returns two hashes from KOHA_XML record hashed
358 ## A biblio hash and and array of item hashes
359 my ($dbh,$xml,$related_record,@fields) = @_;
362 ## if @fields is given do not bother about the rest of fields just parse those
364 if ($related_record eq "biblios" || $related_record eq "" || !$related_record){
366 foreach my $field(@fields){
367 my $val=&XML_readline($xml,$field,'biblios');
368 $result->{$field}=$val if $val;
372 my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like 'biblios' and tagfield is not null" );
375 while ($field=$sth2->fetchrow) {
376 $result->{$field}=&XML_readline($xml,$field,'biblios');
380 ## we only need the following for biblio data
382 # modify copyrightdate to keep only the 1st year found
383 my $temp = $result->{'copyrightdate'};
384 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
386 $result->{'copyrightdate'} = $1;
387 } else { # if no cYYYY, get the 1st date.
388 $temp =~ m/(\d\d\d\d)/;
389 $result->{'copyrightdate'} = $1;
391 # modify publicationyear to keep only the 1st year found
392 $temp = $result->{'publicationyear'};
393 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
395 $result->{'publicationyear'} = $1;
396 } else { # if no cYYYY, get the 1st date.
397 $temp =~ m/(\d\d\d\d)/;
398 $result->{'publicationyear'} = $1;
401 if ($related_record eq "holdings" || $related_record eq "" || !$related_record){
402 my $holdings=$xml->{holdings}->[0]->{record};
406 foreach my $holding (@$holdings){
408 foreach my $field(@fields){
409 my $val=&XML_readline($holding,$field,'holdings');
410 $itemresult->{$field}=$val if $val;
412 push @items, $itemresult;
415 my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like 'holdings' and tagfield is not null" );
416 foreach my $holding (@$holdings){
420 while ($field=$sth2->fetchrow) {
421 $itemresult->{$field}=&XML_readline($xml,$field,'holdings');
423 push @items, $itemresult;
429 return ($result,@items);
431 sub XMLmarc2koha_onerecord {
432 # warn "XMLmarc2koha_onerecord";
433 ##Returns a koha hash from MARCXML hash
435 my ($dbh,$xml,$related_record,@fields) = @_;
438 ## if @fields is given do not bother about the rest of fields just parse those
441 foreach my $field(@fields){
442 my $val=&XML_readline_onerecord($xml,$field,$related_record);
443 $result->{$field}=$val if $val;
446 my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like ? and tagfield is not null" );
447 $sth2->execute($related_record);
449 while ($field=$sth2->fetchrow) {
450 $result->{$field}=&XML_readline_onerecord($xml,$field,$related_record);
457 # warn "XMLmodLCindex";
458 my ($dbh,$xmlhash)=@_;
459 my ($lc)=XML_readline_onerecord($xmlhash,"classification","biblios");
460 my ($cutter)=XML_readline_onerecord($xmlhash,"subclass","biblios");
464 my ($lcsort)=calculatelc($lc);
465 $xmlhash=XML_writeline($xmlhash,"lcsort",$lcsort,"biblios");
470 sub XMLmoditemonefield{
471 # This routine takes itemnumber and biblionumber and updates XMLmarc;
472 ### the ZEBR DB update can wait depending on $donotupdate flag
473 my ($dbh,$biblionumber,$itemnumber,$itemfield,$newvalue,$donotupdate)=@_;
474 my ($record) = XMLgetitem($dbh,$itemnumber);
475 my $recordhash=XML_xml2hash_onerecord($record);
476 XML_writeline( $recordhash, $itemfield, $newvalue,"holdings" );
478 ## Prevent various update calls to zebra wait until all changes finish
479 $record=XML_hash2xml($recordhash);
480 my $sth=$dbh->prepare("update items set marcxml=? where itemnumber=?");
481 $sth->execute($record,$itemnumber);
484 NEWmoditem($dbh,$recordhash,$biblionumber,$itemnumber);
490 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
492 ## Script to deal with MARC read write operations
495 ##Sub to match kohafield to Z3950 -attributes
497 sub MARCfind_attr_from_kohafield {
498 # warn "MARCfind_attr_from_kohafield";
500 my ( $kohafield ) = @_;
501 return 0, 0 unless $kohafield;
503 my $relations = C4::Context->attrfromkohafield;
504 return ($relations->{$kohafield});
509 # warn "MARCgettagslib";
510 my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
511 $frameworkcode = "" unless $frameworkcode;
513 my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
515 # check that framework exists
518 "select count(*) from biblios_tag_structure where frameworkcode=?");
519 $sth->execute($frameworkcode);
520 my ($total) = $sth->fetchrow;
521 $frameworkcode = "" unless ( $total > 0 );
524 "select tagfield,liblibrarian,libopac,mandatory,repeatable from biblios_tag_structure where frameworkcode=? order by tagfield"
526 $sth->execute($frameworkcode);
527 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
529 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
530 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
531 $res->{$tab}->{tab} = ""; # XXX
532 $res->{$tag}->{mandatory} = $mandatory;
533 $res->{$tag}->{repeatable} = $repeatable;
538 "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"
540 $sth->execute($frameworkcode);
543 my $authorised_value;
553 ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
554 $mandatory, $repeatable, $authorised_value, $authtypecode,
555 $value_builder, $seealso, $hidden,
560 $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
561 $res->{$tag}->{$subfield}->{tab} = $tab;
562 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
563 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
564 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
565 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
566 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
567 $res->{$tag}->{$subfield}->{seealso} = $seealso;
568 $res->{$tag}->{$subfield}->{hidden} = $hidden;
569 $res->{$tag}->{$subfield}->{isurl} = $isurl;
570 $res->{$tag}->{$subfield}->{link} = $link;
574 sub MARCitemsgettagslib {
575 # warn "MARCitemsgettagslib";
576 my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
577 $frameworkcode = "" unless $frameworkcode;
579 my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
581 # check that framework exists
584 "select count(*) from holdings_tag_structure where frameworkcode=?");
585 $sth->execute($frameworkcode);
586 my ($total) = $sth->fetchrow;
587 $frameworkcode = "" unless ( $total > 0 );
590 "select tagfield,liblibrarian,libopac,mandatory,repeatable from holdings_tag_structure where frameworkcode=? order by tagfield"
592 $sth->execute($frameworkcode);
593 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
595 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
596 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
597 $res->{$tab}->{tab} = ""; # XXX
598 $res->{$tag}->{mandatory} = $mandatory;
599 $res->{$tag}->{repeatable} = $repeatable;
604 "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"
606 $sth->execute($frameworkcode);
609 my $authorised_value;
619 ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
620 $mandatory, $repeatable, $authorised_value, $authtypecode,
621 $value_builder, $seealso, $hidden,
626 $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
627 $res->{$tag}->{$subfield}->{tab} = $tab;
628 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
629 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
630 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
631 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
632 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
633 $res->{$tag}->{$subfield}->{seealso} = $seealso;
634 $res->{$tag}->{$subfield}->{hidden} = $hidden;
635 $res->{$tag}->{$subfield}->{isurl} = $isurl;
636 $res->{$tag}->{$subfield}->{link} = $link;
640 sub MARCfind_marc_from_kohafield {
641 # warn "MARCfind_marc_from_kohafield";
642 my ( $kohafield,$recordtype) = @_;
643 return 0, 0 unless $kohafield;
644 $recordtype="biblios" unless $recordtype;
645 my $relations = C4::Context->marcfromkohafield;
646 return ($relations->{$recordtype}->{$kohafield}->[0],$relations->{$recordtype}->{$kohafield}->[1]);
652 # Returns MARC::Record of the biblio passed in parameter.
653 ### Takes a new parameter of $title_author =1 which parses the record obly on those fields and nothing else
654 ### Its useful when Koha requires only title&author for performance issues
655 my ( $dbh, $biblionumber, $title_author ) = @_;
657 $dbh->prepare("select marc from biblio where biblionumber=? " );
658 $sth->execute( $biblionumber);
659 my ($marc)=$sth->fetchrow;
662 $record = MARC::File::USMARC::decode($marc,\&func_title_author);
664 $record = MARC::File::USMARC::decode($marc);
675 # warn "MARCgetitem";
676 # Returns MARC::Record of the item passed in parameter uses either itemnumber or barcode
677 my ( $dbh, $itemnumber,$barcode ) = @_;
680 $sth = $dbh->prepare("select i.marc from items i where i.itemnumber=?" );
681 $sth->execute($itemnumber);
683 $sth = $dbh->prepare("select i.marc from items i where i.barcode=?" );
684 $sth->execute($barcode);
686 my ($marc)=$sth->fetchrow;
687 my $record = MARC::File::USMARC::decode($marc);
692 sub MARCgetallitems {
693 # warn "MARCgetallitems";
694 # Returns an array of MARC::Record of the items passed in parameter as biblionumber
695 my ( $dbh, $biblionumber ) = @_;
697 my $sth = $dbh->prepare("select marc from items where biblionumber =?" );
698 $sth->execute($biblionumber);
700 while(my ($marc)=$sth->fetchrow_array){
701 my $record = MARC::File::USMARC::decode($marc);
702 push @results,$record;
712 sub MARCfind_frameworkcode {
713 # warn "MARCfind_frameworkcode";
714 my ( $dbh, $biblionumber ) = @_;
716 $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
717 $sth->execute($biblionumber);
718 my ($frameworkcode) = $sth->fetchrow;
719 return $frameworkcode;
721 sub MARCfind_itemtype {
722 # warn "MARCfind_itemtype";
723 my ( $dbh, $biblionumber ) = @_;
725 $dbh->prepare("select itemtype from biblio where biblionumber=?");
726 $sth->execute($biblionumber);
727 my ($itemtype) = $sth->fetchrow;
734 # warn "MARChtml2xml ";
735 my ($tags,$subfields,$values,$indicator,$ind_tag) = @_;
736 # use MARC::File::XML;
737 my $xml= marc_record_header('UTF-8'); #### we do not need a collection wrapper
743 for (my $i=0;$i<=@$tags;$i++){
744 @$values[$i] =~ s/&/&/g;
745 @$values[$i] =~ s/</</g;
746 @$values[$i] =~ s/>/>/g;
747 @$values[$i] =~ s/"/"/g;
748 @$values[$i] =~ s/'/'/g;
750 if ((@$tags[$i] ne $prevtag)){
751 $j++ unless (@$tags[$i] eq "");
752 ## warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i];
754 $xml.="</datafield>\n";
755 if ((@$tags[$i] > 10) && (@$values[$i] ne "")){
756 my $ind1 = substr(@$indicator[$j],0,1);
757 my $ind2 = substr(@$indicator[$j],1,1);
758 $xml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
759 $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
765 if (@$values[$i] ne "") {
767 if (@$tags[$i] eq "000") {
768 ##Force the leader to UTF8
769 substr(@$values[$i],9,1)="a";
770 $xml.="<leader>@$values[$i]</leader>\n";
772 # rest of the fixed fields
773 } elsif (@$tags[$i] < 10) {
774 $xml.="<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
777 my $ind1 = substr(@$indicator[$j],0,1);
778 my $ind2 = substr(@$indicator[$j],1,1);
779 $xml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
780 $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
785 } else { # @$tags[$i] eq $prevtag
786 if (@$values[$i] eq "") {
790 my $ind1 = substr(@$indicator[$j],0,1);
791 my $ind2 = substr(@$indicator[$j],1,1);
792 $xml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
795 $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
798 $prevtag = @$tags[$i];
802 $xml=Encode::decode('utf8',$xml);
805 sub marc_record_header {
806 #### this one is for <record>
808 my $enc = shift || 'UTF-8';
810 return( <<MARC_XML_HEADER );
811 <?xml version="1.0" encoding="$enc"?>
812 <record xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
813 xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
814 xmlns="http://www.loc.gov/MARC21/slim">
819 sub collection_header {
820 #### this one is for koha collection
822 my $enc = shift || 'UTF-8';
823 return( <<KOHA_XML_HEADER );
824 <?xml version="1.0" encoding="$enc"?>
825 <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">
832 # warn "MARCkoha2marc";
833 ## This routine most probably will be depreaceated -- it is still used for acqui management
834 ##Returns a MARC record from a hash
835 my ($dbh,$result,$recordtype) = @_;
837 my $record = MARC::Record->new();
838 my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where tagfield is not null and recordtype=?");
839 $sth2->execute($recordtype);
841 while (($field)=$sth2->fetchrow) {
842 $record=&MARCkoha2marcOnefield($record,$field,$result->{$field},$recordtype) if $result->{$field};
847 # warn "MARCmarc2koha";
848 ##Returns a hash from MARC record
849 my ($dbh,$record,$related_record) = @_;
851 if (!$related_record){$related_record="biblios";}
852 my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like ? and tagfield is not null" );
853 $sth2->execute($related_record);
855 while ($field=$sth2->fetchrow) {
856 $result=&MARCmarc2kohaOneField($field,$record,$result,$related_record);
859 ## we only need the following for biblio data
860 if ($related_record eq "biblios"){
861 # modify copyrightdate to keep only the 1st year found
862 my $temp = $result->{'copyrightdate'};
863 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
865 $result->{'copyrightdate'} = $1;
866 } else { # if no cYYYY, get the 1st date.
867 $temp =~ m/(\d\d\d\d)/;
868 $result->{'copyrightdate'} = $1;
870 # modify publicationyear to keep only the 1st year found
871 $temp = $result->{'publicationyear'};
872 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
874 $result->{'publicationyear'} = $1;
875 } else { # if no cYYYY, get the 1st date.
876 $temp =~ m/(\d\d\d\d)/;
877 $result->{'publicationyear'} = $1;
883 sub MARCkoha2marcOnefield {
884 ##Updates or creates one field in MARC record
885 my ( $record, $kohafieldname, $value,$recordtype ) = @_;
886 my ( $tagfield, $tagsubfield ) = MARCfind_marc_from_kohafield($kohafieldname,$recordtype);
888 my $tag = $record->field($tagfield);
891 if ($value){## We may be trying to delete a subfield value
892 $tag->update( $tagsubfield=> $value );
894 $tag->delete_subfield(code=>$tagsubfield);
896 $record->delete_field($tag);
897 $record->insert_fields_ordered($tag);
899 my $newtag=MARC::Field->new( $tagfield, " ", " ", $tagsubfield => $value);
900 $record->insert_fields_ordered($newtag);
905 $tag->update( $value );
906 $record->delete_field($tag);
907 $record->insert_fields_ordered($tag);
909 $record->delete_field($tag);
912 my $newtag=MARC::Field->new( $tagfield => $value);
913 $record->insert_fields_ordered($newtag);
916 }## $tagfield defined
920 sub MARCmarc2kohaOneField {
921 my ( $kohafield, $record, $result,$recordtype ) = @_;
922 # # warn "kohatable / $kohafield / $result / ";
925 my ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield($kohafield,$recordtype);
927 foreach my $field ( $record->field($tagfield) ) {
928 if ($field->tag()<10) {
929 if ($result->{$kohafield}) {
930 $result->{$kohafield} .= " | ".$field->data();
932 $result->{$kohafield} = $field->data();
935 if ( $field->subfields ) {
936 my @subfields = $field->subfields();
937 foreach my $subfieldcount ( 0 .. $#subfields ) {
938 if ($subfields[$subfieldcount][0] eq $subfield) {
939 if ( $result->{$kohafield} ) {
940 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
943 $result->{$kohafield} = $subfields[$subfieldcount][1];
956 ##########################NEW NEW NEW#############################
958 my ( $dbh, $xml, $frameworkcode) = @_;
959 $frameworkcode="" unless $frameworkcode;
960 my $biblionumber=XML_readline_onerecord($xml,"biblionumber","biblios");
961 ## In case reimporting records with biblionumbers keep them
963 $biblionumber=NEWmodbiblio( $dbh, $biblionumber,$xml,$frameworkcode );
965 $biblionumber = NEWaddbiblio( $dbh, $xml,$frameworkcode );
968 return ( $biblionumber );
975 sub NEWmodbiblioframework {
976 my ($dbh,$biblionumber,$frameworkcode) =@_;
977 my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=$biblionumber");
978 $sth->execute($frameworkcode);
985 my ( $dbh, $biblionumber ) = @_;
986 my $sth=$dbh->prepare("SELECT itemnumber FROM items where biblionumber=?");
988 $sth->execute($biblionumber);
989 while (my $itemnumber =$sth->fetchrow){
990 OLDdelitem($dbh,$itemnumber) ;
993 ZEBRAop($dbh,$biblionumber,"recordDelete","biblioserver");
994 OLDdelbiblio($dbh,$biblionumber) ;
999 my ( $dbh, $xmlhash, $biblionumber ) = @_;
1000 my $itemtype= MARCfind_itemtype($dbh,$biblionumber);
1002 ## In case we are re-importing marc records from bulk import do not change itemnumbers
1003 my $itemnumber=XML_readline_onerecord($xmlhash,"itemnumber","holdings");
1005 NEWmoditem ( $dbh, $xmlhash, $biblionumber, $itemnumber);
1008 ##Add biblionumber to $record
1009 $xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"holdings");
1010 # MARCkoha2marcOnefield($record,"biblionumber",$biblionumber,"holdings");
1011 my $sth=$dbh->prepare("select notforloan from itemtypes where itemtype='$itemtype'");
1013 my $notforloan=$sth->fetchrow;
1014 ##Change the notforloan field if $notforloan found
1015 if ($notforloan >0){
1016 $xmlhash=XML_writeline($xmlhash,"notforloan",$notforloan,"holdings");
1018 my $dateaccessioned=XML_readline_onerecord($xmlhash,"dateaccessioned","holdings");
1019 unless($dateaccessioned){
1021 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
1022 localtime(time); $year +=1900; $mon +=1;
1023 my $date = "$year-".sprintf ("%0.2d", $mon)."-".sprintf("%0.2d",$mday);
1025 $xmlhash=XML_writeline($xmlhash,"dateaccessioned",$date,"holdings");
1028 ## Now calculate itempart of cutter-- This is NEU specific
1029 my $itemcallnumber=XML_readline_onerecord($xmlhash,"itemcallnumber","holdings");
1030 if ($itemcallnumber){
1031 my ($cutterextra)=itemcalculator($dbh,$biblionumber,$itemcallnumber);
1032 $xmlhash=XML_writeline($xmlhash,"cutterextra",$cutterextra,"holdings");
1035 ##NEU specific add cataloguers cardnumber as well
1036 my $me= C4::Context->userenv;
1037 my $cataloger=$me->{'cardnumber'} if ($me);
1038 $xmlhash=XML_writeline($xmlhash,"circid",$cataloger,"holdings") if $cataloger;
1041 my $itemnumber = &OLDnewitems( $dbh, $xmlhash );
1043 # add the item to zebra it will add the biblio as well!!!
1044 ZEBRAop( $dbh, $biblionumber,"specialUpdate","biblioserver" );
1053 my ( $dbh, $xmlhash, $biblionumber, $itemnumber ) = @_;
1055 ##Add itemnumber incase lost (old bug 090c was lost sometimes) --just incase
1056 $xmlhash=XML_writeline($xmlhash,"itemnumber",$itemnumber,"holdings");
1057 ##Add biblionumber incase lost on html
1058 $xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"holdings");
1060 my $barcode=XML_readline_onerecord($xmlhash,"barcode","holdings");
1061 ## Now calculate itempart of cutter-- This is NEU specific
1062 my $itemcallnumber=XML_readline_onerecord($xmlhash,"itemcallnumber","holdings");
1063 if ($itemcallnumber){
1064 my ($cutterextra)=itemcalculator($dbh,$biblionumber,$itemcallnumber);
1065 $xmlhash=XML_writeline($xmlhash,"cutterextra",$cutterextra,"holdings");
1068 ##NEU specific add cataloguers cardnumber as well
1069 my $me= C4::Context->userenv;
1070 my $cataloger=$me->{'cardnumber'} if ($me);
1071 $xmlhash=XML_writeline($xmlhash,"circid",$cataloger,"holdings") if $cataloger;
1072 my $xml=XML_hash2xml($xmlhash);
1073 OLDmoditem( $dbh, $xml,$biblionumber,$itemnumber,$barcode );
1074 ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
1078 my ( $dbh, $itemnumber ) = @_;
1079 my $sth=$dbh->prepare("SELECT biblionumber from items where itemnumber=?");
1080 $sth->execute($itemnumber);
1081 my $biblionumber=$sth->fetchrow;
1082 OLDdelitem( $dbh, $itemnumber ) ;
1083 ZEBRAop($dbh,$biblionumber,"recordDelete","biblioserver");
1091 my ( $dbh, $xmlhash,$frameworkcode ) = @_;
1092 my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
1094 my $data = $sth->fetchrow;
1095 my $biblionumber = $data + 1;
1097 # we must add biblionumber
1099 $xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"biblios");
1101 ###NEU specific add cataloguers cardnumber as well
1103 my $me= C4::Context->userenv;
1104 my $cataloger=$me->{'cardnumber'} if ($me);
1105 $xmlhash=XML_writeline($xmlhash,"indexedby",$cataloger,"biblios") if $cataloger;
1107 ## We must add the indexing fields for LC in MARC record--TG
1108 &XMLmodLCindex($dbh,$xmlhash);
1111 my $itemtype=XML_readline_onerecord($xmlhash,"itemtype","biblios");
1113 my $isbn=XML_readline_onerecord($xmlhash,"isbn","biblios");
1115 my $issn=XML_readline_onerecord($xmlhash,"issn","biblios");
1117 my $title=XML_readline_onerecord($xmlhash,"title","biblios");
1119 my $author=XML_readline_onerecord($xmlhash,"title","biblios");
1120 my $xml=XML_hash2xml($xmlhash);
1122 $sth = $dbh->prepare("insert into biblio set biblionumber = ?,frameworkcode=?, itemtype=?,marcxml=?,title=?,author=?,isbn=?,issn=?" );
1123 $sth->execute( $biblionumber,$frameworkcode, $itemtype,$xml ,$title,$author,$isbn,$issn );
1126 ### Do not add biblio to ZEBRA unless there is an item with it -- depends on system preference defaults to NO
1127 if (C4::Context->preference('AddaloneBiblios')){
1128 ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
1130 return ($biblionumber);
1134 my ( $dbh, $biblionumber,$xmlhash,$frameworkcode ) = @_;
1135 ##Add biblionumber incase lost on html
1137 $xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"biblios");
1139 ###NEU specific add cataloguers cardnumber as well
1140 my $me= C4::Context->userenv;
1141 my $cataloger=$me->{'cardnumber'} if ($me);
1143 $xmlhash=XML_writeline($xmlhash,"indexedby",$cataloger,"biblios") if $cataloger;
1145 ## We must add the indexing fields for LC in MARC record--TG
1147 ## XMLmodLCindex($dbh,$xmlhash);
1148 OLDmodbiblio ($dbh,$xmlhash,$biblionumber,$frameworkcode);
1149 my $ok=ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
1150 return ($biblionumber);
1155 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1161 my ( $dbh, $xmlhash) = @_;
1162 my $sth = $dbh->prepare("SELECT max(itemnumber) from items");
1166 $data = $sth->fetchrow_hashref;
1167 $itemnumber = $data->{'max(itemnumber)'} + 1;
1169 $xmlhash=XML_writeline( $xmlhash, "itemnumber", $itemnumber,"holdings" );
1170 my $biblionumber=XML_readline_onerecord($xmlhash,"biblionumber","holdings");
1171 my $barcode=XML_readline_onerecord($xmlhash,"barcode","holdings");
1172 my $xml=XML_hash2xml($xmlhash);
1173 $sth = $dbh->prepare( "Insert into items set itemnumber = ?, biblionumber = ?,barcode = ?,marcxml=?" );
1174 $sth->execute($itemnumber,$biblionumber,$barcode,$xml);
1179 my ( $dbh, $xml,$biblionumber,$itemnumber,$barcode ) = @_;
1180 my $sth =$dbh->prepare("replace items set biblionumber=?,marcxml=?,barcode=? , itemnumber=?");
1181 $sth->execute($biblionumber,$xml,$barcode,$itemnumber);
1186 my ( $dbh, $itemnumber ) = @_;
1187 my $sth = $dbh->prepare("select * from items where itemnumber=?");
1188 $sth->execute($itemnumber);
1189 if ( my $data = $sth->fetchrow_hashref ) {
1191 my $query = "replace deleteditems set ";
1193 foreach my $temp ( keys %$data ) {
1194 $query .= "$temp = ?,";
1195 push ( @bind, $data->{$temp} );
1198 #replacing the last , by ",?)"
1200 $sth = $dbh->prepare($query);
1201 $sth->execute(@bind);
1203 $sth = $dbh->prepare("Delete from items where itemnumber=?");
1204 $sth->execute($itemnumber);
1211 # modifies the biblio table
1212 my ($dbh,$xmlhash,$biblionumber,$frameworkcode) = @_;
1213 if (!$frameworkcode){
1217 my $itemtype=XML_readline_onerecord($xmlhash,"itemtype","biblios");
1219 my $isbn=XML_readline_onerecord($xmlhash,"isbn","biblios");
1221 my $issn=XML_readline_onerecord($xmlhash,"issn","biblios");
1223 my $title=XML_readline_onerecord($xmlhash,"title","biblios");
1225 my $author=XML_readline_onerecord($xmlhash,"author","biblios");
1226 my $xml=XML_hash2xml($xmlhash);
1228 #my $marc=MARC::Record->new_from_xml($xml,'UTF-8');## this will be depreceated
1229 $isbn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g;
1230 $issn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g;
1231 $isbn=~s/^\s+|\s+$//g;
1232 $isbn=substr($isbn,0,13);
1233 my $sth = $dbh->prepare("REPLACE biblio set biblionumber=?,marcxml=?,frameworkcode=? ,itemtype=? , title=?,author=?,isbn=?,issn=?" );
1234 $sth->execute( $biblionumber ,$xml, $frameworkcode,$itemtype, $title,$author,$isbn,$issn);
1236 return $biblionumber;
1240 my ( $dbh, $biblionumber ) = @_;
1241 my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1242 $sth->execute($biblionumber);
1243 if ( my $data = $sth->fetchrow_hashref ) {
1245 my $query = "replace deletedbiblio set ";
1247 foreach my $temp ( keys %$data ) {
1248 $query .= "$temp = ?,";
1249 push ( @bind, $data->{$temp} );
1252 #replacing the last , by ",?)"
1254 $sth = $dbh->prepare($query);
1255 $sth->execute(@bind);
1257 $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1258 $sth->execute($biblionumber);
1272 sub ZEBRAgetrecord {
1273 my $biblionumber=shift;
1275 $oConnection[0]=C4::Context->Zconn("biblioserver");
1276 my $field=MARCfind_attr_from_kohafield("biblionumber");
1277 my $query=$field." ".$biblionumber;
1278 my $oResult= $oConnection[0]->search_pqf($query);
1281 while (($i = ZOOM::event(\@oConnection)) != 0) {
1282 $event = $oConnection[$i-1]->last_event();
1283 last if $event == ZOOM::Event::ZEND;
1285 if ($oResult->size()){
1286 my $xmlrecord=$oResult->record(0)->raw() ;
1287 $oConnection[0]->destroy;
1288 $xmlrecord=Encode::decode('utf8',$xmlrecord);
1289 my $hashed=XML_xml2hash($xmlrecord);
1290 my ( $xmlrecord, @itemsrecord) = XML_separate($hashed);
1291 return ($xmlrecord, @itemsrecord);
1293 return (undef,undef);
1299 ### Puts the zebra update in queue writes in zebraserver table
1300 my ($dbh,$biblionumber,$op,$server)=@_;
1303 my $sth=$dbh->prepare("insert into zebraqueue (biblio_auth_number ,server,operation) values(?,?,?)");
1304 $sth->execute($biblionumber,$server,$op);
1310 ###Accepts a $server variable thus we can use it to update biblios, authorities or other zebra dbs
1311 my ($record,$op,$server)=@_;
1318 $record=Encode::encode("UTF-8",$record);
1319 my $shadow=$server."shadow";
1322 $Zconnbiblio[0]=C4::Context->Zconnauth($server);
1324 my $Zpackage = $Zconnbiblio[0]->package();
1325 $Zpackage->option(action => $op);
1326 $Zpackage->option(record => $record);
1328 $Zpackage->send("update");
1332 while (($i = ZOOM::event(\@Zconnbiblio)) != 0) {
1333 $event = $Zconnbiblio[0]->last_event();
1334 last if $event == ZOOM::Event::ZEND;
1336 my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio[0]->error_x();
1337 if ($error==10007 && $tried<3) {## timeout --another 30 looonng seconds for this update
1338 sleep 1; ## wait a sec!
1341 }elsif ($error==2 && $tried<2) {## timeout --temporary zebra error !whatever that means
1342 sleep 2; ## wait two seconds!
1345 }elsif($error==10004 && $recon==0){##Lost connection -reconnect
1346 sleep 1; ## wait a sec!
1348 $Zpackage->destroy();
1349 $Zconnbiblio[0]->destroy();
1352 # warn "Error-$server $op /errcode:, $error, /MSG:,$errmsg,$addinfo \n";
1353 $Zpackage->destroy();
1354 $Zconnbiblio[0]->destroy();
1355 # ZEBRAopfiles($dbh,$biblionumber,$record,$op,$server);
1358 ## System preference batchMode=1 means wea are bulk importing
1359 ## DO NOT COMMIT while in batchMode for faster operation
1360 my $batchmode=C4::Context->preference('batchMode');
1361 if (C4::Context->$shadow >0 && !$batchmode){
1362 $Zpackage->send('commit');
1363 while (($i = ZOOM::event(\@Zconnbiblio)) != 0) {
1364 $event = $Zconnbiblio[0]->last_event();
1365 last if $event == ZOOM::Event::ZEND;
1367 my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio[0]->error_x();
1368 if ($error) { ## This is serious ZEBRA server is not updating
1369 $Zpackage->destroy();
1370 $Zconnbiblio[0]->destroy();
1375 $Zpackage->destroy();
1376 $Zconnbiblio[0]->destroy();
1383 my ($dbh,$biblionumber)=@_;
1384 my $biblioxml=XMLgetbiblio($dbh,$biblionumber);
1385 my @itemxml=XMLgetallitems($dbh,$biblionumber);
1386 my $zebraxml=collection_header();
1387 $zebraxml.="<koharecord>";
1388 $zebraxml.=$biblioxml;
1389 $zebraxml.="<holdings>";
1390 foreach my $item(@itemxml){
1391 $zebraxml.=$item if $item;
1393 $zebraxml.="</holdings>";
1394 $zebraxml.="</koharecord>";
1395 $zebraxml.="</kohacollection>";
1399 sub ZEBRA_readyXML_noheader{
1400 my ($dbh,$biblionumber)=@_;
1401 my $biblioxml=XMLgetbiblio($dbh,$biblionumber);
1402 my @itemxml=XMLgetallitems($dbh,$biblionumber);
1403 my $zebraxml="<koharecord>";
1404 $zebraxml.=$biblioxml;
1405 $zebraxml.="<holdings>";
1406 foreach my $item(@itemxml){
1407 $zebraxml.=$item if $item;
1409 $zebraxml.="</holdings>";
1410 $zebraxml.="</koharecord>";
1416 # various utility subs and those not complying to new rules
1421 ## Used in acqui management -- creates the biblio from hash rather than marc-record
1423 my $dbh = C4::Context->dbh;
1424 my $record=MARCkoha2marc($dbh,$biblio,"biblios");
1425 $record->encoding('UTF-8');
1426 my $biblionumber=NEWnewbiblio($dbh,$record);
1427 return ($biblionumber);
1430 ## Used in acqui management -- modifies the biblio from hash rather than marc-record
1432 my $dbh = C4::Context->dbh;
1433 my $record=MARCkoha2marc($dbh,$biblio,"biblios");
1434 my $biblionumber=NEWmodbiblio($dbh,$record,$biblio->{biblionumber});
1435 return ($biblionumber);
1439 ## Used in acqui management -- creates the item from hash rather than marc-record
1440 my ( $item, @barcodes ) = @_;
1441 my $dbh = C4::Context->dbh;
1445 foreach my $barcode (@barcodes) {
1446 $item->{barcode}=$barcode;
1447 my $record=MARCkoha2marc($dbh,$item,"holdings");
1448 my $itemnumber= NEWnewitem($dbh,$record,$item->{biblionumber});
1451 return $itemnumber ;
1458 my $dbh = C4::Context->dbh;
1459 my $query = "select * from itemtypes order by description";
1460 my $sth = $dbh->prepare($query);
1462 # || die "Cannot prepare $query" . $dbh->errstr;
1466 # || die "Cannot execute $query\n" . $sth->errstr;
1467 while ( my $data = $sth->fetchrow_hashref ) {
1468 $results[$count] = $data;
1473 return ( $count, @results );
1474 } # sub getitemtypes
1479 #returns MySQL like fieldnames to emulate searches on sql like fieldnames
1481 ## Either opac or intranet to select appropriate fields
1483 $type="intra" unless $type;
1484 if ($type eq "intranet"){ $type="intra";}
1485 my $dbh = C4::Context->dbh;
1489 my $sth=$dbh->prepare("SELECT * FROM koha_attr where $type=1 order by liblibrarian");
1491 while (my $data=$sth->fetchrow_hashref){
1496 return ($i,@results);
1504 ## Old style ISBN handling should be modified to accept 13 digits
1508 if(substr($isbn, 0, 1) <=7) {
1509 $seg1 = substr($isbn, 0, 1);
1510 } elsif(substr($isbn, 0, 2) <= 94) {
1511 $seg1 = substr($isbn, 0, 2);
1512 } elsif(substr($isbn, 0, 3) <= 995) {
1513 $seg1 = substr($isbn, 0, 3);
1514 } elsif(substr($isbn, 0, 4) <= 9989) {
1515 $seg1 = substr($isbn, 0, 4);
1517 $seg1 = substr($isbn, 0, 5);
1519 my $x = substr($isbn, length($seg1));
1521 if(substr($x, 0, 2) <= 19) {
1522 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
1523 $seg2 = substr($x, 0, 2);
1524 } elsif(substr($x, 0, 3) <= 699) {
1525 $seg2 = substr($x, 0, 3);
1526 } elsif(substr($x, 0, 4) <= 8399) {
1527 $seg2 = substr($x, 0, 4);
1528 } elsif(substr($x, 0, 5) <= 89999) {
1529 $seg2 = substr($x, 0, 5);
1530 } elsif(substr($x, 0, 6) <= 9499999) {
1531 $seg2 = substr($x, 0, 6);
1533 $seg2 = substr($x, 0, 7);
1535 my $seg3=substr($x,length($seg2));
1536 $seg3=substr($seg3,0,length($seg3)-1) ;
1537 my $seg4 = substr($x, -1, 1);
1538 return "$seg1-$seg2-$seg3-$seg4";
1541 ## Function to create padded LC call number for sorting items with their LC code. Not exported
1542 my ($classification)=@_;
1543 $classification=~s/^\s+|\s+$//g;
1547 for ($i=0; $i<length($classification);$i++){
1548 my $c=(substr($classification,$i,1));
1549 if ($c ge '0' && $c le '9'){
1551 $lc2=substr($classification,$i);
1554 $lc1.=substr($classification,$i,1);
1559 my $other=length($lc1);
1560 if(!$lc1){$other=0;}
1563 for (1..(4-$other)){
1572 ##Find the decimal part of $lc2
1573 my $pos=index($lc2,".");
1574 if ($pos<0){$pos=length($lc2);}
1575 if ($pos>=0 && $pos<5){
1576 ##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort as numeric
1587 ## Sublimentary function to obtain sorted LC for items. Not exported
1588 my ($dbh,$biblionumber,$callnumber)=@_;
1589 my $xml=XMLgetbiblio($dbh,$biblionumber);
1590 my $xmlhash=XML_xml2hash_onerecord($xml);
1591 my $lc=XML_readline_onerecord($xmlhash,"classification","biblios");
1592 my $cutter=XML_readline_onerecord($xmlhash,"subclass","biblios");
1593 my $all=$lc." ".$cutter;
1594 my $total=length($all);
1595 my $cutterextra=substr($callnumber,$total);
1596 return $cutterextra;
1601 #### This function allows decoding of only title and author out of a MARC record
1602 sub func_title_author {
1603 my ($tagno,$tagdata) = @_;
1604 my ($titlef,$subf)=&MARCfind_marc_from_kohafield("title","biblios");
1605 my ($authf,$subf)=&MARCfind_marc_from_kohafield("author","biblios");
1606 return ($tagno == $titlef || $tagno == $authf);
1611 END { } # module clean-up code here (global destructor)
1617 Koha Developement team <info@koha.org>