[Koha-cvs] CVS: koha/C4 Biblio.pm,1.78.2.3,1.78.2.4
Paul POULAIN
tipaul at users.sourceforge.net
Thu Feb 12 14:41:58 CET 2004
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)=@_;
- 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)=@_;
- 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)=@_;
- 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)=@_;
- 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)=@_;
- 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, at barcodes)=@_;
- 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)=@_;
- 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)=@_;
- 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)=@_;
- 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
- )=@_;
-
- # 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 <info at koha.org>
-
- Paul POULAIN paul.poulain at free.fr
-
- =cut
--- 2544,2545 ----
More information about the Koha-cvs
mailing list