[Koha-cvs] CVS: koha/C4 Biblio.pm,1.7,1.8
Paul POULAIN
tipaul at users.sourceforge.net
Tue Sep 10 15:53:55 CEST 2002
Update of /cvsroot/koha/koha/C4
In directory usw-pr-cvs1:/tmp/cvs-serv3933
Modified Files:
Biblio.pm
Log Message:
MARC API continued...
* some bugfixes
* multiple item management : MARCadditem and MARCmoditem have been added. They suppose that ALL the MARC field linked to koha-item are in the same MARC tag (on the same line of MARC file)
Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
Index: Biblio.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Biblio.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -r1.7 -r1.8
*** Biblio.pm 14 Aug 2002 18:12:51 -0000 1.7
--- Biblio.pm 10 Sep 2002 13:53:52 -0000 1.8
***************
*** 2,5 ****
--- 2,12 ----
# $Id$
# $Log$
+ # Revision 1.8 2002/09/10 13:53:52 tipaul
+ # MARC API continued...
+ # * some bugfixes
+ # * multiple item management : MARCadditem and MARCmoditem have been added. They suppose that ALL the MARC field linked to koha-item are in the same MARC tag (on the same line of MARC file)
+ #
+ # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
+ #
# Revision 1.7 2002/08/14 18:12:51 tonnesen
# Added copyright statement to all .pl and .pm files
***************
*** 106,114 ****
&MARCgettagslib
! &MARCaddbiblio &MARCmodsubfield &MARCaddsubfield
! &MARCmodbiblio
&MARCfindsubfield
! &MARCkoha2marcBiblio &MARCmarc2koha
! &MARCgetbiblio
&MARCaddword &MARCdelword
);
--- 113,122 ----
&MARCgettagslib
! &MARCaddbiblio &MARCadditem
! &MARCmodsubfield &MARCaddsubfield
! &MARCmodbiblio &MARCmoditem
&MARCfindsubfield
! &MARCkoha2marcBiblio &MARCmarc2koha &MARCkoha2marcItem
! &MARCgetbiblio &MARCgetitem
&MARCaddword &MARCdelword
);
***************
*** 285,289 ****
my $bibid;
# adding main table, and retrieving bibid
! $dbh->do("lock tables marc_biblio WRITE");
my $sth=$dbh->prepare("insert into marc_biblio (datecreated,biblionumber) values (now(),?)");
$sth->execute($biblionumber);
--- 293,297 ----
my $bibid;
# adding main table, and retrieving bibid
! $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
my $sth=$dbh->prepare("insert into marc_biblio (datecreated,biblionumber) values (now(),?)");
$sth->execute($biblionumber);
***************
*** 292,296 ****
($bibid)=$sth->fetchrow;
$sth->finish;
- $dbh->do("unlock tables");
my $fieldcount=0;
# now, add subfields...
--- 300,303 ----
***************
*** 299,303 ****
$fieldcount++;
foreach my $subfieldcount (0..$#subfields) {
- # print $field->tag().":".$field->indicator(1).$field->indicator(2).":".$subfields[$subfieldcount][0].":".$subfields[$subfieldcount][1]."\n";
&MARCaddsubfield($dbh,$bibid,
$field->tag(),
--- 306,309 ----
***************
*** 305,313 ****
$fieldcount,
$subfields[$subfieldcount][0],
! $subfieldcount,
$subfields[$subfieldcount][1]
);
}
}
return $bibid;
}
--- 311,349 ----
$fieldcount,
$subfields[$subfieldcount][0],
! $subfieldcount+1,
$subfields[$subfieldcount][1]
);
}
}
+ $dbh->do("unlock tables");
+ return $bibid;
+ }
+
+ sub MARCadditem {
+ # pass the MARC::Record to this function, and it will create the records in the marc tables
+ my ($dbh,$record,$biblionumber) = @_;
+ # search for MARC biblionumber
+ $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
+ my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
+ my @fields=$record->fields();
+ my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
+ $sth->execute($bibid);
+ my ($fieldcount) = $sth->fetchrow;
+ # now, add subfields...
+ foreach my $field (@fields) {
+ my @subfields=$field->subfields();
+ $fieldcount++;
+ foreach my $subfieldcount (0..$#subfields) {
+ &MARCaddsubfield($dbh,$bibid,
+ $field->tag(),
+ $field->indicator(1).$field->indicator(2),
+ $fieldcount,
+ $subfields[$subfieldcount][0],
+ $subfieldcount+1,
+ $subfields[$subfieldcount][1]
+ );
+ }
+ }
+ $dbh->do("unlock tables");
return $bibid;
}
***************
*** 315,327 ****
sub MARCaddsubfield {
# Add a new subfield to a tag into the DB.
! my $dbh=shift;
! my $bibid=shift;
! my $tagid=shift;
! my $indicator=shift;
! my $tagorder=shift;
! my $subfieldcode=shift;
! my $subfieldorder=shift;
! my $subfieldvalue=shift;
!
# if not value, end of job, we do nothing
if (not($subfieldvalue)) {
--- 351,355 ----
sub MARCaddsubfield {
# Add a new subfield to a tag into the DB.
! my ($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
# if not value, end of job, we do nothing
if (not($subfieldvalue)) {
***************
*** 331,346 ****
$subfieldcode=' ';
}
- unless ($subfieldorder) {
- my $sth=$dbh->prepare("select max(subfieldorder) from marc_subfield_table where tag=$tagid");
- $sth->execute;
- if ($sth->rows) {
- ($subfieldorder) = $sth->fetchrow;
- $subfieldorder++;
- } else {
- $subfieldorder=1;
- }
- }
if (length($subfieldvalue)>255) {
! $dbh->do("lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE");
my $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
$sth->execute($subfieldvalue);
--- 359,364 ----
$subfieldcode=' ';
}
if (length($subfieldvalue)>255) {
! # $dbh->do("lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE");
my $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
$sth->execute($subfieldvalue);
***************
*** 357,361 ****
print STDERR "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
}
! $dbh->do("unlock tables");
} else {
my $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?)");
--- 375,379 ----
print STDERR "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
}
! # $dbh->do("unlock tables");
} else {
my $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?)");
***************
*** 409,423 ****
}
! # print "----------------------\n".$record->as_formatted()."\n-----------------";
return $record;
}
sub MARCmodbiblio {
! # NOT SURE THIS SUB WORKS WELL...
! my ($dbh,$bibid,$delete,$record)=@_;
my $oldrecord=&MARCgetbiblio($dbh,$bibid);
# if nothing to change, don't waste time...
if ($oldrecord eq $record) {
- # print "nothing to do \n";
return;
}
--- 427,484 ----
}
! return $record;
! }
! sub MARCgetitem {
! # Returns MARC::Record of the biblio passed in parameter.
! my ($dbh,$bibid,$itemnumber)=@_;
! my $record = MARC::Record->new();
! # search MARC tagorder
! my $sth2 = $dbh->prepare("select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?");
! $sth2->execute($bibid,$itemnumber);
! my ($tagorder) = $sth2->fetchrow_array();
! #---- TODO : the leader is missing
! my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
! from marc_subfield_table
! where bibid=? and tagorder=? order by subfieldorder
! ");
! my $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
! $sth->execute($bibid,$tagorder);
! while (my $row=$sth->fetchrow_hashref) {
! if ($row->{'valuebloblink'}) { #---- search blob if there is one
! $sth2->execute($row->{'valuebloblink'});
! my $row2=$sth2->fetchrow_hashref;
! $sth2->finish;
! $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
! }
! if ($record->field($row->{'tag'})) {
! my $field;
! #--- this test must stay as this, because of strange behaviour of mySQL/Perl DBI with char var containing a number...
! #--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\
! if (length($row->{'tag'}) <3) {
! $row->{'tag'} = "0".$row->{'tag'};
! }
! $field =$record->field($row->{'tag'});
! if ($field) {
! my $x = $field->add_subfields($row->{'subfieldcode'},$row->{'subfieldvalue'});
! $record->delete_field($field);
! $record->add_fields($field);
! }
! } else {
! if (length($row->{'tag'}) < 3) {
! $row->{'tag'} = "0".$row->{'tag'};
! }
! my $temp = MARC::Field->new($row->{'tag'}," "," ", $row->{'subfieldcode'} => $row->{'subfieldvalue'});
! $record->add_fields($temp);
! }
!
! }
return $record;
}
sub MARCmodbiblio {
! my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
my $oldrecord=&MARCgetbiblio($dbh,$bibid);
# if nothing to change, don't waste time...
if ($oldrecord eq $record) {
return;
}
***************
*** 426,430 ****
my $tagorder=0;
foreach my $field (@fields) {
- #print "tag : ".$field->tag()."\n";
my $oldfield = $oldrecord->field($field->tag());
my @subfields=$field->subfields();
--- 487,490 ----
***************
*** 433,437 ****
foreach my $subfield (@subfields) {
$subfieldorder++;
! if ($oldfield eq 0) {
# just adding datas...
&MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
--- 493,497 ----
foreach my $subfield (@subfields) {
$subfieldorder++;
! if ($oldfield eq 0 or (! $oldfield->subfield(@$subfield[0])) ) {
# just adding datas...
&MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
***************
*** 443,447 ****
&MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
} else {
- # print "nothing to change\n";
}
}
--- 503,506 ----
***************
*** 449,457 ****
}
}
sub MARCmodsubfield {
# Subroutine changes a subfield value given a subfieldid.
my ($dbh, $subfieldid, $subfieldvalue )=@_;
-
$dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
my $sth1=$dbh->prepare("select valuebloblink from marc_subfield_table where subfieldid=?");
--- 508,550 ----
}
}
+ sub MARCmoditem {
+ my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
+ my $oldrecord=&MARCgetitem($dbh,$bibid,$itemnumber);
+ # if nothing to change, don't waste time...
+ if ($oldrecord eq $record) {
+ return;
+ }
+ # otherwise, skip through each subfield...
+ my @fields = $record->fields();
+ # search old MARC item
+ my $sth2 = $dbh->prepare("select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?");
+ $sth2->execute($bibid,$itemnumber);
+ my ($tagorder) = $sth2->fetchrow_array();
+ foreach my $field (@fields) {
+ my $oldfield = $oldrecord->field($field->tag());
+ my @subfields=$field->subfields();
+ my $subfieldorder=0;
+ foreach my $subfield (@subfields) {
+ $subfieldorder++;
+ if ($oldfield eq 0 or (! $oldfield->subfield(@$subfield[0])) ) {
+ # just adding datas...
+ &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
+ $tagorder,@$subfield[0],$subfieldorder,@$subfield[1]);
+ } else {
+ # modify he subfield if it's a different string
+ if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
+ my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
+ &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
+ } else {
+ }
+ }
+ }
+ }
+ }
+
sub MARCmodsubfield {
# Subroutine changes a subfield value given a subfieldid.
my ($dbh, $subfieldid, $subfieldvalue )=@_;
$dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
my $sth1=$dbh->prepare("select valuebloblink from marc_subfield_table where subfieldid=?");
***************
*** 533,537 ****
# delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
- # my $dbh=&C4Connect;
$dbh->do("delete from marc_subfield_table where bibid='$bibid' and
tag='$tag' and tagorder='$tagorder'
--- 626,629 ----
***************
*** 543,547 ****
# delete a biblio for a $bibid
my ($dbh,$bibid) = @_;
- # my $dbh=&C4Connect;
$dbh->do("delete from marc_subfield_table where bibid='$bibid'");
$dbh->do("delete from marc_biblio where bibid='$bibid'");
--- 635,638 ----
***************
*** 551,555 ****
# this function builds partial MARC::Record from the old koha-DB fields
my ($dbh,$biblionumber,$biblioitemnumber) = @_;
- # my $dbh=&C4Connect;
my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
my $record = MARC::Record->new();
--- 642,645 ----
***************
*** 596,599 ****
--- 686,690 ----
#--- if item, then retrieve old-style koha data
if ($itemnumber>0) {
+ # print STDERR "prepare $biblionumber,$itemnumber\n";
my $sth2=$dbh->prepare("SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
***************
*** 601,606 ****
reserves,restricted,binding,itemnotes,holdingbranch,interim,timestamp
FROM items
! WHERE biblionumber=? and itemnumber=?");
! $sth2->execute($biblionumber,$itemnumber);
my $row=$sth2->fetchrow_hashref;
my $code;
--- 692,697 ----
reserves,restricted,binding,itemnotes,holdingbranch,interim,timestamp
FROM items
! WHERE itemnumber=?");
! $sth2->execute($itemnumber);
my $row=$sth2->fetchrow_hashref;
my $code;
***************
*** 618,622 ****
# this function builds partial MARC::Record from the old koha-DB fields
my ($dbh,$bibnum,$subtitle) = @_;
- # my $dbh=&C4Connect;
my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
my $record = MARC::Record->new();
--- 709,712 ----
***************
*** 670,677 ****
# additional authors : specific
$result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result);
- # print STDERR $result."XXXX\n";
- # foreach my $tmp (key $result) {
- # print STDERR $result->{$tmp}."\n";
- # }
return $result;
}
--- 760,763 ----
***************
*** 702,714 ****
my ($dbh,$bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_;
$sentence =~ s/(\.|\?|\:|\!|\'|,|\-)/ /g;
- # TODO : remove stopwords
my @words = split / /,$sentence;
my $sth=$dbh->prepare("insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word)
values (?,?,?,?,?,?,soundex(?))");
foreach my $word (@words) {
! # we record only words longer than 2 car
! if (length($word)>1) {
$sth->execute($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word);
! # print "($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word)\n";
}
}
--- 788,809 ----
my ($dbh,$bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_;
$sentence =~ s/(\.|\?|\:|\!|\'|,|\-)/ /g;
my @words = split / /,$sentence;
+ # build stopword list
+ my $sth2 =$dbh->prepare("select word from stopwords");
+ $sth2->execute;
+ my $stopwords;
+ my $stopword;
+ while(($stopword) = $sth2->fetchrow_array) {
+ $stopwords->{$stopword} = $stopword;
+ }
my $sth=$dbh->prepare("insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word)
values (?,?,?,?,?,?,soundex(?))");
foreach my $word (@words) {
! # we record only words longer than 2 car and not in stopwords hash
! if (length($word)>1 and !($stopwords->{uc($word)})) {
$sth->execute($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word);
! if ($sth->err()) {
! print STDERR "ERROR ==> insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word) values ($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,soundex($word))\n";
! }
}
}
***************
*** 1276,1280 ****
}
$sth->finish;
! $itemnumber++;
# $dbh->disconnect;
return($itemnumber,$error);
--- 1371,1375 ----
}
$sth->finish;
! # $itemnumber++;
# $dbh->disconnect;
return($itemnumber,$error);
***************
*** 1499,1502 ****
--- 1594,1599 ----
my $dbh = C4Connect;
&OLDmodbibitem($dbh,$biblioitem);
+ my $MARCbibitem = MARCkoha2marcBiblio($dbh,$biblioitem);
+ &MARCmodbiblio($dbh,$biblioitem->{biblionumber},0,$MARCbibitem);
$dbh->disconnect;
} # sub modbibitem
***************
*** 1534,1538 ****
}
-
sub newitems {
my ($item, @barcodes) = @_;
--- 1631,1634 ----
***************
*** 1544,1547 ****
--- 1640,1648 ----
($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
$errors .=$error;
+ # print STDERR "biblionumber : $item->{biblionumber} / MARCbibid : $MARCbibid / itemnumber : $itemnumber\n";
+ my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
+ # print STDERR "MARCitem ".$MARCitem->as_formatted()."\n";
+ &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
+ # print STDERR "MARCmodbiblio called\n";
}
$dbh->disconnect;
More information about the Koha-cvs
mailing list