From de7dfb22fc0a9f2f9e975b243c7664661592cfcc Mon Sep 17 00:00:00 2001 From: tipaul Date: Tue, 10 Sep 2002 13:53:52 +0000 Subject: [PATCH] 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. --- C4/Biblio.pm | 207 ++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 154 insertions(+), 53 deletions(-) diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 8f5bc5d8dc..e3f40d8d61 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -1,6 +1,13 @@ package C4::Biblio; # $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 # @@ -105,11 +112,12 @@ $VERSION = 0.01; &ALLnewbiblio &ALLnewitem &MARCgettagslib - &MARCaddbiblio &MARCmodsubfield &MARCaddsubfield - &MARCmodbiblio + &MARCaddbiblio &MARCadditem + &MARCmodsubfield &MARCaddsubfield + &MARCmodbiblio &MARCmoditem &MARCfindsubfield - &MARCkoha2marcBiblio &MARCmarc2koha - &MARCgetbiblio + &MARCkoha2marcBiblio &MARCmarc2koha &MARCkoha2marcItem + &MARCgetbiblio &MARCgetitem &MARCaddword &MARCdelword ); %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], @@ -284,45 +292,65 @@ sub MARCaddbiblio { my @fields=$record->fields(); my $bibid; # adding main table, and retrieving bibid - $dbh->do("lock tables marc_biblio WRITE"); + $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); $sth=$dbh->prepare("select max(bibid) from marc_biblio"); $sth->execute; ($bibid)=$sth->fetchrow; $sth->finish; - $dbh->do("unlock tables"); my $fieldcount=0; # now, add subfields... foreach my $field (@fields) { my @subfields=$field->subfields(); $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(), $field->indicator(1).$field->indicator(2), $fieldcount, $subfields[$subfieldcount][0], - $subfieldcount, + $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; } 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; - + my ($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue) = @_; # if not value, end of job, we do nothing if (not($subfieldvalue)) { return; @@ -330,18 +358,8 @@ sub MARCaddsubfield { if (not($subfieldcode)) { $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"); +# $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); $sth=$dbh->prepare("select max(blobidlink)from marc_blob_subfield"); @@ -356,7 +374,7 @@ sub MARCaddsubfield { if ($sth->errstr) { 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"); +# $dbh->do("unlock tables"); } else { my $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?)"); $sth->execute($bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue); @@ -408,31 +426,73 @@ sub MARCgetbiblio { } } -# print "----------------------\n".$record->as_formatted()."\n-----------------"; + 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 { -# NOT SURE THIS SUB WORKS WELL... - my ($dbh,$bibid,$delete,$record)=@_; + my ($dbh,$record,$bibid,$itemnumber,$delete)=@_; my $oldrecord=&MARCgetbiblio($dbh,$bibid); # if nothing to change, don't waste time... if ($oldrecord eq $record) { -# print "nothing to do \n"; return; } # otherwise, skip through each subfield... my @fields = $record->fields(); my $tagorder=0; foreach my $field (@fields) { -#print "tag : ".$field->tag()."\n"; my $oldfield = $oldrecord->field($field->tag()); my @subfields=$field->subfields(); my $subfieldorder=0; $tagorder++; foreach my $subfield (@subfields) { $subfieldorder++; - if ($oldfield eq 0) { + if ($oldfield eq 0 or (! $oldfield->subfield(@$subfield[0])) ) { # just adding datas... &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2), 1,@$subfield[0],$subfieldorder,@$subfield[1]); @@ -442,17 +502,50 @@ sub MARCmodbiblio { my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder); &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]); } else { -# print "nothing to change\n"; + } + } + } + } +} +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=?"); $sth1->execute($subfieldid); @@ -532,7 +625,6 @@ sub MARCfindsubfieldid { sub MARCdelsubfield { # 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' and subfieldcode='$subfield' and subfieldorder='$subfieldorder @@ -542,7 +634,6 @@ sub MARCdelsubfield { sub MARCdelbiblio { # 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'"); } @@ -550,7 +641,6 @@ sub MARCdelbiblio { sub MARCkoha2marcBiblio { # 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(); #--- if bibid, then retrieve old-style koha data @@ -595,13 +685,14 @@ sub MARCkoha2marcItem { my $record = MARC::Record->new(); #--- 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, datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,bulk,issues,renewals, reserves,restricted,binding,itemnotes,holdingbranch,interim,timestamp FROM items - WHERE biblionumber=? and itemnumber=?"); - $sth2->execute($biblionumber,$itemnumber); + WHERE itemnumber=?"); + $sth2->execute($itemnumber); my $row=$sth2->fetchrow_hashref; my $code; foreach $code (keys %$row) { @@ -617,7 +708,6 @@ sub MARCkoha2marcItem { sub MARCkoha2marcSubtitle { # 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(); &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.subtitle",$subtitle); @@ -669,10 +759,6 @@ sub MARCmarc2koha { } # 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; } @@ -701,15 +787,24 @@ sub MARCaddword { # removes stopwords my ($dbh,$bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_; $sentence =~ s/(\.|\?|\:|\!|\'|,|\-)/ /g; -# TODO : remove stopwords 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 - if (length($word)>1) { +# 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); -# print "($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word)\n"; + 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"; + } } } } @@ -1275,7 +1370,7 @@ sub OLDnewitems { $error .= $sth->errstr; } $sth->finish; - $itemnumber++; +# $itemnumber++; # $dbh->disconnect; return($itemnumber,$error); } @@ -1498,6 +1593,8 @@ sub modbibitem { my ($biblioitem) = @_; my $dbh = C4Connect; &OLDmodbibitem($dbh,$biblioitem); + my $MARCbibitem = MARCkoha2marcBiblio($dbh,$biblioitem); + &MARCmodbiblio($dbh,$biblioitem->{biblionumber},0,$MARCbibitem); $dbh->disconnect; } # sub modbibitem @@ -1533,7 +1630,6 @@ sub newsubtitle { $dbh->disconnect; } - sub newitems { my ($item, @barcodes) = @_; my $dbh = C4Connect; @@ -1543,6 +1639,11 @@ sub newitems { foreach my $barcode (@barcodes) { ($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; return($errors); -- 2.39.5