[Koha-cvs] CVS: koha/C4 Biblio.pm,1.78.2.3,1.78.2.4

[Paul POULAIN]

Update of /cvsroot/koha/koha/C4
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28563/C4

Modified Files:
      Tag: rel_2_0
        Biblio.pm 
Log Message:
deleting duplicated subs (by buggy copy/paste probably)

Index: Biblio.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Biblio.pm,v
retrieving revision 1.78.2.3
retrieving revision 1.78.2.4
diff -C2 -r1.78.2.3 -r1.78.2.4
*** Biblio.pm   10 Feb 2004 13:15:46 -0000      1.78.2.3
--- Biblio.pm   12 Feb 2004 13:41:56 -0000      1.78.2.4
***************
*** 2192,2195 ****
--- 2192,2198 ----
  # $Id$
  # $Log$
+ # Revision 1.78.2.4  2004/02/12 13:41:56  tipaul
+ # deleting duplicated subs (by buggy copy/paste probably)
+ #
  # Revision 1.78.2.3  2004/02/10 13:15:46  tipaul
  # removing 2 warnings
***************
*** 2541,3147 ****
  # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
  #
- 
- sub itemcount{
-   my ($biblio)address@hidden;
-   my $dbh = C4::Context->dbh;
-   my $query="Select count(*) from items where biblionumber=$biblio";
- #  print $query;
-   my $sth=$dbh->prepare($query);
-   $sth->execute;
-   my $data=$sth->fetchrow_hashref;
-   $sth->finish;
-   return($data->{'count(*)'});
- }
- 
- =item getorder
- 
-   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
- 
- Looks up the order with the given biblionumber and biblioitemnumber.
- 
- Returns a two-element array. C<$ordernumber> is the order number.
- C<$order> is a reference-to-hash describing the order; its keys are
- fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
- tables of the Koha database.
- 
- =cut
- #'
- # FIXME - This is effectively identical to &C4::Catalogue::getorder.
- # Pick one and stick with it.
- sub getorder{
-   my ($bi,$bib)address@hidden;
-   my $dbh = C4::Context->dbh;
-   my $query="Select ordernumber
-       from aqorders
-       where biblionumber=? and biblioitemnumber=?";
-   my $sth=$dbh->prepare($query);
-   $sth->execute($bib,$bi);
-   # FIXME - Use fetchrow_array(), since we're only interested in the one
-   # value.
-   my $ordnum=$sth->fetchrow_hashref;
-   $sth->finish;
-   my $order=getsingleorder($ordnum->{'ordernumber'});
- #  print $query;
-   return ($order,$ordnum->{'ordernumber'});
- }
- 
- =item getsingleorder
- 
-   $order = &getsingleorder($ordernumber);
- 
- Looks up an order by order number.
- 
- Returns a reference-to-hash describing the order. The keys of
- C<$order> are fields from the biblio, biblioitems, aqorders, and
- aqorderbreakdown tables of the Koha database.
- 
- =cut
- #'
- # FIXME - This is effectively identical to
- # &C4::Catalogue::getsingleorder.
- # Pick one and stick with it.
- sub getsingleorder {
-   my ($ordnum)address@hidden;
-   my $dbh = C4::Context->dbh;
-   my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
-   where aqorders.ordernumber=?
-   and biblio.biblionumber=aqorders.biblionumber and
-   biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
-   aqorders.ordernumber=aqorderbreakdown.ordernumber";
-   my $sth=$dbh->prepare($query);
-   $sth->execute($ordnum);
-   my $data=$sth->fetchrow_hashref;
-   $sth->finish;
-   return($data);
- }
- 
- sub newbiblio {
-       my ($biblio) = @_;
-       my $dbh    = C4::Context->dbh;
-       my $bibnum=OLDnewbiblio($dbh,$biblio);
-       # finds new (MARC bibid
- #     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
-       my $record = &MARCkoha2marcBiblio($dbh,$bibnum);
-       MARCaddbiblio($dbh,$record,$bibnum);
-       return($bibnum);
- }
- 
- =item modbiblio
- 
-   $biblionumber = &modbiblio($biblio);
- 
- Update a biblio record.
- 
- C<$biblio> is a reference-to-hash whose keys are the fields in the
- biblio table in the Koha database. All fields must be present, not
- just the ones you wish to change.
- 
- C<&modbiblio> updates the record defined by
- C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
- 
- C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
- successful or not.
- 
- =cut
- 
- sub modbiblio {
-       my ($biblio) = @_;
-       my $dbh  = C4::Context->dbh;
-       my $biblionumber=OLDmodbiblio($dbh,$biblio);
-       my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
-       # finds new (MARC bibid
-       my $bibid = 
&MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
-       MARCmodbiblio($dbh,$bibid,$record,0);
-       return($biblionumber);
- } # sub modbiblio
- 
- =item modsubtitle
- 
-   &modsubtitle($biblionumber, $subtitle);
- 
- Sets the subtitle of a book.
- 
- C<$biblionumber> is the biblionumber of the book to modify.
- 
- C<$subtitle> is the new subtitle.
- 
- =cut
- 
- sub modsubtitle {
-   my ($bibnum, $subtitle) = @_;
-   my $dbh   = C4::Context->dbh;
-   &OLDmodsubtitle($dbh,$bibnum,$subtitle);
- } # sub modsubtitle
- 
- =item modaddauthor
- 
-   &modaddauthor($biblionumber, $author);
- 
- Replaces all additional authors for the book with biblio number
- C<$biblionumber> with C<$author>. If C<$author> is the empty string,
- C<&modaddauthor> deletes all additional authors.
- 
- =cut
- 
- sub modaddauthor {
-     my ($bibnum, $author) = @_;
-     my $dbh   = C4::Context->dbh;
-     &OLDmodaddauthor($dbh,$bibnum,$author);
- } # sub modaddauthor
- 
- =item modsubject
- 
-   $error = &modsubject($biblionumber, $force, @subjects);
- 
- $force - a subject to force
- 
- $error - Error message, or undef if successful.
- 
- =cut
- 
- sub modsubject {
-   my ($bibnum, $force, @subject) = @_;
-   my $dbh   = C4::Context->dbh;
-   my $error= &OLDmodsubject($dbh,$bibnum,$force, @subject);
-   return($error);
- } # sub modsubject
- 
- sub modbibitem {
-     my ($biblioitem) = @_;
-     my $dbh   = C4::Context->dbh;
-     &OLDmodbibitem($dbh,$biblioitem);
- } # sub modbibitem
- 
- sub modnote {
-   my ($bibitemnum,$note)address@hidden;
-   my $dbh = C4::Context->dbh;
-   &OLDmodnote($dbh,$bibitemnum,$note);
- }
- 
- sub newbiblioitem {
-       my ($biblioitem) = @_;
-       my $dbh   = C4::Context->dbh;
-       my $bibitemnum = &OLDnewbiblioitem($dbh,$biblioitem);
-       my $MARCbiblio= MARCkoha2marcBiblio($dbh,0,$bibitemnum); # the 0 means 
"do NOT retrieve biblio, only biblioitem, in the MARC record
-       my $bibid = 
&MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblioitem->{biblionumber});
-       &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber},$bibid);
-       return($bibitemnum);
- }
- 
- sub newsubject {
-   my ($bibnum)address@hidden;
-   my $dbh = C4::Context->dbh;
-   &OLDnewsubject($dbh,$bibnum);
- }
- 
- sub newsubtitle {
-     my ($bibnum, $subtitle) = @_;
-     my $dbh   = C4::Context->dbh;
-     &OLDnewsubtitle($dbh,$bibnum,$subtitle);
- }
- 
- sub newitems {
-   my ($item, @barcodes) = @_;
-   my $dbh   = C4::Context->dbh;
-   my $errors;
-   my $itemnumber;
-   my $error;
-   foreach my $barcode (@barcodes) {
-       ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
-       $errors .=$error;
-       my $MARCitem = 
&MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
-       &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
-   }
-   return($errors);
- }
- 
- sub moditem {
-     my ($item) = @_;
-     my $dbh = C4::Context->dbh;
-     &OLDmoditem($dbh,$item);
-     my $MARCitem = 
&MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'});
-     my $bibid = 
&MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber});
-     &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0);
- }
- 
- sub checkitems{
-   my ($count,@barcodes)address@hidden;
-   my $dbh = C4::Context->dbh;
-   my $error;
-   for (my $i=0;$i<$count;$i++){
-     $barcodes[$i]=uc $barcodes[$i];
-     my $query="Select * from items where barcode='$barcodes[$i]'";
-     my $sth=$dbh->prepare($query);
-     $sth->execute;
-     if (my $data=$sth->fetchrow_hashref){
-       $error.=" Duplicate Barcode: $barcodes[$i]";
-     }
-     $sth->finish;
-   }
-   return($error);
- }
- 
- sub countitems{
-   my ($bibitemnum)address@hidden;
-   my $dbh = C4::Context->dbh;
-   my $query="Select count(*) from items where biblioitemnumber='$bibitemnum'";
-   my $sth=$dbh->prepare($query);
-   $sth->execute;
-   my $data=$sth->fetchrow_hashref;
-   $sth->finish;
-   return($data->{'count(*)'});
- }
- 
- sub delitem{
-   my ($itemnum)address@hidden;
-   my $dbh = C4::Context->dbh;
-   &OLDdelitem($dbh,$itemnum);
- }
- 
- sub deletebiblioitem {
-     my ($biblioitemnumber) = @_;
-     my $dbh   = C4::Context->dbh;
-     &OLDdeletebiblioitem($dbh,$biblioitemnumber);
- } # sub deletebiblioitem
- 
- 
- sub delbiblio {
-       my ($biblio)address@hidden;
-       my $dbh = C4::Context->dbh;
-       &OLDdelbiblio($dbh,$biblio);
-       my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblio);
-       &MARCdelbiblio($dbh,$bibid,0);
- }
- 
- sub getitemtypes {
-   my $dbh   = C4::Context->dbh;
-   my $query = "select * from itemtypes order by description";
-   my $sth   = $dbh->prepare($query);
-     # || die "Cannot prepare $query" . $dbh->errstr;
-   my $count = 0;
-   my @results;
- 
-   $sth->execute;
-     # || die "Cannot execute $query\n" . $sth->errstr;
-   while (my $data = $sth->fetchrow_hashref) {
-     $results[$count] = $data;
-     $count++;
-   } # while
- 
-   $sth->finish;
-   return($count, @results);
- } # sub getitemtypes
- 
- sub getbiblio {
-     my ($biblionumber) = @_;
-     my $dbh   = C4::Context->dbh;
-     my $query = "Select * from biblio where biblionumber = $biblionumber";
-     my $sth   = $dbh->prepare($query);
-       # || die "Cannot prepare $query\n" . $dbh->errstr;
-     my $count = 0;
-     my @results;
- 
-     $sth->execute;
-       # || die "Cannot execute $query\n" . $sth->errstr;
-     while (my $data = $sth->fetchrow_hashref) {
-       $results[$count] = $data;
-       $count++;
-     } # while
- 
-     $sth->finish;
-     return($count, @results);
- } # sub getbiblio
- 
- sub getbiblioitem {
-     my ($biblioitemnum) = @_;
-     my $dbh   = C4::Context->dbh;
-     my $query = "Select * from biblioitems where
- biblioitemnumber = $biblioitemnum";
-     my $sth   = $dbh->prepare($query);
-     my $count = 0;
-     my @results;
- 
-     $sth->execute;
- 
-     while (my $data = $sth->fetchrow_hashref) {
-         $results[$count] = $data;
-       $count++;
-     } # while
- 
-     $sth->finish;
-     return($count, @results);
- } # sub getbiblioitem
- 
- sub getbiblioitembybiblionumber {
-     my ($biblionumber) = @_;
-     my $dbh   = C4::Context->dbh;
-     my $query = "Select * from biblioitems where biblionumber =
- $biblionumber";
-     my $sth   = $dbh->prepare($query);
-     my $count = 0;
-     my @results;
- 
-     $sth->execute;
- 
-     while (my $data = $sth->fetchrow_hashref) {
-         $results[$count] = $data;
-       $count++;
-     } # while
- 
-     $sth->finish;
-     return($count, @results);
- } # sub
- 
- sub getitemsbybiblioitem {
-     my ($biblioitemnum) = @_;
-     my $dbh   = C4::Context->dbh;
-     my $query = "Select * from items, biblio where
- biblio.biblionumber = items.biblionumber and biblioitemnumber
- = $biblioitemnum";
-     my $sth   = $dbh->prepare($query);
-       # || die "Cannot prepare $query\n" . $dbh->errstr;
-     my $count = 0;
-     my @results;
- 
-     $sth->execute;
-       # || die "Cannot execute $query\n" . $sth->errstr;
-     while (my $data = $sth->fetchrow_hashref) {
-       $results[$count] = $data;
-       $count++;
-     } # while
- 
-     $sth->finish;
-     return($count, @results);
- } # sub getitemsbybiblioitem
- 
- 
- sub logchange {
- # Subroutine to log changes to databases
- # Eventually, this subroutine will be used to create a log of all changes 
made,
- # with the possibility of "undo"ing some changes
-     my $database=shift;
-     if ($database eq 'kohadb') {
-       my $type=shift;
-       my $section=shift;
-       my $item=shift;
-       my $original=shift;
-       my $new=shift;
- #     print STDERR "KOHA: $type $section $item $original $new\n";
-     } elsif ($database eq 'marc') {
-       my $type=shift;
-       my $Record_ID=shift;
-       my $tag=shift;
-       my $mark=shift;
-       my $subfield_ID=shift;
-       my $original=shift;
-       my $new=shift;
- #     print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original 
$new\n";
-     }
- }
- 
- #------------------------------------------------
- 
- 
- #---------------------------------------
- # Find a biblio entry, or create a new one if it doesn't exist.
- #  If a "subtitle" entry is in hash, add it to subtitle table
- sub getoraddbiblio {
-       # input params
-       my (
-         $dbh,         # db handle
-                       # FIXME - Unused argument
-         $biblio,      # hash ref to fields
-       )address@hidden;
- 
-       # return
-       my $biblionumber;
- 
-       my $debug=0;
-       my $sth;
-       my $error;
- 
-       #-----
-       $dbh = C4::Context->dbh;
- 
-       print "<PRE>Looking for biblio </PRE>\n" if $debug;
-       $sth=$dbh->prepare("select biblionumber
-               from biblio
-               where title=? and author=?
-                 and copyrightdate=? and seriestitle=?");
-       $sth->execute(
-               $biblio->{title}, $biblio->{author},
-               $biblio->{copyright}, $biblio->{seriestitle} );
-       if ($sth->rows) {
-           ($biblionumber) = $sth->fetchrow;
-           print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if 
$debug;
-       } else {
-           # Doesn't exist.  Add new one.
-           print "<PRE>Adding biblio</PRE>\n" if $debug;
-           ($biblionumber,$error)=&newbiblio($biblio);
-           if ( $biblionumber ) {
-             print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if 
$debug;
-             if ( $biblio->{subtitle} ) {
-               &newsubtitle($biblionumber,$biblio->{subtitle} );
-             } # if subtitle
-           } else {
-               print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
-           } # if added
-       }
- 
-       return $biblionumber,$error;
- 
- } # sub getoraddbiblio
- 
- sub char_decode {
-       # converts ISO 5426 coded string to ISO 8859-1
-       # sloppy code : should be improved in next issue
-       my ($string,$encoding) = @_ ;
-       $_ = $string ;
- #     $encoding = C4::Context->preference("marcflavour") unless $encoding;
-       if ($encoding eq "UNIMARC") {
-               s/\xe1/Æ/gm ;
-               s/\xe2/Ð/gm ;
-               s/\xe9/Ø/gm ;
-               s/\xec/þ/gm ;
-               s/\xf1/æ/gm ;
-               s/\xf3/ð/gm ;
-               s/\xf9/ø/gm ;
-               s/\xfb/ß/gm ;
-               s/\xc1\x61/à/gm ;
-               s/\xc1\x65/è/gm ;
-               s/\xc1\x69/ì/gm ;
-               s/\xc1\x6f/ò/gm ;
-               s/\xc1\x75/ù/gm ;
-               s/\xc1\x41/À/gm ;
-               s/\xc1\x45/È/gm ;
-               s/\xc1\x49/Ì/gm ;
-               s/\xc1\x4f/Ò/gm ;
-               s/\xc1\x55/Ù/gm ;
-               s/\xc2\x41/Á/gm ;
-               s/\xc2\x45/É/gm ;
-               s/\xc2\x49/Í/gm ;
-               s/\xc2\x4f/Ó/gm ;
-               s/\xc2\x55/Ú/gm ;
-               s/\xc2\x59/Ý/gm ;
-               s/\xc2\x61/á/gm ;
-               s/\xc2\x65/é/gm ;
-               s/\xc2\x69/í/gm ;
-               s/\xc2\x6f/ó/gm ;
-               s/\xc2\x75/ú/gm ;
-               s/\xc2\x79/ý/gm ;
-               s/\xc3\x41/Â/gm ;
-               s/\xc3\x45/Ê/gm ;
-               s/\xc3\x49/Î/gm ;
-               s/\xc3\x4f/Ô/gm ;
-               s/\xc3\x55/Û/gm ;
-               s/\xc3\x61/â/gm ;
-               s/\xc3\x65/ê/gm ;
-               s/\xc3\x69/î/gm ;
-               s/\xc3\x6f/ô/gm ;
-               s/\xc3\x75/û/gm ;
-               s/\xc4\x41/Ã/gm ;
-               s/\xc4\x4e/Ñ/gm ;
-               s/\xc4\x4f/Õ/gm ;
-               s/\xc4\x61/ã/gm ;
-               s/\xc4\x6e/ñ/gm ;
-               s/\xc4\x6f/õ/gm ;
-               s/\xc8\x45/Ë/gm ;
-               s/\xc8\x49/Ï/gm ;
-               s/\xc8\x65/ë/gm ;
-               s/\xc8\x69/ï/gm ;
-               s/\xc8\x76/ÿ/gm ;
-               s/\xc9\x41/Ä/gm ;
-               s/\xc9\x4f/Ö/gm ;
-               s/\xc9\x55/Ü/gm ;
-               s/\xc9\x61/ä/gm ;
-               s/\xc9\x6f/ö/gm ;
-               s/\xc9\x75/ü/gm ;
-               s/\xca\x41/Å/gm ;
-               s/\xca\x61/å/gm ;
-               s/\xd0\x43/Ç/gm ;
-               s/\xd0\x63/ç/gm ;
-               # this handles non-sorting blocks (if implementation requires 
this)
-               $string = nsb_clean($_) ;
-       } elsif ($encoding eq "USMARC" || $encoding eq "MARC21") {
-               if(/[\xc1-\xff]/) {
-                       s/\xe1\x61/à/gm ;
-                       s/\xe1\x65/è/gm ;
-                       s/\xe1\x69/ì/gm ;
-                       s/\xe1\x6f/ò/gm ;
-                       s/\xe1\x75/ù/gm ;
-                       s/\xe1\x41/À/gm ;
-                       s/\xe1\x45/È/gm ;
-                       s/\xe1\x49/Ì/gm ;
-                       s/\xe1\x4f/Ò/gm ;
-                       s/\xe1\x55/Ù/gm ;
-                       s/\xe2\x41/Á/gm ;
-                       s/\xe2\x45/É/gm ;
-                       s/\xe2\x49/Í/gm ;
-                       s/\xe2\x4f/Ó/gm ;
-                       s/\xe2\x55/Ú/gm ;
-                       s/\xe2\x59/Ý/gm ;
-                       s/\xe2\x61/á/gm ;
-                       s/\xe2\x65/é/gm ;
-                       s/\xe2\x69/í/gm ;
-                       s/\xe2\x6f/ó/gm ;
-                       s/\xe2\x75/ú/gm ;
-                       s/\xe2\x79/ý/gm ;
-                       s/\xe3\x41/Â/gm ;
-                       s/\xe3\x45/Ê/gm ;
-                       s/\xe3\x49/Î/gm ;
-                       s/\xe3\x4f/Ô/gm ;
-                       s/\xe3\x55/Û/gm ;
-                       s/\xe3\x61/â/gm ;
-                       s/\xe3\x65/ê/gm ;
-                       s/\xe3\x69/î/gm ;
-                       s/\xe3\x6f/ô/gm ;
-                       s/\xe3\x75/û/gm ;
-                       s/\xe4\x41/Ã/gm ;
-                       s/\xe4\x4e/Ñ/gm ;
-                       s/\xe4\x4f/Õ/gm ;
-                       s/\xe4\x61/ã/gm ;
-                       s/\xe4\x6e/ñ/gm ;
-                       s/\xe4\x6f/õ/gm ;
-                       s/\xe8\x45/Ë/gm ;
-                       s/\xe8\x49/Ï/gm ;
-                       s/\xe8\x65/ë/gm ;
-                       s/\xe8\x69/ï/gm ;
-                       s/\xe8\x76/ÿ/gm ;
-                       s/\xe9\x41/Ä/gm ;
-                       s/\xe9\x4f/Ö/gm ;
-                       s/\xe9\x55/Ü/gm ;
-                       s/\xe9\x61/ä/gm ;
-                       s/\xe9\x6f/ö/gm ;
-                       s/\xe9\x75/ü/gm ;
-                       s/\xea\x41/Å/gm ;
-                       s/\xea\x61/å/gm ;
-                       # this handles non-sorting blocks (if implementation 
requires this)
-                       $string = nsb_clean($_) ;
-               }
-       }
-       return($string) ;
- }
- 
- sub nsb_clean {
-       my $NSB = '\x88' ;              # NSB : begin Non Sorting Block
-       my $NSE = '\x89' ;              # NSE : Non Sorting Block end
-       # handles non sorting blocks
-       my ($string) = @_ ;
-       $_ = $string ;
-       s/$NSB/(/gm ;
-       s/[ ]{0,1}$NSE/) /gm ;
-       $string = $_ ;
-       return($string) ;
- }
- 
- END { }       # module clean-up code here (global destructor)
- 
- =back
- 
- =head1 AUTHOR
- 
- Koha Developement team <address@hidden>
- 
- Paul POULAIN address@hidden
- 
- =cut
--- 2544,2545 ----