[Koha-cvs] CVS: koha/C4 Biblio.pm,1.7,1.8

[Paul POULAIN]

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)address@hidden;
      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)address@hidden;
!     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)address@hidden;
      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 )address@hidden;
- 
      $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)address@hidden;
+     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 )address@hidden;
      $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) 
address@hidden;
      $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) 
address@hidden;
      $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;