From 99d79a6f7f2511efa75d4c92cb40aaee67405166 Mon Sep 17 00:00:00 2001 From: tgarip1957 Date: Fri, 1 Sep 2006 15:33:46 +0000 Subject: [PATCH] No more MARC Records - everything is MARC XML we read - write only XML --- C4/Accounts2.pm | 91 +++---- C4/Biblio.pm | 640 ++++++++++++++++++++++++------------------------ C4/Context.pm | 22 +- C4/Koha.pm | 2 + C4/Search.pm | 140 ++++++----- C4/Serials.pm | 16 +- 6 files changed, 450 insertions(+), 461 deletions(-) diff --git a/C4/Accounts2.pm b/C4/Accounts2.pm index 0af3927152..39a7861eda 100755 --- a/C4/Accounts2.pm +++ b/C4/Accounts2.pm @@ -381,7 +381,7 @@ sub manualcredit{ my $dbh = C4::Context->dbh; my $insert; $itemnum=~ s/ //g; - my %env; + my $accountno=getnextacctno('',$bornum,$dbh); # my $amountleft=$amount; my $amountleft; @@ -389,60 +389,50 @@ my $noerror; if ($type eq 'CN' || $type eq 'CA' || $type eq 'CR' || $type eq 'CF' || $type eq 'CL' || $type eq 'CM'){ my $amount2=$amount*-1; # FIXME - $amount2 = -$amount - ( $amountleft, $noerror,$oldaccount)=fixcredit(\%env,$bornum,$amount2,$itemnum,$type,$user); + ( $amountleft, $noerror,$oldaccount)=fixcredit($dbh,$bornum,$amount2,$itemnum,$type,$user); } if ($noerror>0){ - if ($type eq 'CN'){ - $desc.="Card fee credited by:".$user; - } -if ($type eq 'CM'){ - $desc.="Other fees credited by:".$user; - } -if ($type eq 'CR'){ - $desc.="Resrvation fee credited by:".$user; - } -if ($type eq 'CA'){ - $desc.="Managenent fee credited by:".$user; - } - if ($type eq 'CL' && $desc eq ''){ - $desc="Lost Item credited by:".$user; - } + if ($type eq 'CN'){ + $desc.="Card fee credited by:".$user; + } + if ($type eq 'CM'){ + $desc.="Other fees credited by:".$user; + } + if ($type eq 'CR'){ + $desc.="Resrvation fee credited by:".$user; + } + if ($type eq 'CA'){ + $desc.="Managenent fee credited by:".$user; + } + if ($type eq 'CL' && $desc eq ''){ + $desc="Lost Item credited by:".$user; + } - if ($itemnum ne ''){ - - $desc.=" Credited for overdue item:".$itemnum. " by:".$user; - my $sth=$dbh->prepare("INSERT INTO accountlines + if ($itemnum ne ''){ + $desc.=" Credited for overdue item:".$itemnum. " by:".$user; + my $sth=$dbh->prepare("INSERT INTO accountlines (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,offset) VALUES (?, ?, now(), ?,?, ?,?,?,?)"); - $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$oldaccount); - } else { -# $desc=$dbh->quote($desc); - my $sth=$dbh->prepare("INSERT INTO accountlines + $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$oldaccount); + } else { + my $sth=$dbh->prepare("INSERT INTO accountlines (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,offset) VALUES (?, ?, now(), ?, ?, ?, ?,?)"); - $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft,$oldaccount); - - } + $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft,$oldaccount); + } return ("0"); } else { return("1"); } } # fixcredit -# $amountleft = &fixcredit($env, $bornumber, $data, $barcode, $type, $user); -# -# This function is only used internally. -# FIXME - Figure out what this function does, and write it down. sub fixcredit{ #here we update both the accountoffsets and the account lines - my ($env,$bornumber,$data,$barcode,$type,$user)=@_; - my $dbh = C4::Context->dbh; + my ($dbh,$bornumber,$data,$itemnumber,$type,$user)=@_; my $newamtos = 0; my $accdata = ""; my $amountleft = $data; - - # my $item=getiteminformation($env,'',$barcode); - my $nextaccntno = getnextacctno($env,$bornumber,$dbh); + my $env; my $query="Select * from accountlines where (borrowernumber=? and amountoutstanding > 0)"; my $exectype; @@ -463,8 +453,8 @@ my $exectype; } # print $query; my $sth=$dbh->prepare($query); - if ($exectype && $barcode ne ''){ - $sth->execute($bornumber,$barcode); + if ($exectype && $itemnumber ne ''){ + $sth->execute($bornumber,$itemnumber); }else{ $sth->execute($bornumber); } @@ -484,14 +474,9 @@ if ($accdata){ where (borrowernumber = ?) and (accountno=?)"); $usth->execute($newamtos,$bornumber,$thisacct); $usth->finish; -# $usth = $dbh->prepare("insert into accountoffsets - # (borrowernumber, accountno, offsetaccount, offsetamount) - # values (?,?,?,?)"); -# $usth->execute($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos); - # $usth->finish; + # begin transaction - my $nextaccntno = getnextacctno($env,$bornumber,$dbh); # get lines with outstanding amounts to offset my $sth = $dbh->prepare("select * from accountlines where (borrowernumber = ?) and (amountoutstanding >0) @@ -512,16 +497,9 @@ if ($accdata){ where (borrowernumber = ?) and (accountno=?)"); $usth->execute($newamtos,$bornumber,$thisacct); $usth->finish; -# $usth = $dbh->prepare("insert into accountoffsets - # (borrowernumber, accountno, offsetaccount, offsetamount) - # values (?,?,?,?)"); - # $usth->execute($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos); - # $usth->finish; } $sth->finish; -# $env->{'branch'}=$user; - # $type="Credit ".$type; - # UpdateStats($env,$user,$type,$data,$user,'','',$bornumber); + $amountleft*=-1; return($amountleft,1,$accdata->{'accountno'}); }else{ @@ -540,7 +518,6 @@ sub refund{ my $amountleft = $data *-1; # begin transaction - my $nextaccntno = getnextacctno($env,$bornumber,$dbh); # get lines with outstanding amounts to offset my $sth = $dbh->prepare("select * from accountlines where (borrowernumber = ?) and (amountoutstanding<0) @@ -562,11 +539,7 @@ sub refund{ where (borrowernumber = ?) and (accountno=?)"); $usth->execute($newamtos,$bornumber,$thisacct); $usth->finish; -# $usth = $dbh->prepare("insert into accountoffsets -# (borrowernumber, accountno, offsetaccount, offsetamount) - # values (?,?,?,?)"); -# $usth->execute($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos); -# $usth->finish; + } $sth->finish; return($amountleft); diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 8822a4a1c1..015e3090d4 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -24,7 +24,8 @@ use MARC::File::USMARC; use MARC::File::XML; use XML::Simple; use Encode; - +use utf8; +use Data::Dumper; use vars qw($VERSION @ISA @EXPORT); # set the version for version checking @@ -54,29 +55,34 @@ $VERSION = 2.01; &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_writeline +&XMLmoditemonefield &ZEBRAgetrecord -&ZEBRAgetallitems -&ZEBRAop &ZEBRAopserver + +&ZEBRAop +&ZEBRAopserver &ZEBRA_readyXML &ZEBRA_readyXML_noheader @@ -88,14 +94,52 @@ $VERSION = 2.01; #################### 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{ -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"){ @@ -107,7 +151,7 @@ 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}; } } } @@ -116,7 +160,7 @@ if ($recordtype eq "holdings"){ }else{ foreach my $control (@$hcontrolfield){ if ($control->{'tag'} eq $tag){ - return Encode::decode("UTF-8",$control->{'content'}); + return $control->{'content'}; } } }##tag @@ -130,7 +174,7 @@ my $controlfields=$xml->{'record'}->[0]->{'controlfield'}; foreach my $subfield ( $data->{'subfield'}){ foreach my $code ( @$subfield){ if ($code->{'code'} eq $subf){ - return Encode::decode("UTF-8",$code->{'content'}); + return $code->{'content'}; } } } @@ -140,7 +184,7 @@ my $controlfields=$xml->{'record'}->[0]->{'controlfield'}; 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 @@ -150,45 +194,57 @@ return ""; } 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); +## 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=0; 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 + ## Tag did not exist if (!$updated){ - push @$biblio,{datafield=>[{ - 'ind1' => ' ', - 'ind2' => ' ', - 'subfield' => [ - { - 'content' => $newvalue, - 'code' => $subf - } - ], - 'tag' => $tag - }] - }; + if ($subf){ + push @$biblio, + { + 'ind1' => ' ', + 'ind2' => ' ', + 'subfield' => [ + { + 'content' =>$newvalue, + 'code' => $subf + } + ], + 'tag' =>$tag + } ; + }else{ + push @$biblio, + { + 'ind1' => ' ', + 'ind2' => ' ', + 'tag' =>$tag + } ; + } }## created now }else{ foreach my $control(@$controlfield){ @@ -211,24 +267,52 @@ 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)=@_; + 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 ) = @_; @@ -241,8 +325,17 @@ if ($itemnumber){ $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=XMLgeitem( $dbh, $itemnumber,$barcode); +my $xmlhash=XML_xml2hash_onerecord($xml); +return $xmlhash; +} + sub XMLgetallitems { # warn "XMLgetallitems"; @@ -253,6 +346,7 @@ my $sth = $dbh->prepare("select marcxml from items where biblionumber =?" ); $sth->execute($biblionumber); while(my ($marcxml)=$sth->fetchrow_array){ +$marcxml=Encode::decode('utf8',$marcxml); push @results,$marcxml; } return @results; @@ -260,7 +354,7 @@ 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); @@ -334,7 +428,63 @@ my $itemresult; 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 marctokoha 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); +} + +} # # # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC @@ -554,23 +704,7 @@ my $sth = $dbh->prepare("select marc from items where biblionumber =?" ); 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); -} -} @@ -631,6 +765,8 @@ sub MARChtml2xml { if (@$values[$i] ne "") { # leader if (@$tags[$i] eq "000") { + ##Force the leader to UTF8 + substr(@$values[$i],9,1)="a"; $xml.="@$values[$i]\n"; $first=1; # rest of the fixed fields @@ -663,16 +799,17 @@ sub MARChtml2xml { } $xml.=""; # warn $xml; + $xml=Encode::decode('utf8',$xml); return $xml; } sub marc_record_header { #### this one is for my $format = shift; my $enc = shift || 'UTF-8'; +## return( < - MARC_XML_HEADER @@ -689,64 +826,7 @@ sub collection_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"; @@ -871,32 +951,18 @@ if ($tagfield){ 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 ); @@ -930,49 +996,49 @@ OLDdelbiblio($dbh,$biblionumber) ; } 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"); +# MARCkoha2marcOnefield($record,"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" ); @@ -984,70 +1050,32 @@ return $itemnumber; 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; @@ -1060,53 +1088,39 @@ ZEBRAop($dbh,$biblionumber,"recordDelete","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 @@ -1117,38 +1131,21 @@ if (C4::Context->preference('AddaloneBiblios')){ } 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); } @@ -1161,7 +1158,7 @@ my $oldtag=$record->field($tag); sub OLDnewitems { - my ( $dbh, $barcode,$record) = @_; + my ( $dbh, $xmlhash) = @_; my $sth = $dbh->prepare("SELECT max(itemnumber) from items"); my $data; my $itemnumber; @@ -1169,24 +1166,19 @@ sub OLDnewitems { $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; } @@ -1217,22 +1209,29 @@ my $sth = $dbh->prepare("select * from items where itemnumber=?"); 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); + +#my $marc=MARC::Record->new_from_xml($xml,'UTF-8');## this will be depreceated $isbn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g; $issn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g; $isbn=~s/^\s+|\s+$//g; $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; } @@ -1270,28 +1269,32 @@ sub OLDdelbiblio { # # -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 ZEBRAgetrecord { +my $biblionumber=shift; +my @oConnection; + $oConnection[0]=C4::Context->Zconn("biblioserver"); +my $field=MARCfind_attr_from_kohafield("biblionumber"); +my $query=$field." ".$biblionumber; +my $oResult= $oConnection[0]->search_pqf($query); +my $event; +my $i; + while (($i = ZOOM::event(\@oConnection)) != 0) { + $event = $oConnection[$i-1]->last_event(); + last if $event == ZOOM::Event::ZEND; + }# while +if ($oResult->size()){ +my $xmlrecord=$oResult->record(0)->raw() ; +$oConnection[0]->destroy; +$xmlrecord=Encode::decode('utf8',$xmlrecord); +my $hashed=XML_xml2hash($xmlrecord); +my ( $xmlrecord, @itemsrecord) = XML_separate($hashed); +return ($xmlrecord, @itemsrecord); +}else{ +return (undef,undef); } - } + sub ZEBRAop { ### Puts the zebra update in queue writes in zebraserver table my ($dbh,$biblionumber,$op,$server)=@_; @@ -1499,6 +1502,7 @@ return ($i,@results); sub DisplayISBN { ## Old style ISBN handling should be modified to accept 13 digits + my ($isbn)=@_; my $seg1; if(substr($isbn, 0, 1) <=7) { @@ -1582,13 +1586,13 @@ return($lc1.$lc2); 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 $xml=XMLgetbiblio($dbh,$biblionumber); +my $xmlhash=XML_xml2hash_onerecord($xml); +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; } diff --git a/C4/Context.pm b/C4/Context.pm index c180f7738b..0c79264d23 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -18,7 +18,7 @@ # $Id$ package C4::Context; use strict; -use C4::UTF8DBI; +use DBI; use C4::Boolean; use XML::Simple; use vars qw($VERSION $AUTOLOAD), @@ -484,14 +484,11 @@ sub _new_dbh my $db_host = $context->config("hostname"); my $db_user = $context->config("user"); my $db_passwd = $context->config("pass"); - my $dbh= UTF8DBI->connect("DBI:$db_driver:$db_name:$db_host", + my $dbh= DBI->connect("DBI:$db_driver:$db_name:$db_host", $db_user, $db_passwd); # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config. # this is better than modifying my.cnf (and forcing all communications to be in utf8) -# $dbh->do("set NAMES 'utf8'"); -# $dbh->do("SET character_set_client=utf8"); -# $dbh->do("SET character_set_connection=utf8"); -# $dbh->do("SET character_set_results=utf8"); + $dbh->do("set NAMES 'utf8'"); return $dbh; } @@ -835,16 +832,9 @@ Andrew Arensburger =cut # $Log$ -# Revision 1.44 2006/08/25 21:07:08 tgarip1957 -# New set of routines for HEAD. -# Uses a complete new ZEBRA Indexing. -# ZEBRA is now XML and comprises of a KOHA meta record. Explanatory notes will be on koha-devel -# Fixes UTF8 problems -# Fixes bug with authorities -# SQL database major changes. -# Separate biblioograaphic and holdings records. Biblioitems table depreceated -# etc. etc. -# Wait for explanatory document on koha-devel +# Revision 1.45 2006/09/01 15:33:47 tgarip1957 +# No more MARC Records - everything is MARC XML +# we read - write only XML # # Revision 1.43 2006/08/10 12:49:37 toins # sync with dev_week. diff --git a/C4/Koha.pm b/C4/Koha.pm index db2a5d3408..e2bd059c95 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -138,6 +138,8 @@ sub GetBranches { $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ? and categorycode = ?"); $nsth->execute($branch->{'branchcode'},$type); } else { + $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ? "); + $nsth->execute($branch->{'branchcode'}); } while (my ($cat) = $nsth->fetchrow_array) { diff --git a/C4/Search.pm b/C4/Search.pm index 7b59ba8f9a..910f105107 100755 --- a/C4/Search.pm +++ b/C4/Search.pm @@ -22,10 +22,7 @@ use C4::Context; use C4::Reserves2; use C4::Biblio; use Date::Calc; -use MARC::File::USMARC; -use MARC::Record; -use MARC::File::XML; - +use Encode; # FIXME - C4::Search uses C4::Reserves2, which uses C4::Search. # So Perl complains that all of the functions here get redefined. use C4::Date; @@ -84,7 +81,7 @@ See sub FindDuplicates for an example; sub ZEBRAsearch_kohafields{ my ($kohafield,$value, $relation,$sort, $and_or, $fordisplay,$reorder,$startfrom,$number_of_results,$searchfrom)=@_; -return (0,0) unless (@$value[0]); +return (0,undef) unless (@$value[0]); my $server="biblioserver"; my @results; my $attr; @@ -135,7 +132,7 @@ my ($sortattr)=MARCfind_attr_from_kohafield($sortpart[0]); $query="\@attr 2=102 ".$query; } } -#warn $query; +##warn $query; my $oResult; my $tried=0; @@ -174,10 +171,11 @@ my $dbh=C4::Context->dbh; $ri=$startfrom if $startfrom; for ( $ri; $ri<$numresults ; $ri++){ my $xmlrecord=$oResult->record($ri)->raw(); - if (!$fordisplay){ + $xmlrecord=Encode::decode("utf8",$xmlrecord); + #if (!$fordisplay){ ### Turn into hash of xml $xmlrecord=XML_xml2hash($xmlrecord); - } + ##} $z++; push @results,$xmlrecord; last if ($number_of_results && $z>=$number_of_results); @@ -265,7 +263,7 @@ my ($search,$num,$offset) = @_; my $dbh=C4::Context->dbh; #Prepare search my $query; -my $condition="select SQL_CALC_FOUND_ROWS marc from biblio where "; +my $condition="select SQL_CALC_FOUND_ROWS marcxml from biblio where "; if ($search->{'isbn'} ne''){ $search->{'isbn'}=$search->{'isbn'}."%"; $query=$search->{'isbn'}; @@ -286,8 +284,8 @@ my $i=0; my @results; while (my $marc=$sth->fetchrow){ if (($i >= $startfrom) && ($i < $limit)) { - my $record=MARC::File::USMARC::decode($marc); - my $data=MARCmarc2koha($dbh,$record,"biblios"); + my $record=XML_xml2hash_onerecord($marc); + my $data=XMLmarc2koha_onerecord($dbh,$record,"biblios"); push @results,$data; } $i++; @@ -299,9 +297,9 @@ return ($count,@results); sub FindDuplicate { - my ($record)=@_; + my ($xml)=@_; my $dbh=C4::Context->dbh; - my $result = MARCmarc2koha($dbh,$record,"biblios"); + my ($result) = XMLmarc2koha_onerecord($dbh,$xml,"biblios"); my @kohafield; my @value; my @relation; @@ -485,7 +483,7 @@ The returned items include very overdue items, but not lost ones. sub barcodes{ #called from request.pl my ($biblionumber)=@_; -warn $biblionumber; +#warn $biblionumber; my $dbh = C4::Context->dbh; my @kohafields; my @values; @@ -504,12 +502,52 @@ push @fields,"barcode","itemlost","itemnumber","date_due","wthdrawn","notforloa return(@items); } +sub XML_repeated_read{ +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 +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 +return @value; +}## if tag is mapped +return ""; +} sub getMARCnotes { +##Requires a MARCXML as $record my ($dbh, $record, $marcflavour) = @_; + my ($mintag, $maxtag); if ($marcflavour eq "MARC21") { $mintag = "500"; @@ -518,31 +556,10 @@ sub getMARCnotes { $mintag = "300"; $maxtag = "399"; } - - - - my @marcnotes; - my $note = ""; - my $tag = ""; - my $marcnote; - - foreach my $field ($record->field('5..')) { - my $value = $field->as_string(); - if ( $note ne "") { - - $marcnote = {marcnote => $note,}; - push @marcnotes, $marcnote; - $note=$value; - } - if ($note ne $value) { - $note = $note." ".$value; - } - } - - if ($note) { - $marcnote = {MARCNOTE => $note}; - push @marcnotes, $marcnote; #load last tag into array + foreach my $field ($mintag..$maxtag) { + my @value=XML_repeated_read($record,"","",$field,""); + push @marcnotes, \@value; } @@ -568,11 +585,12 @@ sub getMARCsubjects { my $subfield = ""; my $marcsubjct; - foreach my $field ($record->field('6..')) { - my $value = $field->subfield('a'); - $marcsubjct = {MARCSUBJCT => $value,}; + foreach my $field ($mintag..$maxtag) { + my @value =XML_repeated_read($record,"","",$field,"a"); + foreach my $subject (@value){ + $marcsubjct = {MARCSUBJCT => $subject,}; push @marcsubjcts, $marcsubjct; - $subjct = $value; + } } my $marcsubjctsarray=\@marcsubjcts; @@ -596,14 +614,16 @@ sub getMARCurls { my $url = ""; my $subfil = ""; my $marcurl; - foreach my $field ($record->field('856')) { - my $value = $field->subfield('u'); -# my $subfil = $data->[1]; - if ( $value ne $url) { - $marcurl = {MARCURL => $value,}; - push @marcurls, $marcurl; - $url = $value; - } + my $value; + foreach my $field ($mintag..$maxtag) { + my @value =XML_repeated_read($record,"","",$field,"a"); + foreach my $url (@value){ + if ( $value ne $url) { + $marcurl = {MARCURL => $url,}; + push @marcurls, $marcurl; + $value=$url; + } + } } @@ -644,8 +664,8 @@ my $shelfstatus = $dbh->prepare("select authorised_value from holdings_subfield_ } } my $even=1; -foreach my $xmlrecord(@marcrecords){ -my $xml=XML_xml2hash($xmlrecord); +foreach my $xml(@marcrecords){ +#my $xml=XML_xml2hash($xmlrecord); my @kohafields; ## just name those necessary for the result page push @kohafields, "biblionumber","title","author","publishercode","classification","itemtype","copyrightdate", "holdingbranch","date_due","location","shelf","itemcallnumber","notforloan","itemlost","wthdrawn"; my ($oldbiblio,@itemrecords) = XMLmarc2koha($dbh,$xml,"",@kohafields); @@ -739,17 +759,15 @@ my $norequests = 1; sub getcoverPhoto { ## return the address of a cover image if defined otherwise the amazon cover images - my $record =shift @_; + my $record =shift ; -my($phototag,$photosubtag)=MARCfind_marc_from_kohafield("coverphoto","biblios"); -if ($phototag){ - my $imagetag=$record->field($phototag); - my $image=$imagetag->subfield($photosubtag) if $imagetag; -return $image if $image; -} + my $image=XML_readline_onerecord($record,"coverphoto","biblios"); + if ($image){ + return $image; + } # if there is no image put the amazon cover image adress -my($isbntag,$isbnsubtag)=MARCfind_marc_from_kohafield("isbn","biblios"); -my $isbn=$record->field($isbntag)->subfield($isbnsubtag) if $record->field($isbntag); + +my $isbn=XML_readline_onerecord($record,"isbn","biblios"); return "http://images.amazon.com/images/P/".$isbn.".01.MZZZZZZZ.jpg"; } diff --git a/C4/Serials.pm b/C4/Serials.pm index 7d6852a5ec..292f447033 100644 --- a/C4/Serials.pm +++ b/C4/Serials.pm @@ -1041,8 +1041,9 @@ sub NewSubscription { $sth = $dbh->prepare($query); $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes); ## User may have subscriptionid stored in MARC so check and fill it -my $record=MARCgetbiblio($dbh,$biblionumber); -MARCkoha2marcOnefield( $record, "subscriptionid", $subscriptionid,"biblios" ); +my $record=XMLgetbiblio($dbh,$biblionumber); +$record=XML_xml2hash_onerecord($record); +XML_writeline( $record, "subscriptionid", $subscriptionid,"biblios" ); my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber); NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode); # reread subscription to get a hash (for calculation of the 1st issue number) @@ -1084,9 +1085,9 @@ sub ReNewSubscription { my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_; my $dbh = C4::Context->dbh; my $subscription = GetSubscription($subscriptionid); - my $record=MARCgetbiblio($dbh,$subscription->{biblionumber}); - - my $biblio = MARCmarc2koha($dbh,$record,"biblios"); + my $record=XMLgetbiblio($dbh,$subscription->{biblionumber}); + $record=XML_xml2hash_onerecord($record); + my $biblio = XMLmarc2koha_onerecord($dbh,$record,"biblios"); NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber}); # renew subscription my $query = qq| @@ -1295,8 +1296,9 @@ sub DelSubscription { my ($subscriptionid,$biblionumber) = @_; my $dbh = C4::Context->dbh; ## User may have subscriptionid stored in MARC so check and remove it -my $record=MARCgetbiblio($dbh,$biblionumber); -MARCkoha2marcOnefield( $record, "subscriptionid", "","biblios" ); +my $record=XMLgetbiblio($dbh,$biblionumber); +$record=XML_xml2hash_onerecord($record); +XML_writeline( $record, "subscriptionid", "","biblios" ); my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber); NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode); $subscriptionid=$dbh->quote($subscriptionid); -- 2.20.1