[Koha-cvs] koha/C4 Accounts2.pm Biblio.pm Context.pm Koha....
Tumer Garip
tgarip at neu.edu.tr
Fri Sep 1 17:33:47 CEST 2006
CVSROOT: /sources/koha
Module name: koha
Changes by: Tumer Garip <tgarip1957> 06/09/01 15:33:47
Modified files:
C4 : Accounts2.pm Biblio.pm Context.pm Koha.pm
Search.pm Serials.pm
Log message:
No more MARC Records - everything is MARC XML
we read - write only XML
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Accounts2.pm?cvsroot=koha&r1=1.31&r2=1.32
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Biblio.pm?cvsroot=koha&r1=1.179&r2=1.180
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Context.pm?cvsroot=koha&r1=1.44&r2=1.45
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Koha.pm?cvsroot=koha&r1=1.41&r2=1.42
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Search.pm?cvsroot=koha&r1=1.121&r2=1.122
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Serials.pm?cvsroot=koha&r1=1.6&r2=1.7
Patches:
Index: Accounts2.pm
===================================================================
RCS file: /sources/koha/koha/C4/Accounts2.pm,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -b -r1.31 -r1.32
--- Accounts2.pm 25 Aug 2006 21:07:08 -0000 1.31
+++ Accounts2.pm 1 Sep 2006 15:33:46 -0000 1.32
@@ -381,7 +381,7 @@
my $dbh = C4::Context->dbh;
my $insert;
$itemnum=~ s/ //g;
- my %env;
+
my $accountno=getnextacctno('',$bornum,$dbh);
# my $amountleft=$amount;
my $amountleft;
@@ -389,19 +389,19 @@
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'){
+ if ($type eq 'CM'){
$desc.="Other fees credited by:".$user;
}
-if ($type eq 'CR'){
+ if ($type eq 'CR'){
$desc.="Resrvation fee credited by:".$user;
}
-if ($type eq 'CA'){
+ if ($type eq 'CA'){
$desc.="Managenent fee credited by:".$user;
}
if ($type eq 'CL' && $desc eq ''){
@@ -409,19 +409,16 @@
}
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
(borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,offset)
VALUES (?, ?, now(), ?, ?, ?, ?,?)");
$sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft,$oldaccount);
-
}
return ("0");
} else {
@@ -429,20 +426,13 @@
}
}
# 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 @@
}
# 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 @@
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 @@
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 @@
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 @@
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);
Index: Biblio.pm
===================================================================
RCS file: /sources/koha/koha/C4/Biblio.pm,v
retrieving revision 1.179
retrieving revision 1.180
diff -u -b -r1.179 -r1.180
--- Biblio.pm 25 Aug 2006 21:07:08 -0000 1.179
+++ Biblio.pm 1 Sep 2006 15:33:46 -0000 1.180
@@ -24,7 +24,8 @@
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 @@
&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 @@
#################### 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 @@
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 @@
}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 @@
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 @@
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 @@
}
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
if (!$updated){
- push @$biblio,{datafield=>[{
+ if ($subf){
+ push @$biblio,
+ {
'ind1' => ' ',
'ind2' => ' ',
'subfield' => [
{
- 'content' => $newvalue,
+ 'content' =>$newvalue,
'code' => $subf
}
],
- 'tag' => $tag
- }]
- };
+ 'tag' =>$tag
+ } ;
+ }else{
+ push @$biblio,
+ {
+ 'ind1' => ' ',
+ 'ind2' => ' ',
+ 'tag' =>$tag
+ } ;
+ }
}## created now
}else{
foreach my $control(@$controlfield){
@@ -211,24 +267,52 @@
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, at 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 @@
$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 @@
$sth->execute($biblionumber);
while(my ($marcxml)=$sth->fetchrow_array){
+$marcxml=Encode::decode('utf8',$marcxml);
push @results,$marcxml;
}
return @results;
@@ -260,7 +354,7 @@
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, at fields) = @_;
my ($result, at items);
@@ -334,7 +428,63 @@
return ($result, at items);
}
+sub XMLmarc2koha_onerecord {
+# warn "XMLmarc2koha_onerecord";
+##Returns a koha hash from MARCXML hash
+
+ my ($dbh,$xml,$related_record, at 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 @@
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 @@
if (@$values[$i] ne "") {
# leader
if (@$tags[$i] eq "000") {
+ ##Force the leader to UTF8
+ substr(@$values[$i],9,1)="a";
$xml.="<leader>@$values[$i]</leader>\n";
$first=1;
# rest of the fixed fields
@@ -663,16 +799,17 @@
}
$xml.="</record>";
# warn $xml;
+ $xml=Encode::decode('utf8',$xml);
return $xml;
}
sub marc_record_header {
#### this one is for <record>
my $format = shift;
my $enc = shift || 'UTF-8';
+##
return( <<MARC_XML_HEADER );
<?xml version="1.0" encoding="$enc"?>
-<record
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+<record xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
xmlns="http://www.loc.gov/MARC21/slim">
MARC_XML_HEADER
@@ -689,64 +826,7 @@
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 @@
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 @@
}
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 @@
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...
+ my ( $dbh, $xmlhash, $biblionumber, $itemnumber ) = @_;
- $record->delete_field($old_field);
- $record->insert_fields_ordered($newfield);
+##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);
- }
+$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");
}
- # 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){
+##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 $sth=$dbh->prepare("SELECT biblionumber from items where itemnumber=?");
$sth->execute($itemnumber);
my $biblionumber=$sth->fetchrow;
@@ -1060,53 +1088,39 @@
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 @@
}
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 @@
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 @@
$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 @@
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 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 @@
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 @@
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;
}
Index: Context.pm
===================================================================
RCS file: /sources/koha/koha/C4/Context.pm,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -b -r1.44 -r1.45
--- Context.pm 25 Aug 2006 21:07:08 -0000 1.44
+++ Context.pm 1 Sep 2006 15:33:47 -0000 1.45
@@ -15,17 +15,17 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Context.pm,v 1.44 2006/08/25 21:07:08 tgarip1957 Exp $
+# $Id: Context.pm,v 1.45 2006/09/01 15:33:47 tgarip1957 Exp $
package C4::Context;
use strict;
-use C4::UTF8DBI;
+use DBI;
use C4::Boolean;
use XML::Simple;
use vars qw($VERSION $AUTOLOAD),
qw($context),
qw(@context_stack);
-$VERSION = do { my @v = '$Revision: 1.44 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.45 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -484,14 +484,11 @@
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 @@
=cut
# $Log: Context.pm,v $
-# 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.
Index: Koha.pm
===================================================================
RCS file: /sources/koha/koha/C4/Koha.pm,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -b -r1.41 -r1.42
--- Koha.pm 25 Aug 2006 21:07:08 -0000 1.41
+++ Koha.pm 1 Sep 2006 15:33:47 -0000 1.42
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Koha.pm,v 1.41 2006/08/25 21:07:08 tgarip1957 Exp $
+# $Id: Koha.pm,v 1.42 2006/09/01 15:33:47 tgarip1957 Exp $
use strict;
require Exporter;
@@ -25,7 +25,7 @@
use C4::Biblio;
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = do { my @v = '$Revision: 1.41 $' =~ /\d+/g; shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
+$VERSION = do { my @v = '$Revision: 1.42 $' =~ /\d+/g; shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -138,6 +138,8 @@
$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) {
Index: Search.pm
===================================================================
RCS file: /sources/koha/koha/C4/Search.pm,v
retrieving revision 1.121
retrieving revision 1.122
diff -u -b -r1.121 -r1.122
--- Search.pm 25 Aug 2006 21:07:08 -0000 1.121
+++ Search.pm 1 Sep 2006 15:33:47 -0000 1.122
@@ -22,10 +22,7 @@
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;
@@ -33,7 +30,7 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.121 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.122 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -84,7 +81,7 @@
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 @@
$query="\@attr 2=102 ".$query;
}
}
-#warn $query;
+##warn $query;
my $oResult;
my $tried=0;
@@ -174,10 +171,11 @@
$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 $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 @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 @@
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 @@
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 @@
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 @@
$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 @@
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,13 +614,15 @@
my $url = "";
my $subfil = "";
my $marcurl;
- foreach my $field ($record->field('856')) {
- my $value = $field->subfield('u');
-# my $subfil = $data->[1];
+ 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 => $value,};
+ $marcurl = {MARCURL => $url,};
push @marcurls, $marcurl;
- $url = $value;
+ $value=$url;
+ }
}
}
@@ -644,8 +664,8 @@
}
}
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, at itemrecords) = XMLmarc2koha($dbh,$xml,"", at kohafields);
@@ -739,17 +759,15 @@
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";
}
Index: Serials.pm
===================================================================
RCS file: /sources/koha/koha/C4/Serials.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -b -r1.6 -r1.7
--- Serials.pm 25 Aug 2006 21:07:08 -0000 1.6
+++ Serials.pm 1 Sep 2006 15:33:47 -0000 1.7
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Serials.pm,v 1.6 2006/08/25 21:07:08 tgarip1957 Exp $
+# $Id: Serials.pm,v 1.7 2006/09/01 15:33:47 tgarip1957 Exp $
use strict;
use C4::Date;
@@ -31,7 +31,7 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.6 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.7 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
@@ -1041,8 +1041,9 @@
$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 @@
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 @@
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);
More information about the Koha-cvs
mailing list