Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

deleting subs duplicated by error

Browse source
This commit is contained in:
tipaul 2004-02-12 13:40:56 +00:00
parent 5affdbf4e7
commit 15defe58a9
1 changed files with 3 additions and 605 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

608
C4/Biblio.pm
View file

@ -2191,6 +2191,9 @@ Paul POULAIN paul.poulain@free.fr
# $Id$
# $Log$
# Revision 1.80 2004/02/12 13:40:56 tipaul
# deleting subs duplicated by error
#
# Revision 1.79 2004/02/11 08:40:09 tipaul
# synch'ing 2.0.0 branch and head
#
@ -2543,608 +2546,3 @@ Paul POULAIN paul.poulain@free.fr
# In Biblio.pm, there are some subs that permits to build a old-style record from a MARC::Record, and the opposite. There is also a sub finding a MARC-bibid from a old-biblionumber and the opposite too.
# 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,@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@koha.org>
Paul POULAIN paul.poulain@free.fr
=cut