From 0451359813e49cf2fc35c582dab6a6dc0a11b213 Mon Sep 17 00:00:00 2001 From: tgarip1957 Date: Fri, 25 Aug 2006 21:07:08 +0000 Subject: [PATCH] New set of routines for HEAD. Uses a complete new ZEBRA Indexing. ZEBRA is now XML and comprises of a KOHA meta record. Explanatory notes will be on koha-devel Fixes UTF8 problems Fixes bug with authorities SQL database major changes. Separate biblioograaphic and holdings records. Biblioitems table depreceated etc. etc. Wait for explanatory document on koha-devel --- C4/Accounts2.pm | 390 +- C4/Acquisition.pm | 119 +- C4/Amazon.pm | 56 +- C4/Barcodes/PrinterConfig.pm | 220 - C4/Biblio.pm | 4038 ++++---------- C4/BookShelves.pm | 394 +- C4/Bookfund.pm | 4 +- C4/Breeding.pm | 62 +- C4/{ => Calendar}/Calendar.pm | 1142 ++-- C4/Circulation/Circ2.pm | 1172 ++-- C4/Circulation/Fines.pm | 351 +- C4/Circulation/Returns.pm | 334 -- C4/Context.pm | 156 +- C4/Database.pm | 33 - C4/Date.pm | 32 +- C4/Input.pm | 1 - C4/Interface/CGI/Output.pm | 49 +- C4/Koha.pm | 36 +- C4/Letters.pm | 1 - C4/Maintainance.pm | 230 - C4/Members.pm | 44 +- C4/NewsChannels.pm | 774 +-- C4/Output.pm | 42 +- C4/Reserves2.pm | 927 ++-- C4/Search.pm | 4830 ++--------------- C4/SearchBiblio.pm | 716 --- C4/Serials.pm | 556 +- C4/Shelf.pm | 476 -- C4/Stats.pm | 323 +- C4/Stock.pm | 50 - C4/Suggestions.pm | 3 +- C4/UTF8DBI.pm | 25 + C4/Z3950.pm | 14 +- C4/tests/Record_test.pl | 142 - C4/tests/testrecords/marc21_marc8.dat | 1 - .../marc21_marc8_combining_chars.dat | 1 - C4/tests/testrecords/marc21_marc8_errors.dat | 1 - C4/tests/testrecords/marc21_utf8.dat | 1 - .../marc21_utf8_combining_chars.dat | 1 - C4/tests/testrecords/marcxml_utf8.xml | 44 - .../marcxml_utf8_entityencoded.xml | 46 - 41 files changed, 4907 insertions(+), 12930 deletions(-) delete mode 100644 C4/Barcodes/PrinterConfig.pm rename C4/{ => Calendar}/Calendar.pm (93%) delete mode 100755 C4/Circulation/Returns.pm delete mode 100755 C4/Database.pm delete mode 100644 C4/Maintainance.pm delete mode 100644 C4/SearchBiblio.pm delete mode 100644 C4/Shelf.pm delete mode 100644 C4/Stock.pm create mode 100644 C4/UTF8DBI.pm delete mode 100755 C4/tests/Record_test.pl delete mode 100644 C4/tests/testrecords/marc21_marc8.dat delete mode 100644 C4/tests/testrecords/marc21_marc8_combining_chars.dat delete mode 100644 C4/tests/testrecords/marc21_marc8_errors.dat delete mode 100644 C4/tests/testrecords/marc21_utf8.dat delete mode 100644 C4/tests/testrecords/marc21_utf8_combining_chars.dat delete mode 100644 C4/tests/testrecords/marcxml_utf8.xml delete mode 100644 C4/tests/testrecords/marcxml_utf8_entityencoded.xml diff --git a/C4/Accounts2.pm b/C4/Accounts2.pm index ea920ededf..0af3927152 100755 --- a/C4/Accounts2.pm +++ b/C4/Accounts2.pm @@ -18,19 +18,18 @@ package C4::Accounts2; #assumes C4/Accounts2 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA -# $Id$ use strict; require Exporter; -use DBI; use C4::Context; use C4::Stats; -use C4::Members; +use C4::Search; use C4::Circulation::Circ2; +use C4::Members; use vars qw($VERSION @ISA @EXPORT); # set the version for version checking -$VERSION = do { my @v = '$Revision$' =~ /\d+/g; -shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); }; +$VERSION = 0.01; # FIXME - Should probably be different from + # the version for C4::Accounts =head1 NAME @@ -53,8 +52,10 @@ patron. =cut @ISA = qw(Exporter); -@EXPORT = qw(&checkaccount &recordpayment &fixaccounts &makepayment &manualinvoice -&getnextacctno &reconcileaccount); +@EXPORT = qw(&checkaccount &recordpayment &fixaccounts &makepayment &manualinvoice + &getnextacctno &manualcredit + + &dailyAccountBalance &addDailyAccountOp &getDailyAccountOp); =item checkaccount @@ -79,7 +80,7 @@ sub checkaccount { WHERE borrowernumber = ? AND amountoutstanding<>0"; my @bind = ($bornumber); - if ($date && $date ne ''){ + if ($date ne ''){ $select.=" AND date < ?"; push(@bind,$date); } @@ -87,7 +88,7 @@ sub checkaccount { my $sth=$dbh->prepare($select); $sth->execute(@bind); my $data=$sth->fetchrow_hashref; - my $total = $data->{'total'} || 0; + my $total = $data->{'total'}; $sth->finish; # output(1,2,"borrower owes $total"); #if ($total > 0){ @@ -120,12 +121,10 @@ will be credited to the next one. sub recordpayment{ #here we update both the accountoffsets and the account lines my ($env,$bornumber,$data)=@_; - warn "in accounts2.pm"; my $dbh = C4::Context->dbh; my $newamtos = 0; my $accdata = ""; my $branch=$env->{'branchcode'}; - warn $branch; my $amountleft = $data; # begin transaction my $nextaccntno = getnextacctno($env,$bornumber,$dbh); @@ -138,21 +137,21 @@ sub recordpayment{ while (($accdata=$sth->fetchrow_hashref) and ($amountleft>0)){ if ($accdata->{'amountoutstanding'} < $amountleft) { $newamtos = 0; - $amountleft -= $accdata->{'amountoutstanding'}; + $amountleft -= $accdata->{'amountoutstanding'}; } else { $newamtos = $accdata->{'amountoutstanding'} - $amountleft; - $amountleft = 0; + $amountleft = 0; } my $thisacct = $accdata->{accountno}; my $usth = $dbh->prepare("update accountlines set amountoutstanding= ? where (borrowernumber = ?) and (accountno=?)"); $usth->execute($newamtos,$bornumber,$thisacct); $usth->finish; - $usth = $dbh->prepare("insert into accountoffsets - (borrowernumber, accountno, offsetaccount, offsetamount) - values (?,?,?,?)"); - $usth->execute($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos); - $usth->finish; + # $usth = $dbh->prepare("insert into accountoffsets + # (borrowernumber, accountno, offsetaccount, offsetamount) + # values (?,?,?,?)"); + # $usth->execute($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos); + # $usth->finish; } # create new line my $usth = $dbh->prepare("insert into accountlines @@ -160,7 +159,7 @@ sub recordpayment{ values (?,?,now(),?,'Payment,thanks','Pay',?)"); $usth->execute($bornumber,$nextaccntno,0-$data,0-$amountleft); $usth->finish; - UpdateStats($env,$branch,'payment',$data,'','','',$bornumber); +# UpdateStats($env,$branch,'payment',$data,'','','',$bornumber); $sth->finish; } @@ -181,16 +180,25 @@ was made. #' # FIXME - I'm not at all sure about the above, because I don't # understand what the acct* tables in the Koha database are for. + sub makepayment{ - #here we update both the accountoffsets and the account lines + #here we update the account lines #updated to check, if they are paying off a lost item, we return the item # from their card, and put a note on the item record - my ($bornumber,$accountno,$amount,$user,$branch)=@_; - my %env; - $env{'branchcode'}=$branch; + my ($bornumber,$accountno,$amount,$user,$type)=@_; + my $env; +my $desc; +my $pay; +if ($type eq "Pay"){ + $desc="Payment,received by -". $user; + $pay="Pay"; +}else{ + $desc="Written-off -by". $user; + $pay="W"; +} my $dbh = C4::Context->dbh; # begin transaction - my $nextaccntno = getnextacctno(\%env,$bornumber,$dbh); + my $nextaccntno = getnextacctno($env,$bornumber,$dbh); my $newamtos=0; my $sth=$dbh->prepare("Select * from accountlines where borrowernumber=? and accountno=?"); $sth->execute($bornumber,$accountno); @@ -198,34 +206,45 @@ sub makepayment{ $sth->finish; $dbh->do(<do(<do(<{'itemnumber'}){ +$desc.=" ".$data->{'itemnumber'}; + + $dbh->do(<{'itemnumber'},now(), $payment, + '$desc', '$pay', 0,$accountno) +EOT +}else{ $dbh->do(<finish; #check to see what accounttype if ($data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L'){ @@ -275,17 +294,17 @@ sub fixaccounts { and accountno=?"); $sth->execute($borrowernumber,$accountno); my $data=$sth->fetchrow_hashref; - # FIXME - Error-checking + # FIXME - Error-checking my $diff=$amount-$data->{'amount'}; my $outstanding=$data->{'amountoutstanding'}+$diff; $sth->finish; $dbh->do(<dbh; - my $borrower=borrdata('',$borrnum); + my $borrower=borrdata('',$borrnum); #from C4::Search; my $sth=$dbh->prepare("Update issues set returndate=now() where borrowernumber=? and itemnumber=? and returndate is null"); $sth->execute($borrnum,$itemnum); @@ -330,35 +349,85 @@ sub manualinvoice{ my $accountno=getnextacctno('',$bornum,$dbh); my $amountleft=$amount; - if ($type eq 'CS' || $type eq 'CB' || $type eq 'CW' - || $type eq 'CF' || $type eq 'CL'){ - my $amount2=$amount*-1; # FIXME - $amount2 = -$amount - $amountleft=fixcredit(\%env,$bornum,$amount2,$itemnum,$type,$user); - } + if ($type eq 'N'){ $desc.="New Card"; } + if ($type eq 'L' && $desc eq ''){ $desc="Lost Item"; } - if ($type eq 'REF'){ + if ($type eq 'REF'){ + $desc="Cash refund"; $amountleft=refund('',$bornum,$amount); } if ($itemnum ne ''){ + $desc.=" ".$itemnum; - my $sth=$dbh->prepare("INSERT INTO accountlines - (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber) - VALUES (?, ?, now(), ?,?, ?,?,?)"); -# $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft, $data->{'itemnumber'}); + my $sth=$dbh->prepare("INSERT INTO accountlines + (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber) + VALUES (?, ?, now(), ?,?, ?,?,?)"); $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft, $itemnum); } else { + $desc=$dbh->quote($desc); my $sth=$dbh->prepare("INSERT INTO accountlines (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding) VALUES (?, ?, now(), ?, ?, ?, ?)"); $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft); } } +sub manualcredit{ + my ($bornum,$itemnum,$desc,$type,$amount,$user,$oldaccount)=@_; + my $dbh = C4::Context->dbh; + my $insert; + $itemnum=~ s/ //g; + my %env; + my $accountno=getnextacctno('',$bornum,$dbh); +# my $amountleft=$amount; +my $amountleft; +my $noerror; + if ($type eq 'CN' || $type eq 'CA' || $type eq 'CR' + || $type eq 'CF' || $type eq 'CL' || $type eq 'CM'){ + my $amount2=$amount*-1; # FIXME - $amount2 = -$amount + ( $amountleft, $noerror,$oldaccount)=fixcredit(\%env,$bornum,$amount2,$itemnum,$type,$user); + } + if ($noerror>0){ + if ($type eq 'CN'){ + $desc.="Card fee credited by:".$user; + } +if ($type eq 'CM'){ + $desc.="Other fees credited by:".$user; + } +if ($type eq 'CR'){ + $desc.="Resrvation fee credited by:".$user; + } +if ($type eq 'CA'){ + $desc.="Managenent fee credited by:".$user; + } + if ($type eq 'CL' && $desc eq ''){ + $desc="Lost Item credited by:".$user; + } + + if ($itemnum ne ''){ + $desc.=" Credited for overdue item:".$itemnum. " by:".$user; + my $sth=$dbh->prepare("INSERT INTO accountlines + (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,offset) + VALUES (?, ?, now(), ?,?, ?,?,?,?)"); + $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$oldaccount); + } else { +# $desc=$dbh->quote($desc); + my $sth=$dbh->prepare("INSERT INTO accountlines + (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,offset) + VALUES (?, ?, now(), ?, ?, ?, ?,?)"); + $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft,$oldaccount); + + } +return ("0"); +} else { + return("1"); +} +} # fixcredit # $amountleft = &fixcredit($env, $bornumber, $data, $barcode, $type, $user); # @@ -371,42 +440,56 @@ sub fixcredit{ my $newamtos = 0; my $accdata = ""; my $amountleft = $data; - if ($barcode ne ''){ - my $item=getiteminformation($env,'',$barcode); + + # my $item=getiteminformation($env,'',$barcode); my $nextaccntno = getnextacctno($env,$bornumber,$dbh); my $query="Select * from accountlines where (borrowernumber=? - and itemnumber=? and amountoutstanding > 0)"; - if ($type eq 'CL'){ - $query.=" and (accounttype = 'L' or accounttype = 'Rep')"; - } elsif ($type eq 'CF'){ - $query.=" and (accounttype = 'F' or accounttype = 'FU' or - accounttype='Res' or accounttype='Rent')"; - } elsif ($type eq 'CB'){ - $query.=" and accounttype='A'"; - } + and amountoutstanding > 0)"; +my $exectype; + if ($type eq 'CL'){ + $query.=" and (accounttype = 'L' or accounttype = 'Rep')"; + } elsif ($type eq 'CF'){ + $query.=" and ( itemnumber= ? and (accounttype = 'FU' or accounttype='F') )"; + $exectype=1; + } elsif ($type eq 'CN'){ + $query.=" and ( accounttype = 'N' )"; + } elsif ($type eq 'CR'){ + $query.=" and ( itemnumber= ? and ( accounttype='Res' or accounttype='Rent'))"; + $exectype=1; + }elsif ($type eq 'CM'){ + $query.=" and ( accounttype = 'M' )"; + }elsif ($type eq 'CA'){ + $query.=" and ( accounttype = 'A' )"; + } # print $query; my $sth=$dbh->prepare($query); - $sth->execute($bornumber,$item->{'itemnumber'}); + if ($exectype && $barcode ne ''){ + $sth->execute($bornumber,$barcode); + }else{ + $sth->execute($bornumber); + } $accdata=$sth->fetchrow_hashref; $sth->finish; - if ($accdata->{'amountoutstanding'} < $amountleft) { - $newamtos = 0; - $amountleft -= $accdata->{'amountoutstanding'}; - } else { - $newamtos = $accdata->{'amountoutstanding'} - $amountleft; - $amountleft = 0; - } + +if ($accdata){ + if ($accdata->{'amountoutstanding'} < $amountleft) { + $newamtos = 0; + $amountleft -= $accdata->{'amountoutstanding'}; + } else { + $newamtos = $accdata->{'amountoutstanding'} - $amountleft; + $amountleft = 0; + } my $thisacct = $accdata->{accountno}; my $usth = $dbh->prepare("update accountlines set amountoutstanding= ? where (borrowernumber = ?) and (accountno=?)"); $usth->execute($newamtos,$bornumber,$thisacct); $usth->finish; - $usth = $dbh->prepare("insert into accountoffsets - (borrowernumber, accountno, offsetaccount, offsetamount) - values (?,?,?,?)"); - $usth->execute($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos); - $usth->finish; - } +# $usth = $dbh->prepare("insert into accountoffsets + # (borrowernumber, accountno, offsetaccount, offsetamount) + # values (?,?,?,?)"); +# $usth->execute($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos); + # $usth->finish; + # begin transaction my $nextaccntno = getnextacctno($env,$bornumber,$dbh); # get lines with outstanding amounts to offset @@ -419,29 +502,31 @@ sub fixcredit{ while (($accdata=$sth->fetchrow_hashref) and ($amountleft>0)){ if ($accdata->{'amountoutstanding'} < $amountleft) { $newamtos = 0; - $amountleft -= $accdata->{'amountoutstanding'}; + $amountleft -= $accdata->{'amountoutstanding'}; } else { $newamtos = $accdata->{'amountoutstanding'} - $amountleft; - $amountleft = 0; + $amountleft = 0; } my $thisacct = $accdata->{accountno}; my $usth = $dbh->prepare("update accountlines set amountoutstanding= ? where (borrowernumber = ?) and (accountno=?)"); $usth->execute($newamtos,$bornumber,$thisacct); $usth->finish; - $usth = $dbh->prepare("insert into accountoffsets - (borrowernumber, accountno, offsetaccount, offsetamount) - values (?,?,?,?)"); - $usth->execute($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos); - $usth->finish; +# $usth = $dbh->prepare("insert into accountoffsets + # (borrowernumber, accountno, offsetaccount, offsetamount) + # values (?,?,?,?)"); + # $usth->execute($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos); + # $usth->finish; } $sth->finish; - $env->{'branch'}=$user; - $type="Credit ".$type; - UpdateStats($env,$user,$type,$data,$user,'','',$bornumber); +# $env->{'branch'}=$user; + # $type="Credit ".$type; + # UpdateStats($env,$user,$type,$data,$user,'','',$bornumber); $amountleft*=-1; - return($amountleft); - + return($amountleft,1,$accdata->{'accountno'}); +}else{ +return("",0) +} } # FIXME - Figure out what this function does, and write it down. @@ -466,10 +551,10 @@ sub refund{ while (($accdata=$sth->fetchrow_hashref) and ($amountleft<0)){ if ($accdata->{'amountoutstanding'} > $amountleft) { $newamtos = 0; - $amountleft -= $accdata->{'amountoutstanding'}; + $amountleft -= $accdata->{'amountoutstanding'}; } else { $newamtos = $accdata->{'amountoutstanding'} - $amountleft; - $amountleft = 0; + $amountleft = 0; } # print $amountleft; my $thisacct = $accdata->{accountno}; @@ -477,16 +562,116 @@ sub refund{ where (borrowernumber = ?) and (accountno=?)"); $usth->execute($newamtos,$bornumber,$thisacct); $usth->finish; - $usth = $dbh->prepare("insert into accountoffsets - (borrowernumber, accountno, offsetaccount, offsetamount) - values (?,?,?,?)"); - $usth->execute($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos); - $usth->finish; +# $usth = $dbh->prepare("insert into accountoffsets +# (borrowernumber, accountno, offsetaccount, offsetamount) + # values (?,?,?,?)"); +# $usth->execute($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos); +# $usth->finish; } $sth->finish; return($amountleft); } +#Funtion to manage the daily account# + +sub dailyAccountBalance { + my ($date) = @_; + my $dbh = C4::Context->dbh; + my $sth; + + if ($date) { + + $sth = $dbh->prepare("SELECT * FROM dailyaccountbalance WHERE balanceDate = ?"); + $sth->execute($date); + my $data = $sth->fetchrow_hashref; + if (!$data->{'balanceDate'}) { + $data->{'noentry'} = 1; + } + return ($data); + + } else { + + $sth = $dbh->prepare("SELECT * FROM dailyaccountbalance WHERE balanceDate = CURRENT_DATE()"); + $sth->execute(); + + if ($sth->rows) { + return ($sth->fetchrow_hashref); + } else { + my %hash; + + $sth = $dbh->prepare("SELECT currentBalanceInHand FROM dailyaccountbalance ORDER BY balanceDate DESC LIMIT 1"); + $sth->execute(); + if ($sth->rows) { + ($hash{'initialBalanceInHand'}) = $sth->fetchrow_array; + $hash{'currentBalanceInHand'} = $hash{'initialBalanceInHand'}; + } else { + $hash{'initialBalanceInHand'} = 0; + $hash{'currentBalanceInHand'} = 0; + } + #gets the current date. + my @nowarr = localtime(); + my $date = (1900+$nowarr[5])."-".($nowarr[4]+1)."-".$nowarr[3]; + + $hash{'balanceDate'} = $date; + $hash{'initialBalanceInHand'} = sprintf ("%.2f", $hash{'initialBalanceInHand'}); + $hash{'currentBalanceInHand'} = sprintf ("%.2f", $hash{'currentBalanceInHand'}); + return \%hash; + } + + } +} + +sub addDailyAccountOp { + my ($description, $amount, $type, $invoice) = @_; + my $dbh = C4::Context->dbh; + unless ($invoice) { $invoice = undef}; + my $sth = $dbh->prepare("INSERT INTO dailyaccount (date, description, amount, type, invoice) VALUES (CURRENT_DATE(), ?, ?, ?, ?)"); + $sth->execute($description, $amount, $type, $invoice); + my $accountop = $dbh->{'mysql_insertid'}; + $sth = $dbh->prepare("SELECT * FROM dailyaccountbalance WHERE balanceDate = CURRENT_DATE()"); + $sth->execute(); + if (!$sth->rows) { + $sth = $dbh->prepare("SELECT currentBalanceInHand FROM dailyaccountbalance ORDER BY balanceDate DESC LIMIT 1"); + $sth->execute(); + my ($blc) = $sth->fetchrow_array; + unless ($blc) {$blc = 0} + $sth = $dbh->prepare("INSERT INTO dailyaccountbalance (balanceDate, initialBalanceInHand, currentBalanceInHand) VALUES (CURRENT_DATE(), ?, ?)"); + $sth->execute($blc, $blc); + } + if ($type eq 'D') { + $amount = -1 * $amount; + } + $sth = $dbh->prepare("UPDATE dailyaccountbalance SET currentBalanceInHand = currentBalanceInHand + ? WHERE balanceDate = CURRENT_DATE()"); + $sth->execute($amount); + return $accountop; +} + +sub getDailyAccountOp { + my ($date) = @_; + my $dbh = C4::Context->dbh; + my $sth; + if ($date) { + $sth = $dbh->prepare("SELECT * FROM dailyaccount WHERE date = ?"); + $sth->execute($date); + } else { + $sth = $dbh->prepare("SELECT * FROM dailyaccount WHERE date = CURRENT_DATE()"); + $sth->execute(); + } + my @operations; + my $count = 1; + while (my $row = $sth->fetchrow_hashref) { + $row->{'num'} = $count++; + $row->{$row->{'type'}} = 1; + + $row->{'invoice'} =~ /(\w*)\-(\w*)\-(\w*)/; + $row->{'invoiceNumber'} = $1; + $row->{'invoiceSupplier'} = $2; + $row->{'invoiceType'} = $3; + + push @operations, $row; + } + return (scalar(@operations), \@operations); +} END { } # module clean-up code here (global destructor) @@ -500,4 +685,3 @@ __END__ DBI(3) =cut - diff --git a/C4/Acquisition.pm b/C4/Acquisition.pm index e6a7f07fe0..bef5234233 100644 --- a/C4/Acquisition.pm +++ b/C4/Acquisition.pm @@ -62,9 +62,10 @@ orders, basket and parcels. &GetOrderNumber &GetLateOrders &NewOrder &DelOrder &SearchOrder &GetHistory &ModOrder &ModReceiveOrder &ModOrderBiblioNumber - &GetParcels &GetParcel + &GetParcels &GetParcel ); + =head2 FUNCTIONS ABOUT BASKETS =over 2 @@ -267,19 +268,18 @@ sub GetOrders { my $dbh = C4::Context->dbh; my $query =" SELECT aqorderbreakdown.*, - biblio.*,biblioitems.*, + biblio.*, aqorders.*, biblio.title - FROM aqorders,biblio,biblioitems + FROM aqorders,biblio LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber WHERE basketno=? AND biblio.biblionumber=aqorders.biblionumber - AND biblioitems.biblioitemnumber=aqorders.biblioitemnumber AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00') "; - $orderby = "biblioitems.publishercode" unless $orderby; + $orderby = "biblio.title" unless $orderby; $query .= " ORDER BY $orderby"; my $sth = $dbh->prepare($query); $sth->execute($basketno); @@ -301,7 +301,7 @@ sub GetOrders { $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber); -Looks up the ordernumber with the given biblionumber and biblioitemnumber. +Looks up the ordernumber with the given biblionumber Returns the number of this order. @@ -311,16 +311,16 @@ Returns the number of this order. =cut sub GetOrderNumber { - my ( $biblionumber,$biblioitemnumber ) = @_; + my ( $biblionumber ) = @_; my $dbh = C4::Context->dbh; my $query = " SELECT ordernumber FROM aqorders WHERE biblionumber=? - AND biblioitemnumber=? + "; my $sth = $dbh->prepare($query); - $sth->execute( $biblionumber, $biblioitemnumber ); + $sth->execute( $biblionumber ); return $sth->fetchrow; } @@ -336,7 +336,7 @@ $order = &GetOrder($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 +C<$order> are fields from the biblio, , aqorders, and aqorderbreakdown tables of the Koha database. =back @@ -348,11 +348,11 @@ sub GetOrder { my $dbh = C4::Context->dbh; my $query = " SELECT * - FROM biblio,biblioitems,aqorders + FROM biblio,aqorders LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber WHERE aqorders.ordernumber=? AND biblio.biblionumber=aqorders.biblionumber - AND biblioitems.biblioitemnumber=aqorders.biblioitemnumber + "; my $sth= $dbh->prepare($query); $sth->execute($ordnum); @@ -392,9 +392,9 @@ C<$subscription> may be either "yes", or anything else for "no". sub NewOrder { my ( - $basketno, $bibnum, $title, $quantity, + $basketno, $biblionumber, $title, $quantity, $listprice, $booksellerid, $authorisedby, $notes, - $bookfund, $bibitemnum, $rrp, $ecost, + $bookfund, $rrp, $ecost, $gst, $budget, $cost, $sub, $invoice, $sort1, $sort2 ) @@ -434,14 +434,14 @@ sub NewOrder { my $query = " INSERT INTO aqorders ( biblionumber,title,basketno,quantity,listprice,notes, - biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2,budgetdate,entrydate) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,$budget,now() ) + rrp,ecost,gst,unitprice,subscription,sort1,sort2,budgetdate,entrydate) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,$budget,now() ) "; my $sth = $dbh->prepare($query); $sth->execute( - $bibnum, $title, $basketno, $quantity, $listprice, - $notes, $bibitemnum, $rrp, $ecost, $gst, + $biblionumber, $title, $basketno, $quantity, $listprice, + $notes, $rrp, $ecost, $gst, $cost, $sub, $sort1, $sort2 ); $sth->finish; @@ -483,9 +483,9 @@ table are also updated to the new book fund ID. sub ModOrder { my ( - $title, $ordnum, $quantity, $listprice, $bibnum, + $title, $ordnum, $quantity, $listprice, $biblionumber, $basketno, $supplier, $who, $notes, $bookfund, - $bibitemnum, $rrp, $ecost, $gst, $budget, + $rrp, $ecost, $gst, $budget, $cost, $invoice, $sort1, $sort2 ) = @_; @@ -502,7 +502,7 @@ sub ModOrder { $sth->execute( $title, $quantity, $listprice, $basketno, $rrp, $ecost, $cost, $invoice, $notes, $sort1, - $sort2, $ordnum, $bibnum + $sort2, $ordnum, $biblionumber ); $sth->finish; my $query = " @@ -540,17 +540,6 @@ Updates the order with order number C<$ordernum> and biblionumber C<$biblionumbe =cut -sub ModOrderBiblioNumber { - my ($biblioitemnumber,$ordnum, $biblionumber) = @_; - my $dbh = C4::Context->dbh; - my $query = " - UPDATE aqorders - SET biblioitemnumber = ? - WHERE ordernumber = ? - AND biblionumber = ?"; - my $sth = $dbh->prepare($query); - $sth->execute( $biblioitemnumber, $ordnum, $biblionumber ); -} #------------------------------------------------------------# @@ -578,7 +567,7 @@ Also updates the book fund ID in the aqorderbreakdown table. sub ModReceiveOrder { my ( - $biblio, $ordnum, $quantrec, $user, $cost, + $biblionumber, $ordnum, $quantrec, $user, $cost, $invoiceno, $freight, $rrp, $bookfund ) = @_; @@ -590,11 +579,11 @@ sub ModReceiveOrder { WHERE biblionumber=? AND ordernumber=? "; my $sth = $dbh->prepare($query); - my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblio ); + my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber ); if ($suggestionid) { - ModStatus( $suggestionid, 'AVAILABLE', '', $biblio ); + ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber ); } - $sth->execute( $quantrec, $invoiceno, $cost, $freight, $rrp, $biblio, + $sth->execute( $quantrec, $invoiceno, $cost, $freight, $rrp, $biblionumber, $ordnum ); $sth->finish; @@ -649,6 +638,9 @@ C<@results> is an array of references-to-hash with the following keys: =cut sub SearchOrder { +### Requires fixing for KOHA 3 API for performance. Currently just fiixed so it works +## Very CPU expensive searches seems to be repeated!! +## This search can be directed to ZEBRA for title,isbn etc. ordernumber ,booksellerid to acquiorders my ( $search, $id, $biblio, $catview ) = @_; my $dbh = C4::Context->dbh; my @data = split( ' ', $search ); @@ -661,11 +653,11 @@ sub SearchOrder { my $query; if ($id) { $query = - "SELECT *,biblio.title FROM aqorders,biblioitems,biblio,aqbasket - WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber AND + "SELECT *,biblio.title FROM aqorders,biblio,aqbasket + WHERE biblio.biblionumber=aqorders.biblionumber AND aqorders.basketno = aqbasket.basketno AND aqbasket.booksellerid = ? - AND biblio.biblionumber=aqorders.biblionumber + AND ((datecancellationprinted is NULL) OR (datecancellationprinted = '0000-00-00')) AND ((" @@ -673,16 +665,16 @@ sub SearchOrder { join( " AND ", map { "(biblio.title like ? or biblio.title like ?)" } @data ) ) - . ") OR biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) "; + . ") OR biblio.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) "; } else { $query = " SELECT *,biblio.title - FROM aqorders,biblioitems,biblio,aqbasket - WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber + FROM aqorders,biblio,aqbasket + WHERE aqorders.biblionumber = biblio.biblionumber AND aqorders.basketno = aqbasket.basketno - AND biblio.biblionumber=aqorders.biblionumber + AND ((datecancellationprinted is NULL) OR (datecancellationprinted = '0000-00-00')) AND (aqorders.quantityreceived < aqorders.quantity OR aqorders.quantityreceived is NULL) @@ -691,18 +683,15 @@ sub SearchOrder { join( " AND ", map { "(biblio.title like ? OR biblio.title like ?)" } @data ) ) - . ") or biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) "; + . ") or biblio.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) "; } $query .= " GROUP BY aqorders.ordernumber"; my $sth = $dbh->prepare($query); $sth->execute(@searchterms); my @results = (); - my $query2 = " - SELECT * - FROM biblio - WHERE biblionumber=? - "; - my $sth2 = $dbh->prepare($query2); + + + my $query3 = " SELECT * FROM aqorderbreakdown @@ -711,8 +700,11 @@ sub SearchOrder { my $sth3 = $dbh->prepare($query3); while ( my $data = $sth->fetchrow_hashref ) { - $sth2->execute( $data->{'biblionumber'} ); - my $data2 = $sth2->fetchrow_hashref; +## Retrieving a whole marc record just to extract seriestitle is very poor performance +## Rewrite these searches +my $record=MARCgetbiblio($dbh,$data->{'biblionumber'}); +my $data2=MARCmarc2koha($dbh,$record,"biblios"); + $data->{'author'} = $data2->{'author'}; $data->{'seriestitle'} = $data2->{'seriestitle'}; $sth3->execute( $data->{'ordernumber'} ); @@ -722,7 +714,7 @@ sub SearchOrder { push( @results, $data ); } $sth->finish; - $sth2->finish; + $sth3->finish; return @results; } @@ -744,7 +736,7 @@ cancelled. =cut sub DelOrder { - my ( $bibnum, $ordnum ) = @_; + my ( $biblionumber, $ordnum ) = @_; my $dbh = C4::Context->dbh; my $query = " UPDATE aqorders @@ -752,7 +744,7 @@ sub DelOrder { WHERE biblionumber=? AND ordernumber=? "; my $sth = $dbh->prepare($query); - $sth->execute( $bibnum, $ordnum ); + $sth->execute( $biblionumber, $ordnum ); $sth->finish; } @@ -779,7 +771,7 @@ Looks up all of the received items from the supplier with the given bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders. C<@results> is an array of references-to-hash. The keys of each element are fields from -the aqorders, biblio, and biblioitems tables of the Koha database. +the aqorders, biblio tables of the Koha database. C<@results> is sorted alphabetically by book title. @@ -930,6 +922,7 @@ the table of supplier with late issues. This table is full of hashref. =cut sub GetLateOrders { +## requirse fixing for KOHA 3 API. Currently does not return publisher my $delay = shift; my $supplierid = shift; my $branch = shift; @@ -954,12 +947,11 @@ sub GetLateOrders { aqbooksellers.name AS supplier, aqorders.title, biblio.author, - biblioitems.publishercode AS publisher, - biblioitems.publicationyear, + DATEDIFF(CURDATE( ),closedate) AS latesince - FROM ((( + FROM (( (aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber) - LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber) + LEFT JOIN aqorderbreakdown ON aqorders.ordernumber = aqorderbreakdown.ordernumber) LEFT JOIN aqbookfund ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid), (aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber) @@ -996,12 +988,11 @@ sub GetLateOrders { aqbooksellers.name AS supplier, biblio.title, biblio.author, - biblioitems.publishercode AS publisher, - biblioitems.publicationyear, + (CURDATE - closedate) AS latesince - FROM(( ( + FROM(( (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) - LEFT JOIN biblioitems on biblioitems.biblionumber=biblio.biblionumber) + LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber) LEFT JOIN aqbookfund ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid), (aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id diff --git a/C4/Amazon.pm b/C4/Amazon.pm index f99ff342d4..34b58b1439 100755 --- a/C4/Amazon.pm +++ b/C4/Amazon.pm @@ -34,23 +34,12 @@ package C4::Amazon; # loop SimilarProducts (Product) # loop Reviews (rating, Summary) # -use XML::Simple; -use LWP::Simple; use strict; require Exporter; use vars qw($VERSION @ISA @EXPORT); -$VERSION = 0.02; -=head1 NAME - -C4::Amazon - Functions for retrieving Amazon.com content in Koha - -=head1 FUNCTIONS - -This module provides facilities for retrieving Amazon.com content in Koha - -=cut +$VERSION = 0.01; @ISA = qw(Exporter); @@ -58,24 +47,15 @@ This module provides facilities for retrieving Amazon.com content in Koha &get_amazon_details ); -=head1 get_amazon_details($isbn); - -=head2 $isbn is a isbn string - -=cut - sub get_amazon_details { my ( $isbn ) = @_; # insert your dev key here - $isbn =~ s/(p|-)//g; - +my $dev_key='neulibrary-20'; +$isbn=substr($isbn,0,9); # insert your associates tag here - my $dev_key=C4::Context->preference('AmazonDevKey'); - - #grab the associates tag: mine is '0ZRY7YASKJS280T7YB02' - my $af_tag=C4::Context->preference('AmazonAssocTag'); +my $af_tag='0YGCZ5GV9ZNGGS7THDG2'; my $asin=$isbn; @@ -85,19 +65,27 @@ my $asin=$isbn; # "&dev-t=" . $dev_key . # "&type=heavy&f=xml&" . # "AsinSearch=" . $asin; - my $url = "http://xml.amazon.com/onca/xml3?t=$af_tag&dev-t=$dev_key&type=heavy&f=xml&AsinSearch=" . $asin; +my $url = "http://xml.amazon.com/onca/xml3?t=$dev_key&dev-t=$af_tag&type=heavy&f=xml&AsinSearch=" . $asin; + +#Here's an example asin for the book "Cryptonomicon" +#0596005423"; + +use XML::Simple; +use LWP::Simple; my $content = get($url); - warn "could not retrieve $url" unless $content; +if ($content){ + my $xmlsimple = XML::Simple->new(); my $response = $xmlsimple->XMLin($content, - forcearray => [ qw(Details Product AvgCustomerRating CustomerReview) ], + forcearray => [ qw(Details Product AvgCustomerRating CustomerReview ) ], ); return $response; +#foreach my $result (@{$response->{Details}}){ +# my $product_description = $result->{ProductDescription}; +# my $image = $result->{ImageUrlMedium}; +# my $price = $result->{ListPrice}; +# my $reviews = $result->{ +# return $result; +#} } - -=head1 NOTES - -=head1 AUTHOR - -Joshua Ferraro -=cut +} \ No newline at end of file diff --git a/C4/Barcodes/PrinterConfig.pm b/C4/Barcodes/PrinterConfig.pm deleted file mode 100644 index 44e08c3a81..0000000000 --- a/C4/Barcodes/PrinterConfig.pm +++ /dev/null @@ -1,220 +0,0 @@ -package C4::Barcodes::PrinterConfig; - -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. -# -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA - -use strict; -require Exporter; -use vars qw($VERSION @EXPORT); - -use PDF::API2; -use PDF::API2::Page; - -# set the version for version checking -$VERSION = 0.01; - -=head1 NAME - -C4::Barcodes::PrinterConfig - Koha module dealing with labels in a PDF. - -=head1 SYNOPSIS - - use C4::Barcodes::PrinterConfig; - -=head1 DESCRIPTION - -This package is used to deal with labels in a pdf file. Giving some parameters, -this package contains several functions to handle every label considering the -environment of the pdf file. - -=head1 FUNCTIONS - -=over 2 - -=cut - -@EXPORT = qw(&labelsPage &getLabelPosition setPositionsForX setPositionsForY); - -my @positionsForX; # Takes all the X positions of the pdf file. -my @positionsForY; # Takes all the Y positions of the pdf file. -my $firstLabel = 1; # Test if the label passed as a parameter is the first label to be printed into the pdf file. - -=item setPositionsForX - - C4::Barcodes::PrinterConfig::setPositionsForX($marginLeft, $labelWidth, $columns, $pageType); - -Calculate and stores all the X positions across the pdf page. - -C<$marginLeft> Indicates how much left margin do you want in your page type. - -C<$labelWidth> Indicates the width of the label that you are going to use. - -C<$columns> Indicates how many columns do you want in your page type. - -C<$pageType> Page type to print (eg: a4, legal, etc). - -=cut -#' -sub setPositionsForX { - my ($marginLeft, $labelWidth, $columns, $pageType) = @_; - my $defaultDpi = 72/25.4; # By default we know 25.4 mm -> 1 inch -> 72 dots per inch - my $whereToStart = ($marginLeft + ($labelWidth/2)); - my $firstLabel = $whereToStart*$defaultDpi; - my $spaceBetweenLabels = $labelWidth*$defaultDpi; - my @positions; - for (my $i = 0; $i < $columns ; $i++) { - push @positions, ($firstLabel+($spaceBetweenLabels*$i)); - } - @positionsForX = @positions; -} - -=item setPositionsForY - - C4::Barcodes::PrinterConfig::setPositionsForY($marginBottom, $labelHeigth, $rows, $pageType); - -Calculate and stores all tha Y positions across the pdf page. - -C<$marginBottom> Indicates how much bottom margin do you want in your page type. - -C<$labelHeigth> Indicates the height of the label that you are going to use. - -C<$rows> Indicates how many rows do you want in your page type. - -C<$pageType> Page type to print (eg: a4, legal, etc). - -=cut -#' -sub setPositionsForY { - my ($marginBottom, $labelHeigth, $rows, $pageType) = @_; - my $defaultDpi = 72/25.4; # By default we know 25.4 mm -> 1 inch -> 72 dots per inch - my $whereToStart = ($marginBottom + ($labelHeigth/2)); - my $firstLabel = $whereToStart*$defaultDpi; - my $spaceBetweenLabels = $labelHeigth*$defaultDpi; - my @positions; - for (my $i = 0; $i < $rows; $i++) { - unshift @positions, ($firstLabel+($spaceBetweenLabels*$i)); - } - @positionsForY = @positions; -} - -=item getLabelPosition - - (my $x, my $y, $pdfObject, $pageObject, $gfxObject, $textObject, $coreObject, $labelPosition) = - C4::Barcodes::PrinterConfig::getLabelPosition($labelPosition, - $pdfObject, - $page, - $gfx, - $text, - $fontObject, - $pageType); - -Return the (x,y) position of the label that you are going to print considering the environment. - -C<$labelPosition> Indicates which label positions do you want to place by x and y coordinates. - -C<$pdfObject> The PDF object in use. - -C<$page> The page in use. - -C<$gfx> The gfx resource to handle with barcodes objects. - -C<$text> The text resource to handle with text. - -C<$fontObject> The font object - -C<$pageType> Page type to print (eg: a4, legal, etc). - -=cut -#' -sub getLabelPosition { - my ($labelNum, $pdf, $page, $gfxObject, $textObject, $fontObject, $pageType) = @_; - my $indexX = $labelNum % @positionsForX; - my $indexY = int($labelNum / @positionsForX); - # Calculates the next label position and return that label number - my $nextIndexX = $labelNum % @positionsForX; - my $nextIndexY = $labelNum % @positionsForY; - if ($firstLabel) { - $page = $pdf->page; - $page->mediabox($pageType); - $gfxObject = $page->gfx; - $textObject = $page->text; - $textObject->font($fontObject, 7); - $firstLabel = 0; - } elsif (($nextIndexX == 0) && ($nextIndexY == 0)) { - $page = $pdf->page; - $page->mediabox($pageType); - $gfxObject = $page->gfx; - $textObject = $page->text; - $textObject->font($fontObject, 7); - } - $labelNum = $labelNum + 1; - if ($labelNum == (@positionsForX*@positionsForY)) { - $labelNum = 0; - } - return ($positionsForX[$indexX], $positionsForY[$indexY], $pdf, $page, $gfxObject, $textObject, $fontObject, $labelNum); -} - -=item labelsPage - - my @labelTable = C4::Barcodes::PrinterConfig::labelsPage($rows, $columns); - -This function will help you to build the labels panel, where you can choose -wich label position do you want to start the printer process. - -C<$rows> Indicates how many rows do you want in your page type. - -C<$columns> Indicates how many rows do you want in your page type. - -=cut -#' -sub labelsPage{ - my ($rows, $columns) = @_; - my @pageType; - my $tagname = 0; - my $labelname = 1; - my $check; - for (my $i = 1; $i <= $rows; $i++) { - my @column; - for (my $j = 1; $j <= $columns; $j++) { - my %cell; - if ($tagname == 0) { - $check = 'checked'; - } else { - $check = ''; - } - %cell = (check => $check, - tagname => $tagname, - labelname => $labelname); - $tagname = $tagname + 1; - $labelname = $labelname + 1; - push @column, \%cell; - } - my %columns = (columns => \@column); - push @pageType, \%columns; - } - return @pageType; -} - -1; - -__END__ - -=back - -=head1 AUTHOR - -Koha Physics Library UNLP - -=cut \ No newline at end of file diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 0806adcbf6..8822a4a1c1 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -16,225 +16,413 @@ # You should have received a copy of the GNU General Public License along with # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA - use strict; require Exporter; use C4::Context; -use C4::Database; use MARC::Record; use MARC::File::USMARC; use MARC::File::XML; -use ZOOM; -use Data::Dumper; +use XML::Simple; +use Encode; + use vars qw($VERSION @ISA @EXPORT); # set the version for version checking -$VERSION = 0.01; +$VERSION = 2.01; @ISA = qw(Exporter); -# -# don't forget MARCxxx subs are exported only for testing purposes. Should not be used -# as the old-style API and the NEW one are the only public functions. +# &itemcount removed, now resides in Search.pm # @EXPORT = qw( - &updateBiblio &updateBiblioItem &updateItem - &itemcount &newbiblio &newbiblioitem - &modnote &newsubject &newsubtitle - &modbiblio &checkitems - &newitems &modbibitem - &modsubtitle &modsubject &modaddauthor &moditem &countitems - &delitem &deletebiblioitem &delbiblio - &getbiblio &getstacks - &GetBiblioItemByBiblioNumber - &getbiblioitembybiblionumber - &getbiblioitem &getitemsbybiblioitem - &skip &getitemtypes - &get_itemnumbers_of - - &MARCfind_oldbiblionumber_from_MARCbibid - &MARCfind_MARCbibid_from_oldbiblionumber - &MARCfind_marc_from_kohafield - &MARCfindsubfield - &MARCfind_frameworkcode - &MARCgettagslib - &MARCmoditemonefield - &NEWnewbiblio &NEWnewitem - &NEWmodbiblio &NEWmoditem - &NEWdelbiblio &NEWdelitem - &NEWmodbiblioframework - &zebraop - - &MARCaddbiblio &MARCadditem &MARCmodLCindex - &MARCmodsubfield &MARCaddsubfield - &MARCmodbiblio &MARCmoditem - &MARCkoha2marcBiblio &MARCmarc2koha - &MARCkoha2marcItem &MARChtml2marc &MARChtml2xml - &MARCgetbiblio &MARCgetitem &XMLgetbiblio - &MARCaddword &MARCdelword - &MARCdelsubfield - - &MARCgetbiblio2 - &char_decode - &DisplayISBN -&itemcalculator &calculatelc -); - -# -# -# MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC -# -# -# all the following subs takes a MARC::Record as parameter and manage -# the MARC-DB. They are called by the 1.0/1.2 xxx subs, and by the -# NEWxxx subs (xxx deals with old-DB parameters, the NEWxxx deals with MARC-DB parameter) - -=head1 NAME - -C4::Biblio - acquisition, catalog management functions - -=head1 SYNOPSIS - -move from 1.2 to 1.4 version : -1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters. -In the 1.4 version, we want to do 2 differents things : - - keep populating the old-DB, that has a LOT less datas than MARC - - populate the MARC-DB -To populate the DBs we have 2 differents sources : - - the standard acquisition system (through book sellers), that does'nt use MARC data - - the MARC acquisition system, that uses MARC data. - -Thus, we have 2 differents cases : -- with the standard acquisition system, we have non MARC data and want to populate old-DB and MARC-DB, knowing it's an incomplete MARC-record -- with the MARC acquisition system, we have MARC datas, and want to loose nothing in MARC-DB. So, we can't store datas in old-DB, then copy in MARC-DB. we MUST have an API for true MARC data, that populate MARC-DB then old-DB - -That's why we need 4 subs : -all I manage only MARC tables. They manage MARC-DB with MARC::Record parameters -all I manage only OLD-DB tables. They manage old-DB with old-DB parameters -all I manage both OLD-DB and MARC tables. They use MARC::Record as parameters. it's the API that MUST be used in MARC acquisition system -all I are the old-style API. They use old-DB as parameter, then call internally the OLD and MARC subs. - -- NEW and old-style API should be used in koha to manage biblio -- MARCsubs are divided in 2 parts : -* some of them manage MARC parameters. They are heavily used in koha. -* some of them manage MARC biblio : they are mostly used by NEW and old-style subs. -- OLD are used internally only - -all subs requires/use $dbh as 1st parameter. - -I - -all subs requires/use $dbh as 1st parameter. -those subs are used by the MARC-compliant version of koha : marc import, or marc management. - -I - -all subs requires/use $dbh as 1st parameter. -those subs are used by the MARC-compliant version of koha : marc import, or marc management. - -They all are the exact copy of 1.0/1.2 version of the sub without the OLD. -The OLDxxx is called by the original xxx sub. -the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx - -WARNING : there is 1 difference between initialxxx and OLDxxx : -the db header $dbh is always passed as parameter to avoid over-DB connexion - -=head1 DESCRIPTION - -=over 4 - -=item @tagslib = &MARCgettagslib($dbh,1|0,$itemtype); - -last param is 1 for liblibrarian and 0 for libopac -$itemtype contains the itemtype framework reference. If empty or does not exist, the default one is used -returns a hash with tag/subfield meaning -=item ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield); - -finds MARC tag and subfield for a given kohafield -kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table - -=item $biblionumber = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$MARCbibi); - -finds a old-db biblio number for a given MARCbibid number - -=item $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$oldbiblionumber); -finds a MARC bibid from a old-db biblionumber +&getitemtypes +&getkohafields +&getshelves + +&NEWnewbiblio +&NEWnewitem +&NEWmodbiblio +&NEWmoditem +&NEWdelbiblio +&NEWdelitem +&NEWmodbiblioframework + +&MARCgetallitems +&MARCfind_marc_from_kohafield +&MARCfind_frameworkcode +&MARCfind_itemtype +&MARCgettagslib +&MARCitemsgettagslib +&MARCmoditemonefield +&MARCkoha2marc +&MARCmarc2koha +&MARCkoha2marcOnefield +&MARCfind_attr_from_kohafield +&MARChtml2marc +&MARChtml2xml +&MARChtml2marcxml +&MARCgetbiblio +&MARCgetitem + +&XMLgetbiblio +&XMLgetitem +&XMLgetallitems +&XML_xml2hash +&XML_hash2xml +&XMLmarc2koha +&XML_readline +&XML_writeline + +&ZEBRAgetrecord +&ZEBRAgetallitems +&ZEBRAop &ZEBRAopserver +&ZEBRA_readyXML +&ZEBRA_readyXML_noheader + +&newbiblio +&modbiblio +&DisplayISBN -=item $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber); - -MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem - -=item $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber); - -MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item - -=item $MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle); - -MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle - -=item $olddb = &MARCmarc2koha($dbh,$MARCRecord); +); -builds a hash with old-db datas from a MARC::Record +#################### XML XML XML XML ################### +### XML Read- Write functions -=item &MARCaddbiblio($dbh,$MARC::Record,$biblionumber); -creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio +sub XML_readline{ +my ($xml,$kohafield,$recordtype)=@_; +#$xml represents one record node hashed of holdings or a complete xml koharecord +### $recordtype is needed for reading the child records( like holdings records) .Otherwise main record is assumed ( like biblio) +## holding records are parsed and sent here one by one +my ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype); +my @itemresults; +if ($tag){ +if ($recordtype eq "holdings"){ + my $item=$xml->{'datafield'}; + my $hcontrolfield=$xml->{'controlfield'}; + if ($tag>9){ + foreach my $data (@$item){ + if ($data->{'tag'} eq $tag){ + foreach my $subfield ( $data->{'subfield'}){ + foreach my $code ( @$subfield){ + if ($code->{'code'} eq $subf){ + return Encode::decode("UTF-8",$code->{content}); + } + } + } + } + } + }else{ + foreach my $control (@$hcontrolfield){ + if ($control->{'tag'} eq $tag){ + return Encode::decode("UTF-8",$control->{'content'}); + } + } + }##tag + +}else{ ##Not a holding read biblio +my $biblio=$xml->{'record'}->[0]->{'datafield'}; +my $controlfields=$xml->{'record'}->[0]->{'controlfield'}; + if ($tag>9){ + foreach my $data (@$biblio){ + if ($data->{'tag'} eq $tag){ + foreach my $subfield ( $data->{'subfield'}){ + foreach my $code ( @$subfield){ + if ($code->{'code'} eq $subf){ + return Encode::decode("UTF-8",$code->{'content'}); + } + } + } + } + } + }else{ + + foreach my $control (@$controlfields){ + if ($control->{'tag'} eq $tag){ + return Encode::decode("UTF-8",$control->{'content'}) if $control->{'content'}; + } + } + }##tag +}## Holding or not +}## if tag is mapped +return ""; +} + +sub XML_writeline{ +## This routine modifies one line of marcxml record mainly useful for updating circulation data +my ($xml,$kohafield,$newvalue,$recordtype)=@_; +my $biblio=$xml->{'record'}->[0]->{'datafield'}; +my $controlfield=$xml->{'record'}->[0]->{'controlfield'}; +my ($tag,$subf)=MARCfind_kohafield($kohafield,$recordtype); +my $updated=0; + if ($tag>9){ + foreach my $data (@$biblio){ + if ($data->{'tag'} eq $tag){ + my @subfields=$data->{'subfield'}; + foreach my $subfield ( @subfields){ + foreach my $code ( @$subfield){ + if ($code->{'code'} eq $subf){ + $code->{content}=$newvalue; + $updated=1; + } + } + } + if (!$updated){ + push @subfields,{code=>$subf,content=>$newvalue}; + $data->{subfield}= \@subfields; + + } + } + } + ## Tag did not exist + if (!$updated){ + push @$biblio,{datafield=>[{ + 'ind1' => ' ', + 'ind2' => ' ', + 'subfield' => [ + { + 'content' => $newvalue, + 'code' => $subf + } + ], + 'tag' => $tag + }] + }; + }## created now + }else{ + foreach my $control(@$controlfield){ + if ($control->{'tag'} eq $tag){ + $control->{'content'}=$newvalue; + $updated=1; + } + } + if (!$updated){ + push @$controlfield,{tag=>$tag,content=>$newvalue}; + } + } +return $xml; +} -=item &MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue); +sub XML_xml2hash{ +##make a perl hash from xml file +my ($xml)=@_; + my $hashed = XMLin( $xml ,KeyAttr =>['leader','controlfield','datafield'],ForceArray => ['leader','controlfield','datafield','subfield','holdings','record'],KeepRoot=>0); +return $hashed; +} -adds a subfield in a biblio (in the MARC tables only). +sub XML_hash2xml{ +## turn a hash back to xml +my ($hashed,$root)=@_; +$root="record" unless $root; +my $xml= XMLout($hashed,KeyAttr=>['collection','record','leader','controlfıeld','datafield'],NoSort => 1,AttrIndent => 0,KeepRoot=>0,SuppressEmpty => 1,RootName=>$root); +return $xml; +} -=item $MARCRecord = &MARCgetbiblio($dbh,$bibid); -Returns a MARC::Record for the biblio $bibid. +sub XMLgetbiblio { + # Returns MARC::XML of the biblionumber passed in parameter. + my ( $dbh, $biblionumber ) = @_; + my $sth = $dbh->prepare("select marcxml from biblio where biblionumber=? " ); + $sth->execute( $biblionumber); + my ($marcxml)=$sth->fetchrow; + return ($marcxml); +} + +sub XMLgetitem { + # Returns MARC::XML of the item passed in parameter uses either itemnumber or barcode + my ( $dbh, $itemnumber,$barcode ) = @_; +my $sth; +if ($itemnumber){ + $sth = $dbh->prepare("select marcxml from items where itemnumber=?" ); + $sth->execute($itemnumber); +}else{ + $sth = $dbh->prepare("select marcxml from items where barcode=?" ); + $sth->execute($barcode); +} + my ($marcxml)=$sth->fetchrow; + return ($marcxml); +} -=item &MARCmodbiblio($bibid,$record,$frameworkcode,$delete); +sub XMLgetallitems { +# warn "XMLgetallitems"; + # Returns an array of MARC:XML of the items passed in parameter as biblionumber + my ( $dbh, $biblionumber ) = @_; +my @results; +my $sth = $dbh->prepare("select marcxml from items where biblionumber =?" ); + $sth->execute($biblionumber); -MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter -It 1st delete the biblio, then recreates it. -WARNING : the $delete parameter is not used anymore (too much unsolvable cases). -=item ($subfieldid,$subfieldvalue) = &MARCmodsubfield($dbh,$subfieldid,$subfieldvalue); + while(my ($marcxml)=$sth->fetchrow_array){ + push @results,$marcxml; +} +return @results; +} -MARCmodsubfield changes the value of a given subfield +sub XMLmarc2koha { +# warn "XMLmarc2koha"; +##Returns two hashes from KOHA_XML record +## A biblio hash and and array of item hashes + my ($dbh,$xml,$related_record,@fields) = @_; + my ($result,@items); + +## if @fields is given do not bother about the rest of fields just parse those -=item $subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue); +if ($related_record eq "biblios" || $related_record eq "" || !$related_record){ + if (@fields){ + foreach my $field(@fields){ + my $val=&XML_readline($xml,$field,'biblios'); + $result->{$field}=$val if $val; + + } + }else{ + my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like 'biblios' and tagfield is not null" ); + $sth2->execute(); + my $field; + while ($field=$sth2->fetchrow) { + $result->{$field}=&XML_readline($xml,$field,'biblios'); + } + } -MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values. -Returns -1 if more than 1 answer +## we only need the following for biblio data + +# modify copyrightdate to keep only the 1st year found + my $temp = $result->{'copyrightdate'}; + $temp =~ m/c(\d\d\d\d)/; # search cYYYY first + if ($1>0) { + $result->{'copyrightdate'} = $1; + } else { # if no cYYYY, get the 1st date. + $temp =~ m/(\d\d\d\d)/; + $result->{'copyrightdate'} = $1; + } +# modify publicationyear to keep only the 1st year found + $temp = $result->{'publicationyear'}; + $temp =~ m/c(\d\d\d\d)/; # search cYYYY first + if ($1>0) { + $result->{'publicationyear'} = $1; + } else { # if no cYYYY, get the 1st date. + $temp =~ m/(\d\d\d\d)/; + $result->{'publicationyear'} = $1; + } +} +if ($related_record eq "holdings" || $related_record eq "" || !$related_record){ +my $holdings=$xml->{holdings}->[0]->{record}; -=item $subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder); -MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder + if (@fields){ + foreach my $holding (@$holdings){ +my $itemresult; + foreach my $field(@fields){ + my $val=&XML_readline($holding,$field,'holdings'); + $itemresult->{$field}=$val if $val; + } + push @items, $itemresult; + } + }else{ + my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like 'holdings' and tagfield is not null" ); + foreach my $holding (@$holdings){ + $sth2->execute(); + my $field; +my $itemresult; + while ($field=$sth2->fetchrow) { + $itemresult->{$field}=&XML_readline($xml,$field,'holdings'); + } + push @items, $itemresult; + } + } -=item &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder); +} -MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder -If $subfieldorder is not set, delete all the $tag$subfield subfields + return ($result,@items); +} -=item &MARCdelbiblio($dbh,$bibid); +# +# +# MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC +# +## Script to deal with MARC read write operations -MARCdelbiblio delete biblio $bibid -=item &MARCkoha2marcOnefield +##Sub to match kohafield to Z3950 -attributes -used by MARCkoha2marc and should not be useful elsewhere +sub MARCfind_attr_from_kohafield { +# warn "MARCfind_attr_from_kohafield"; +## returns attribute + my ( $kohafield ) = @_; + return 0, 0 unless $kohafield; -=item &MARCmarc2kohaOnefield + my $relations = C4::Context->attrfromkohafield; + return ($relations->{$kohafield}); +} -used by MARCmarc2koha and should not be useful elsewhere -=item MARCaddword +sub MARCgettagslib { +# warn "MARCgettagslib"; + my ( $dbh, $forlibrarian, $frameworkcode ) = @_; + $frameworkcode = "" unless $frameworkcode; + my $sth; + my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac'; -used to manage MARC_word table and should not be useful elsewhere + # check that framework exists + $sth = + $dbh->prepare( + "select count(*) from biblios_tag_structure where frameworkcode=?"); + $sth->execute($frameworkcode); + my ($total) = $sth->fetchrow; + $frameworkcode = "" unless ( $total > 0 ); + $sth = + $dbh->prepare( +"select tagfield,liblibrarian,libopac,mandatory,repeatable from biblios_tag_structure where frameworkcode=? order by tagfield" + ); + $sth->execute($frameworkcode); + my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable ); -=item MARCdelword + while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) { + $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac; + $res->{$tab}->{tab} = ""; # XXX + $res->{$tag}->{mandatory} = $mandatory; + $res->{$tag}->{repeatable} = $repeatable; + } -used to manage MARC_word table and should not be useful elsewhere + $sth = + $dbh->prepare( +"select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,seealso,hidden,isurl,link from biblios_subfield_structure where frameworkcode=? order by tagfield,tagsubfield" + ); + $sth->execute($frameworkcode); -=cut + my $subfield; + my $authorised_value; + my $authtypecode; + my $value_builder; + + my $seealso; + my $hidden; + my $isurl; + my $link; -sub MARCgettagslib { + while ( + ( $tag, $subfield, $liblibrarian, , $libopac, $tab, + $mandatory, $repeatable, $authorised_value, $authtypecode, + $value_builder, $seealso, $hidden, + $isurl, $link ) + = $sth->fetchrow + ) + { + $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac; + $res->{$tag}->{$subfield}->{tab} = $tab; + $res->{$tag}->{$subfield}->{mandatory} = $mandatory; + $res->{$tag}->{$subfield}->{repeatable} = $repeatable; + $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value; + $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode; + $res->{$tag}->{$subfield}->{value_builder} = $value_builder; + $res->{$tag}->{$subfield}->{seealso} = $seealso; + $res->{$tag}->{$subfield}->{hidden} = $hidden; + $res->{$tag}->{$subfield}->{isurl} = $isurl; + $res->{$tag}->{$subfield}->{link} = $link; + } + return $res; +} +sub MARCitemsgettagslib { +# warn "MARCitemsgettagslib"; my ( $dbh, $forlibrarian, $frameworkcode ) = @_; $frameworkcode = "" unless $frameworkcode; my $sth; @@ -243,13 +431,13 @@ sub MARCgettagslib { # check that framework exists $sth = $dbh->prepare( - "select count(*) from marc_tag_structure where frameworkcode=?"); + "select count(*) from holdings_tag_structure where frameworkcode=?"); $sth->execute($frameworkcode); my ($total) = $sth->fetchrow; $frameworkcode = "" unless ( $total > 0 ); $sth = $dbh->prepare( -"select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield" +"select tagfield,liblibrarian,libopac,mandatory,repeatable from holdings_tag_structure where frameworkcode=? order by tagfield" ); $sth->execute($frameworkcode); my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable ); @@ -263,7 +451,7 @@ sub MARCgettagslib { $sth = $dbh->prepare( -"select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield" +"select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,seealso,hidden,isurl,link from holdings_subfield_structure where frameworkcode=? order by tagfield,tagsubfield" ); $sth->execute($frameworkcode); @@ -271,7 +459,7 @@ sub MARCgettagslib { my $authorised_value; my $authtypecode; my $value_builder; - my $kohafield; + my $seealso; my $hidden; my $isurl; @@ -280,7 +468,7 @@ sub MARCgettagslib { while ( ( $tag, $subfield, $liblibrarian, , $libopac, $tab, $mandatory, $repeatable, $authorised_value, $authtypecode, - $value_builder, $kohafield, $seealso, $hidden, + $value_builder, $seealso, $hidden, $isurl, $link ) = $sth->fetchrow ) @@ -292,7 +480,6 @@ sub MARCgettagslib { $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value; $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode; $res->{$tag}->{$subfield}->{value_builder} = $value_builder; - $res->{$tag}->{$subfield}->{kohafield} = $kohafield; $res->{$tag}->{$subfield}->{seealso} = $seealso; $res->{$tag}->{$subfield}->{hidden} = $hidden; $res->{$tag}->{$subfield}->{isurl} = $isurl; @@ -300,641 +487,121 @@ sub MARCgettagslib { } return $res; } - sub MARCfind_marc_from_kohafield { - my ( $dbh, $kohafield,$frameworkcode ) = @_; +# warn "MARCfind_marc_from_kohafield"; + my ( $kohafield,$recordtype) = @_; return 0, 0 unless $kohafield; +$recordtype="biblios" unless $recordtype; my $relations = C4::Context->marcfromkohafield; - return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]); -} - -sub MARCfind_oldbiblionumber_from_MARCbibid { - my ( $dbh, $MARCbibid ) = @_; -# my $sth = - # $dbh->prepare("select biblionumber from marc_biblio where bibid=?"); -# $sth->execute($MARCbibid); - # my ($biblionumber) = $sth->fetchrow; - return $MARCbibid; -} - -sub MARCfind_MARCbibid_from_oldbiblionumber { - my ( $dbh, $oldbiblionumber ) = @_; -# my $sth = - # $dbh->prepare("select bibid from marc_biblio where biblionumber=?"); - # $sth->execute($oldbiblionumber); - # my ($bibid) = $sth->fetchrow; - return $oldbiblionumber; -} - -sub MARCaddbiblio { - -# pass the MARC::Record to this function, and it will create the records in the marc tables - my ($record,$biblionumber,$frameworkcode,$bibid) = @_; - my $dbh = C4::Context->dbh; - my @fields=$record->fields(); - if (!$frameworkcode){ - $frameworkcode=""; - } - my $sth = $dbh->prepare("update biblio set frameworkcode=? where biblionumber=?" ); - $sth->execute( $frameworkcode,$biblionumber ); - $sth->finish; - my $encoding = C4::Context->preference("marcflavour"); - my $sth =$dbh->prepare("update biblioitems set marc=? where biblionumber=?" ); - $sth->execute( $record->as_usmarc() , $biblionumber); - $sth->finish; - &zebraop($dbh,$biblionumber,"specialUpdate","biblioserver"); - return $biblionumber; -} - -sub MARCadditem { - -# pass the MARC::Record to this function, and it will create the records in the marc tables - my ($dbh,$record,$biblionumber) = @_; -my $newrec=&MARCgetbiblio($dbh,$biblionumber); -# 2nd recreate it - my @fields = $record->fields(); - - foreach my $field (@fields) { - $newrec->append_fields($field); - } -my $bibid=&MARCaddbiblio($newrec,$biblionumber); - return $bibid; + return ($relations->{$recordtype}->{$kohafield}->[0],$relations->{$recordtype}->{$kohafield}->[1]); } -sub MARCaddsubfield { -} sub MARCgetbiblio { - my ( $dbh, $bibid ) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("select marcxml from biblioitems where biblionumber=? " ); - $sth->execute($bibid); - my ($marcxml)=$sth->fetchrow; -# $marcxml =~ s/\/\/g; - my $record = MARC::Record->new(); - $record = MARC::Record::new_from_xml( $marcxml,'utf8' ) if $marcxml; - return $record; -} -############OLD VERSION HERE############################################### -# # Returns MARC::Record of the biblio passed in parameter. -#sub MARCgetbiblio { -# my ( $dbh, $bibid ) = @_; -# my $dbh = C4::Context->dbh; -# my $sth = $dbh->prepare("select marcxml from biblioitems where biblionumber=? "); -# $sth->execute($bibid); -# my ($marc)=$sth->fetchrow; -# my $record = MARC::File::USMARC::decode($marc); -# warn "=>".$record->as_formatted; -# return $record; -#} -# -############################################################################# - -sub XMLgetbiblio { - - # Returns MARC::XML of the biblio passed in parameter. - my ( $dbh, $biblionumber ) = @_; - my $dbh = C4::Context->dbh; - - my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=? " ); - - $sth->execute($biblionumber); - my ($marc)=$sth->fetchrow; - $marc=MARC::File::USMARC::decode($marc); - # print Dumper($marc); - my $marcxml=$marc->as_xml_record(); - print Dumper($marcxml); - return $marcxml; -} -sub MARCgetbiblio2 { - # Returns MARC::Record of the biblio passed in parameter. - my ( $dbh, $bibid ) = @_; - - + ### Takes a new parameter of $title_author =1 which parses the record obly on those fields and nothing else + ### Its useful when Koha requires only title&author for performance issues + my ( $dbh, $biblionumber, $title_author ) = @_; my $sth = - $dbh->prepare("select marc from biblioitems where biblionumber=? " ); - - $sth->execute($bibid); + $dbh->prepare("select marc from biblio where biblionumber=? " ); + $sth->execute( $biblionumber); my ($marc)=$sth->fetchrow; - my $record = MARC::File::USMARC::decode($marc); -my $oldbiblio = MARCmarc2koha($dbh,$record,''); - if($oldbiblio->{'biblionumber'}){ +my $record; + if ($title_author){ + $record = MARC::File::USMARC::decode($marc,\&func_title_author); + }else{ + $record = MARC::File::USMARC::decode($marc); + } +$sth->finish; return $record; -}else{ - warn "Record $bibid does not have field for biblionumber"; - return undef; -} } -sub MARCgetitem_frombarcode { - my ( $dbh, $biblionumber, $barcode ) = @_; - my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber); - # get the complete MARC record - - my $record = MARCgetbiblio($dbh,$biblionumber); -# warn "ITEMRECORD".$record->as_formatted; - # now, find the relevant itemnumber - my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.barcode',''); - # prepare the new item record - my $itemrecord = MARC::Record->new(); - # parse all fields fields from the complete record - foreach ($record->field($itemnumberfield)) { - # when the item field is found, save it -# warn "Itenumberfield = $itemnumberfield"; - if ($_->subfield($itemnumbersubfield) == $barcode) { -# warn "Inside if subfield=$itemnumbersubfield"; - $itemrecord->append_fields($_); - } - } -# warn "ITEMS".$itemrecord->as_formatted; - return $itemrecord; -} -sub MARCgetitem { - # Returns MARC::Record of the item passed in parameter. - my ( $dbh, $bibid, $itemnumber ) = @_; - my $newrecord = MARC::Record->new(); - my $sth = - $dbh->prepare("select marc from biblioitems b, items i where b.biblionumber=i.biblionumber and i.itemnumber=?" ); - + +sub MARCgetitem { +# warn "MARCgetitem"; + # Returns MARC::Record of the item passed in parameter uses either itemnumber or barcode + my ( $dbh, $itemnumber,$barcode ) = @_; +my $sth; +if ($itemnumber){ + $sth = $dbh->prepare("select i.marc from items i where i.itemnumber=?" ); $sth->execute($itemnumber); +}else{ + $sth = $dbh->prepare("select i.marc from items i where i.barcode=?" ); + $sth->execute($barcode); +} my ($marc)=$sth->fetchrow; my $record = MARC::File::USMARC::decode($marc); - #search item field code -my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',''); - my @fields = $record->field($itemnumberfield); - - foreach my $field (@fields) { -#my $pos=index($field->as_string() ,$itemnumber ); + return ($record); +} - if ($field->subfield($itemnumbersubfield) eq $itemnumber ){ +sub MARCgetallitems { +# warn "MARCgetallitems"; + # Returns an array of MARC::Record of the items passed in parameter as biblionumber + my ( $dbh, $biblionumber ) = @_; +my @results; +my $sth = $dbh->prepare("select marc from items where biblionumber =?" ); + $sth->execute($biblionumber); - $newrecord->add_fields($field); - } + while(my ($marc)=$sth->fetchrow_array){ + my $record = MARC::File::USMARC::decode($marc); + push @results,$record; } - return $newrecord; +return @results; } -sub MARCmodbiblio { - my ($bibid,$record,$frameworkcode,$delete)=@_; - my $dbh = C4::Context->dbh; -#delete original marcrecord - my $newrec=&MARCdelbiblio($dbh,$bibid,$delete); -# 2nd recreate it - my @fields = $record->fields(); - foreach my $field (@fields) { - $newrec->append_fields($field); - } -##correct the leader - $newrec->leader($record->leader()); - &MARCmodLCindex($dbh,$newrec,$frameworkcode); - &MARCaddbiblio($newrec,$bibid,$frameworkcode,$bibid); - +sub MARCmoditemonefield{ +# This routine will be depraeciated as soon as mysql dependency on items is removed; +## this function is different to MARCkoha2marcOnefield this one does not need the record but the itemnumber +my ($dbh,$biblionumber,$itemnumber,$itemfield,$newvalue,$donotupdate)=@_; +my ($record) = MARCgetitem($dbh,$itemnumber); + MARCkoha2marcOnefield( $record, $itemfield, $newvalue,"holdings" ); + if($donotupdate){ + ## Prevent various update calls to zebra wait until all changes finish + ## Fix to pass this record around to prevent Mysql update as well + my $sth=$dbh->prepare("update items set marc=? where itemnumber=?"); + $sth->execute($record->as_usmarc,$itemnumber); + $sth->finish; + }else{ + NEWmoditem($dbh,$record,$biblionumber,$itemnumber); } -sub MARCdelbiblio { - my ( $dbh, $bibid, $keep_items ) = @_; - - # if the keep_item is set to 1, then all items are preserved. - # This flag is set when the delbiblio is called by modbiblio - # due to a too complex structure of MARC (repeatable fields and subfields), - # the best solution for a modif is to delete / recreate the record. - -# 1st of all, copy the MARC::Record to deletedbiblio table => if a true deletion, MARC data will be kept. -# if deletion called before MARCmodbiblio => won't do anything, as the oldbiblionumber doesn't - # exist in deletedbiblio table - my $record = MARCgetbiblio( $dbh, $bibid ); - my $oldbiblionumber = - MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); - my $copy2deleted = - $dbh->prepare("update deletedbiblio set marc=? where biblionumber=?"); - $copy2deleted->execute( $record->as_usmarc(), $oldbiblionumber ); - my @fields = $record->fields(); - # now, delete in MARC tables. - if ( $keep_items eq 1 ) { - - #search item field code - my $sth = - $dbh->prepare( -"select tagfield from marc_subfield_structure where kohafield like 'items.%'" - ); - $sth->execute; - my $itemtag = $sth->fetchrow_hashref->{tagfield}; - - - foreach my $field (@fields) { - - if ($field->tag() ne $itemtag){ - $record->delete_field($field); - }#if - }#foreach - } - else { - foreach my $field (@fields) { - - $record->delete_field($field); - - }#foreach - } - return $record; -} - -sub MARCdelitem { - - # delete the item passed in parameter in MARC tables. - my ( $dbh, $bibid, $itemnumber ) = @_; - - # my $record = MARC::Record->new(); - # search MARC tagorder - my $record = MARCgetbiblio( $dbh, $bibid); - my $copy2deleted = - $dbh->prepare("update deleteditems set marc=? where itemnumber=?"); - $copy2deleted->execute( $record->as_usmarc(), $itemnumber ); - - #search item field code - my $sth = - $dbh->prepare( -"select tagfield,tagsubfield from marc_subfield_structure where kohafield like 'items.itemnumber'" - ); - $sth->execute; - my ($itemtag,$itemsubfield) = $sth->fetchrow; - my @fields = $record->field($itemtag); - - foreach my $field (@fields) { -# my $field_item = $record->field($itemtag); -#my $pos=index($field->as_string() ,$itemnumber ); - if ($field->subfield($itemsubfield) eq $itemnumber ){ - $record->delete_field($field); - }#if - }#foreach - -return $record; } -sub MARCmoditemonefield{ -my ($dbh,$biblionumber,$itemnumber,$itemfield,$newvalue)=@_; -if (!defined $newvalue){ -$newvalue=""; -} - -my $record = MARCgetitem($dbh,$biblionumber,$itemnumber); - -my $sth = - $dbh->prepare( -"select tagfield,tagsubfield from marc_subfield_structure where kohafield=?" - ); - my $tagfield; - my $tagsubfield; - $sth->execute($itemfield); - if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) { - my $tag = $record->field($tagfield); - - if ( $tag) { - - my $tagsubs=$record->field($tagfield)->subfield($tagsubfield); - - $tag->update($tagsubfield =>$newvalue); - $record->delete_field($tag); - $record->add_fields($tag); - - &MARCmoditem($dbh,$record,$biblionumber,$itemnumber,0); - } - } +sub MARCfind_frameworkcode { +# warn "MARCfind_frameworkcode"; + my ( $dbh, $biblionumber ) = @_; + my $sth = + $dbh->prepare("select frameworkcode from biblio where biblionumber=?"); + $sth->execute($biblionumber); + my ($frameworkcode) = $sth->fetchrow; + return $frameworkcode; } -sub MARCmoditem { - my ($dbh,$record,$bibid,$itemnumber,$delete)=@_; - my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid); - my $newrec=&MARCdelitem($dbh,$bibid,$itemnumber); - -# 2nd recreate it - my @fields = $record->fields(); - ###NEU specific add cataloguers cardnumber as well -my $cardtag=C4::Context->preference('itemcataloguersubfield'); - - foreach my $field (@fields) { - if ($cardtag){ - my $me= C4::Context->userenv; - my $cataloguer=$me->{'cardnumber'} if ($me); - $field->update($cardtag=>$cataloguer) if ($me); - } - $newrec->append_fields($field); - } - &MARCaddbiblio($newrec,$biblionumber); - +sub MARCfind_itemtype { +# warn "MARCfind_itemtype"; + my ( $dbh, $biblionumber ) = @_; + my $sth = + $dbh->prepare("select itemtype from biblio where biblionumber=?"); + $sth->execute($biblionumber); + my ($itemtype) = $sth->fetchrow; + return $itemtype; } -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); - my ($oldvaluebloblink) = $sth1->fetchrow; - $sth1->finish; - my $sth; - # if too long, use a bloblink - if ( length($subfieldvalue) > 255 ) { - # if already a bloblink, update it, otherwise, insert a new one. - if ($oldvaluebloblink) { - $sth = - $dbh->prepare( -"update marc_blob_subfield set subfieldvalue=? where blobidlink=?" - ); - $sth->execute( $subfieldvalue, $oldvaluebloblink ); - } - else { - $sth = - $dbh->prepare( - "insert into marc_blob_subfield (subfieldvalue) values (?)"); - $sth->execute($subfieldvalue); - $sth = - $dbh->prepare("select max(blobidlink) from marc_blob_subfield"); - $sth->execute; - my ($res) = $sth->fetchrow; - $sth = - $dbh->prepare( -"update marc_subfield_table set subfieldvalue=null, valuebloblink=? where subfieldid=?" - ); - $sth->execute( $res, $subfieldid ); - } - } - else { - -# note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script... - $sth = - $dbh->prepare( -"update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?" - ); - $sth->execute( $subfieldvalue, $subfieldid ); - } - $dbh->do("unlock tables"); - $sth->finish; - $sth = - $dbh->prepare( -"select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?" - ); - $sth->execute($subfieldid); - my ( $bibid, $tagid, $tagorder, $subfieldcode, $x, $subfieldorder ) = - $sth->fetchrow; - $subfieldid = $x; - return ( $subfieldid, $subfieldvalue ); -} - -sub MARCfindsubfield { - my ( $dbh, $bibid, $tag, $subfieldcode, $subfieldorder, $subfieldvalue ) = - @_; - my $resultcounter = 0; - my $subfieldid; - my $lastsubfieldid; - my $query = -"select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?"; - my @bind_values = ( $bibid, $tag, $subfieldcode ); - if ($subfieldvalue) { - $query .= " and subfieldvalue=?"; - push ( @bind_values, $subfieldvalue ); - } - else { - if ( $subfieldorder < 1 ) { - $subfieldorder = 1; - } - $query .= " and subfieldorder=?"; - push ( @bind_values, $subfieldorder ); - } - my $sti = $dbh->prepare($query); - $sti->execute(@bind_values); - while ( ($subfieldid) = $sti->fetchrow ) { - $resultcounter++; - $lastsubfieldid = $subfieldid; - } - if ( $resultcounter > 1 ) { - -# Error condition. Values given did not resolve into a unique record. Don't know what to edit -# should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange) - return -1; - } - else { - return $lastsubfieldid; - } -} - -sub MARCfindsubfieldid { - my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_; - my $sth = $dbh->prepare( "select subfieldid from marc_subfield_table - where bibid=? and tag=? and tagorder=? - and subfieldcode=? and subfieldorder=?" - ); - $sth->execute( $bibid, $tag, $tagorder, $subfield, $subfieldorder ); - my ($res) = $sth->fetchrow; - unless ($res) { - $sth = $dbh->prepare( "select subfieldid from marc_subfield_table - where bibid=? and tag=? and tagorder=? - and subfieldcode=?" - ); - $sth->execute( $bibid, $tag, $tagorder, $subfield ); - ($res) = $sth->fetchrow; - } - return $res; -} - -sub MARCfind_frameworkcode { - my ( $dbh, $bibid ) = @_; - my $sth = - $dbh->prepare("select frameworkcode from biblio where biblionumber=?"); - $sth->execute($bibid); - my ($frameworkcode) = $sth->fetchrow; - return $frameworkcode; -} - -sub MARCdelsubfield { - - # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder - my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_; - if ($subfieldorder) { - $dbh->do( "delete from marc_subfield_table where bibid='$bibid' and - tag='$tag' and tagorder='$tagorder' - and subfieldcode='$subfield' and subfieldorder='$subfieldorder' - " - ); - } else { - $dbh->do( "delete from marc_subfield_table where bibid='$bibid' and - tag='$tag' and tagorder='$tagorder' - and subfieldcode='$subfield'" - ); - } -} - -sub MARCkoha2marcBiblio { - - # this function builds partial MARC::Record from the old koha-DB fields - my ( $dbh, $biblionumber, $biblioitemnumber ) = @_; - my $sth = - $dbh->prepare( -"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?" - ); - my $record = MARC::Record->new(); - - #--- if bibid, then retrieve old-style koha data - if ( $biblionumber > 0 ) { - my $sth2 = - $dbh->prepare( -"select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp - from biblio where biblionumber=?" - ); - $sth2->execute($biblionumber); - my $row = $sth2->fetchrow_hashref; - my $code; - foreach $code ( keys %$row ) { - if ( $row->{$code} ) { - &MARCkoha2marcOnefield( $sth, $record, "biblio." . $code, - $row->{$code}, ''); - } - } - } - - #--- if biblioitem, then retrieve old-style koha data - if ( $biblioitemnumber > 0 ) { - my $sth2 = - $dbh->prepare( - " SELECT biblioitemnumber,biblionumber,volume,number,classification, - itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode, - volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place - FROM biblioitems - WHERE biblioitemnumber=? - " - ); - $sth2->execute($biblioitemnumber); - my $row = $sth2->fetchrow_hashref; - my $code; - foreach $code ( keys %$row ) { - if ( $row->{$code} ) { - &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $code, - $row->{$code},'' ); - } - } - } - - # other fields => additional authors, subjects, subtitles - my $sth2 = - $dbh->prepare( - " SELECT author FROM additionalauthors WHERE biblionumber=?"); - $sth2->execute($biblionumber); - while ( my $row = $sth2->fetchrow_hashref ) { - &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author", - $row->{'author'},'' ); - } - $sth2 = - $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?"); - $sth2->execute($biblionumber); - while ( my $row = $sth2->fetchrow_hashref ) { - &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject", - $row->{'subject'},'' ); - } - $sth2 = - $dbh->prepare( - " SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?"); - $sth2->execute($biblionumber); - while ( my $row = $sth2->fetchrow_hashref ) { - &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle", - $row->{'subtitle'},'' ); - } - return $record; -} - -sub MARCkoha2marcItem { - - # this function builds partial MARC::Record from the old koha-DB fields - my ( $dbh, $biblionumber, $itemnumber ) = @_; - - # my $dbh=&C4Connect; - my $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"); - 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,itemcallnumber,issues,renewals, - reserves,restricted,binding,itemnotes,holdingbranch,timestamp,onloan,Cutterextra - FROM items - WHERE itemnumber=?" - ); - $sth2->execute($itemnumber); - my $row = $sth2->fetchrow_hashref; - my $code; - foreach $code ( keys %$row ) { - if ( $row->{$code} ) { - &MARCkoha2marcOnefield( $sth, $record, "items." . $code, - $row->{$code},'' ); - } - } - } - return $record; -} - -sub MARCkoha2marcSubtitle { - - # this function builds partial MARC::Record from the old koha-DB fields - my ( $dbh, $bibnum, $subtitle ) = @_; - my $sth = - $dbh->prepare( -"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?" - ); - my $record = MARC::Record->new(); - &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle", - $subtitle,'' ); - return $record; -} - -sub MARCkoha2marcOnefield { - my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_; - my $tagfield; - my $tagsubfield; - -if (!defined $sth){ -my $dbh=C4::Context->dbh; -$sth = - $dbh->prepare( -"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?" - ); -} - $sth->execute($frameworkcode,$kohafieldname); - if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) { - # if ( $record->field($tagfield) ) { - my $tag = $record->field($tagfield); - if ($tag) { - $tag->update( $tagsubfield=> $value ); - $record->delete_field($tag); - $record->add_fields($tag); - - - }else { - $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value ); - } - } - - return $record; -} sub MARChtml2xml { +# warn "MARChtml2xml "; my ($tags,$subfields,$values,$indicator,$ind_tag) = @_; - #use MARC::File::XML; - my $xml= MARC::File::XML::header('UTF-8'); - #$xml =~ s/UTF-8/ISO-8859-1/; +# use MARC::File::XML; + my $xml= marc_record_header('UTF-8'); #### we do not need a collection wrapper + my $prevvalue; my $prevtag=-1; my $first=1; @@ -948,7 +615,7 @@ sub MARChtml2xml { if ((@$tags[$i] ne $prevtag)){ $j++ unless (@$tags[$i] eq ""); - #warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i]; + ## warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i]; if (!$first){ $xml.="\n"; if ((@$tags[$i] > 10) && (@$values[$i] ne "")){ @@ -994,11 +661,36 @@ sub MARChtml2xml { } $prevtag = @$tags[$i]; } - $xml.= MARC::File::XML::footer(); - #warn $xml; + $xml.=""; + # warn $xml; return $xml; } +sub marc_record_header { +#### this one is for + my $format = shift; + my $enc = shift || 'UTF-8'; + return( < + +MARC_XML_HEADER +} + + +sub collection_header { +#### this one is for koha collection + my $format = shift; + my $enc = shift || 'UTF-8'; + return( < + +KOHA_XML_HEADER +} + sub MARChtml2marc { +# warn "MARChtml2marc"; my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_; my $prevtag = -1; my $record = MARC::Record->new(); @@ -1008,13 +700,13 @@ sub MARChtml2marc { for (my $i=0; $i< @$rtags; $i++) { next unless @$rvalues[$i]; # rebuild MARC::Record -# warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": "; +# # warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": "; if (@$rtags[$i] ne $prevtag) { if ($prevtag < 10) { if ($prevvalue) { if ($prevtag ne '000') { - $record->add_fields((sprintf "%03s",$prevtag),$prevvalue); + $record->insert_fields_ordered((sprintf "%03s",$prevtag),$prevvalue); } else { $record->leader($prevvalue); @@ -1023,7 +715,7 @@ sub MARChtml2marc { } } else { if ($field) { - $record->add_fields($field); + $record->insert_fields_ordered($field); } } $indicators{@$rtags[$i]}.=' '; @@ -1033,7 +725,7 @@ sub MARChtml2marc { } else { undef $prevvalue; $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]); -# warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted; +# # warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted; } $prevtag = @$rtags[$i]; } else { @@ -1042,46 +734,50 @@ sub MARChtml2marc { } else { if (length(@$rvalues[$i])>0) { $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]); -# warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted; +# # warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted; } } $prevtag= @$rtags[$i]; } } # the last has not been included inside the loop... do it now ! - $record->add_fields($field) if $field; -# warn "HTML2MARC=".$record->as_formatted; + $record->insert_fields_ordered($field) if $field; +# # warn "HTML2MARC=".$record->as_formatted; $record->encoding( 'UTF-8' ); # $record->MARC::File::USMARC::update_leader(); return $record; } -sub MARCmarc2koha { - my ($dbh,$record,$frameworkcode) = @_; - my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"); - my $result; - my $sth2=$dbh->prepare("SHOW COLUMNS from biblio"); - $sth2->execute; +sub MARCkoha2marc { +# warn "MARCkoha2marc"; +## This routine most probably will be depreaceated -- it is still used for acqui management +##Returns a MARC record from a hash + my ($dbh,$result,$recordtype) = @_; + + my $record = MARC::Record->new(); + my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where tagfield is not null and recordtype=?"); + $sth2->execute($recordtype); my $field; while (($field)=$sth2->fetchrow) { - $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode); + $record=&MARCkoha2marcOnefield($record,$field,$result->{$field},$recordtype) if $result->{$field}; } - $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems"); - $sth2->execute; - while (($field)=$sth2->fetchrow) { - if ($field eq 'notes') { $field = 'bnotes'; } - $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode); - } - $sth2=$dbh->prepare("SHOW COLUMNS from items"); - $sth2->execute; - while (($field)=$sth2->fetchrow) { - $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode); +return $record; +} +sub MARCmarc2koha { +# warn "MARCmarc2koha"; +##Returns a hash from MARC record + my ($dbh,$record,$related_record) = @_; + my $result; +if (!$related_record){$related_record="biblios";} + my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like ? and tagfield is not null" ); + $sth2->execute($related_record); + my $field; + while ($field=$sth2->fetchrow) { + $result=&MARCmarc2kohaOneField($field,$record,$result,$related_record); } - # additional authors : specific - $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode); - $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode); - $result = &MARCmarc2kohaOneField($sth,"bibliosubject","subject",$record,$result,$frameworkcode); -# + +## we only need the following for biblio data +if ($related_record eq "biblios"){ # modify copyrightdate to keep only the 1st year found my $temp = $result->{'copyrightdate'}; $temp =~ m/c(\d\d\d\d)/; # search cYYYY first @@ -1100,18 +796,54 @@ sub MARCmarc2koha { $temp =~ m/(\d\d\d\d)/; $result->{'publicationyear'} = $1; } +} return $result; } -sub MARCmarc2kohaOneField { +sub MARCkoha2marcOnefield { +##Updates or creates one field in MARC record + my ( $record, $kohafieldname, $value,$recordtype ) = @_; +my ( $tagfield, $tagsubfield ) = MARCfind_marc_from_kohafield($kohafieldname,$recordtype); +if ($tagfield){ +my $tag = $record->field($tagfield); + if ( $tagfield>9) { + if ($tag) { + if ($value){## We may be trying to delete a subfield value + $tag->update( $tagsubfield=> $value ); + }else{ + $tag->delete_subfield(code=>$tagsubfield); + } + $record->delete_field($tag); + $record->insert_fields_ordered($tag); + }else { + my $newtag=MARC::Field->new( $tagfield, " ", " ", $tagsubfield => $value); + $record->insert_fields_ordered($newtag); + } + }else { + if ($tag) { + if ($value){ + $tag->update( $value ); + $record->delete_field($tag); + $record->insert_fields_ordered($tag); + }else{ + $record->delete_field($tag); + } + }else { + my $newtag=MARC::Field->new( $tagfield => $value); + $record->insert_fields_ordered($newtag); + } + } +}## $tagfield defined + return $record; +} -# FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved... - my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_; - # warn "kohatable / $kohafield / $result / "; +sub MARCmarc2kohaOneField { + my ( $kohafield, $record, $result,$recordtype ) = @_; + # # warn "kohatable / $kohafield / $result / "; my $res = ""; - my $tagfield; - my $subfield; - ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode); + + my ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield($kohafield,$recordtype); +if ($tagfield){ foreach my $field ( $record->field($tagfield) ) { if ($field->tag()<10) { if ($result->{$kohafield}) { @@ -1135,962 +867,388 @@ sub MARCmarc2kohaOneField { } } } -# warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield"; +} return $result; } -sub MARCaddword { - - # split a subfield string and adds it into the word table. - # removes stopwords - my ( - $dbh, $bibid, $tag, $tagorder, - $subfieldid, $subfieldorder, $sentence - ) - = @_; - $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)/ /g; - my @words = split / /, $sentence; - my $stopwords = C4::Context->stopwords; - my $sth = - $dbh->prepare( -"insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word) - values (?,concat(?,?),?,?,?,soundex(?))" - ); - foreach my $word (@words) { -# we record only words one char long and not in stopwords hash - if (length($word)>=1 and !($stopwords->{uc($word)})) { - $sth->execute($bibid,$tag,$subfieldid,$tagorder,$subfieldorder,$word,$word); - if ($sth->err()) { - warn "ERROR ==> insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word) values ($bibid,concat($tag,$subfieldid),$tagorder,$subfieldorder,$word,soundex($word))\n"; - } - } - } -} +sub MARCmodLCindex{ +# warn "MARCmodLCindex"; +my ($dbh,$record)=@_; -sub MARCdelword { +my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield("classification","biblios"); +my ($tagfield2,$tagsubfieldsub) = MARCfind_marc_from_kohafield("subclass","biblios"); +my $tag=$record->field($tagfield); +if ($tag){ +my ($lcsort)=calculatelc($tag->subfield($tagsubfield)).$tag->subfield($tagsubfieldsub); -# delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add - my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_; - my $sth = - $dbh->prepare( -"delete from marc_word where bibid=? and tagsubfield=concat(?,?) and tagorder=? and subfieldorder=?" - ); - $sth->execute( $bibid, $tag, $subfield, $tagorder, $subfieldorder ); + &MARCkoha2marcOnefield( $record, "lcsort", $lcsort,"biblios"); +} +return $record; } -# -# -# NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW -# -# -# all the following subs are useful to manage MARC-DB with complete MARC records. -# it's used with marcimport, and marc management tools -# - -=item ($bibid,$oldbibnum,$oldbibitemnum) = NEWnewbibilio($dbh,$MARCRecord,$oldbiblio,$oldbiblioitem); - -creates a new biblio from a MARC::Record. The 3rd and 4th parameter are hashes and may be ignored. If only 2 params are passed to the sub, the old-db hashes -are builded from the MARC::Record. If they are passed, they are used. - -=item NEWnewitem($dbh, $record,$bibid); - -adds an item in the db. - -=cut - +##########################NEW NEW NEW############################# sub NEWnewbiblio { my ( $dbh, $record, $frameworkcode) = @_; - my $oldbibnum; - my $oldbibitemnum; - my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode ); - $oldbibnum = OLDnewbiblio( $dbh, $olddata ); - $olddata->{'biblionumber'} = $oldbibnum; - $oldbibitemnum = OLDnewbiblioitem( $dbh, $olddata ); - - # search subtiles, addiauthors and subjects - my ( $tagfield, $tagsubfield ) = - MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode ); - my @addiauthfields = $record->field($tagfield); - foreach my $addiauthfield (@addiauthfields) { - my @addiauthsubfields = $addiauthfield->subfield($tagsubfield); - foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) { - OLDmodaddauthor( $dbh, $oldbibnum, - $addiauthsubfields[$subfieldcount] ); - } - } - ( $tagfield, $tagsubfield ) = - MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode ); - my @subtitlefields = $record->field($tagfield); - foreach my $subtitlefield (@subtitlefields) { - my @subtitlesubfields = $subtitlefield->subfield($tagsubfield); - foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) { - OLDnewsubtitle( $dbh, $oldbibnum, - $subtitlesubfields[$subfieldcount] ); - } - } - ( $tagfield, $tagsubfield ) = - MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode ); - my @subj = $record->field($tagfield); - my @subjects; - foreach my $subject (@subj) { - my @subjsubfield = $subject->subfield($tagsubfield); - foreach my $subfieldcount ( 0 .. $#subjsubfield ) { - push @subjects, $subjsubfield[$subfieldcount]; - } - } - OLDmodsubject( $dbh, $oldbibnum, 1, @subjects ); - - # we must add bibnum and bibitemnum in MARC::Record... - # we build the new field with biblionumber and biblioitemnumber - # we drop the original field - # we add the new builded field. -# NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber - # (steve and paul : thinks 090 is a good choice) - my $sth = - $dbh->prepare( -"select tagfield,tagsubfield from marc_subfield_structure where kohafield=?" - ); - $sth->execute("biblio.biblionumber"); - ( my $tagfield1, my $tagsubfield1 ) = $sth->fetchrow; - $sth->execute("biblioitems.biblioitemnumber"); - ( my $tagfield2, my $tagsubfield2 ) = $sth->fetchrow; - - my $newfield; - # biblionumber & biblioitemnumber are in different fields - if ( $tagfield1 != $tagfield2 ) { - # deal with biblionumber - if ($tagfield1<10) { - $newfield = MARC::Field->new( - $tagfield1, $oldbibnum, - ); - } else { - $newfield = MARC::Field->new( - $tagfield1, '', '', "$tagsubfield1" => $oldbibnum, - ); - } - # drop old field and create new one... - my $old_field = $record->field($tagfield1); - $record->delete_field($old_field); - $record->append_fields($newfield); - # deal with biblioitemnumber - if ($tagfield2<10) { - $newfield = MARC::Field->new( - $tagfield2, $oldbibitemnum, - ); - } else { - $newfield = MARC::Field->new( - $tagfield2, '', '', "$tagsubfield2" => $oldbibitemnum, - ); - } - # drop old field and create new one... - $old_field = $record->field($tagfield2); - $record->delete_field($old_field); - $record->add_fields($newfield); - # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value) - } else { - my $newfield = MARC::Field->new( - $tagfield1, '', '', "$tagsubfield1" => $oldbibnum, - "$tagsubfield2" => $oldbibitemnum - ); - # drop old field and create new one... - my $old_field = $record->field($tagfield1); - $record->delete_field($old_field); - $record->add_fields($newfield); - } -# warn "REC : ".$record->as_formatted; -###NEU specific add cataloguers cardnumber as well -my $cardtag=C4::Context->preference('cataloguersfield'); -if ($cardtag){ -my $tag=substr($cardtag,0,3); -my $subf=substr($cardtag,3,1); -my $me= C4::Context->userenv; -my $cataloger=$me->{'cardnumber'} if ($me); -my $newtag= MARC::Field->new($tag, '', '', $subf => $cataloger) if ($me); -$record->delete_field($newtag); -$record->add_fields($newtag); + my $biblionumber; +$frameworkcode="" unless $frameworkcode; + my $olddata = MARCmarc2koha( $dbh, $record,"biblios" ); +## In case reimporting records with biblionumbers keep them +if ($olddata->{'biblionumber'}){ +$biblionumber=NEWmodbiblio( $dbh, $olddata->{'biblionumber'},$record,$frameworkcode ); +}else{ + $biblionumber = NEWaddbiblio( $dbh, $record,$frameworkcode ); } -## We must add the indexing fields for LC in MARC record--TG - &MARCmodLCindex($dbh,$record,$frameworkcode); - - my $bibid = MARCaddbiblio($record, $oldbibnum, $frameworkcode ); - return ( $bibid, $oldbibnum, $oldbibitemnum ); + return ( $biblionumber ); } -sub MARCmodLCindex{ -my ($dbh,$record,$frameworkcode)=@_; -if(!$frameworkcode){ -$frameworkcode=""; -} -my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.classification",$frameworkcode); -my ($tagfield,$tagsubfieldsub) = MARCfind_marc_from_kohafield($dbh,"biblioitems.subclass",$frameworkcode); -my $tag=$record->field($tagfield); -if ($tag){ -my ($lcsort)=calculatelc($tag->subfield($tagsubfield)).$tag->subfield($tagsubfieldsub); - &MARCkoha2marcOnefield( undef, $record, "biblioitems.lcsort", $lcsort,$frameworkcode); -} -return $record; -} sub NEWmodbiblioframework { - my ($bibid,$frameworkcode) =@_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=$bibid"); + my ($dbh,$biblionumber,$frameworkcode) =@_; + my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=$biblionumber"); $sth->execute($frameworkcode); return 1; } -sub NEWmodbiblio { - my ($record,$bibid,$frameworkcode) =@_; - my $dbh = C4::Context->dbh; - $frameworkcode="" unless $frameworkcode; - &MARCmodbiblio($bibid,$record,$frameworkcode,1); - my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode); - - my $oldbiblionumber = OLDmodbiblio($dbh,$oldbiblio); +sub NEWdelbiblio { - OLDmodbibitem($dbh,$oldbiblio); + my ( $dbh, $biblionumber ) = @_; +my $sth=$dbh->prepare("SELECT itemnumber FROM items where biblionumber=?"); - # now, modify addi authors, subject, addititles. - my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode); - my @addiauthfields = $record->field($tagfield); - foreach my $addiauthfield (@addiauthfields) { - my @addiauthsubfields = $addiauthfield->subfield($tagsubfield); - foreach my $subfieldcount (0..$#addiauthsubfields) { - OLDmodaddauthor($dbh,$oldbiblionumber,$addiauthsubfields[$subfieldcount]); - } - } - ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode); - my @subtitlefields = $record->field($tagfield); - foreach my $subtitlefield (@subtitlefields) { - my @subtitlesubfields = $subtitlefield->subfield($tagsubfield); - # delete & create subtitle again because OLDmodsubtitle can't handle new subtitles - # between 2 modifs - $dbh->do("delete from bibliosubtitle where biblionumber=$oldbiblionumber"); - foreach my $subfieldcount (0..$#subtitlesubfields) { - foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) { - OLDnewsubtitle($dbh,$oldbiblionumber,$subtit); - } - } - } - ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode); - my @subj = $record->field($tagfield); - my @subjects; - foreach my $subject (@subj) { - my @subjsubfield = $subject->subfield($tagsubfield); - foreach my $subfieldcount (0..$#subjsubfield) { - push @subjects,$subjsubfield[$subfieldcount]; - } +$sth->execute($biblionumber); + while (my $itemnumber =$sth->fetchrow){ + OLDdelitem($dbh,$itemnumber) ; } - OLDmodsubject($dbh,$oldbiblionumber,1,@subjects); - return 1; -} -sub NEWdelbiblio { - my ( $dbh, $bibid ) = @_; - my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); + ZEBRAop($dbh,$biblionumber,"recordDelete","biblioserver"); +OLDdelbiblio($dbh,$biblionumber) ; -&zebraop($dbh,$bibid,"RecordDelete","biblioserver"); - &OLDdelbiblio( $dbh, $biblio ); - my $sth = - $dbh->prepare( - "select biblioitemnumber from biblioitems where biblionumber=?"); - $sth->execute($biblio); - while ( my ($biblioitemnumber) = $sth->fetchrow ) { - OLDdeletebiblioitem( $dbh, $biblioitemnumber ); - } - - &MARCdelbiblio( $dbh, $bibid, 0 ); - } sub NEWnewitem { - my ( $dbh, $record, $bibid ) = @_; - # add item in old-DB - my $frameworkcode=MARCfind_frameworkcode($dbh,$bibid); - my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode ); - # needs old biblionumber and biblioitemnumber - $item->{'biblionumber'} =MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); - my $sth = - $dbh->prepare( - "select biblioitemnumber,itemtype from biblioitems where biblionumber=?"); - $sth->execute( $item->{'biblionumber'} ); -my $itemtype; - ( $item->{'biblioitemnumber'}, $itemtype ) = $sth->fetchrow; -my $sth=$dbh->prepare("select notforloan from itemtypes where itemtype='$itemtype'"); + my ( $dbh, $record, $biblionumber ) = @_; + my $itemtype= MARCfind_itemtype($dbh,$biblionumber); + my $item = &MARCmarc2koha( $dbh, $record,"holdings" ); +## In case we are re-importing marc records from bulk import do not change itemnumbers +if ($item->{itemnumber}){ +NEWmoditem ( $dbh, $record, $biblionumber, $item->{itemnumber}); +}else{ + $item->{'biblionumber'} =$biblionumber; +##Add biblionumber to $record + MARCkoha2marcOnefield($record,"biblionumber",$biblionumber,"holdings"); + my $sth=$dbh->prepare("select notforloan from itemtypes where itemtype='$itemtype'"); $sth->execute(); my $notforloan=$sth->fetchrow; ##Change the notforloan field if $notforloan found -if ($notforloan >0){ -$item->{'notforloan'}=$notforloan; -&MARCitemchange($dbh,$record,"items.notforloan",$notforloan); -} + if ($notforloan >0){ + $item->{'notforloan'}=$notforloan; + &MARCkoha2marcOnefield($record,"notforloan",$notforloan,"holdings"); + } if(!$item->{'dateaccessioned'}||$item->{'dateaccessioned'} eq ''){ # find today's date my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); $year +=1900; $mon +=1; my $date = "$year-".sprintf ("%0.2d", $mon)."-".sprintf("%0.2d",$mday); $item->{'dateaccessioned'}=$date; -&MARCitemchange($dbh,$record,"items.dateaccessioned",$date); - +&MARCkoha2marcOnefield($record,"dateaccessioned",$date,"holdings"); } - my ( $itemnumber, $error ) = &OLDnewitems( $dbh, $item, $item->{barcode} ); - # add itemnumber to MARC::Record before adding the item. - $sth = - $dbh->prepare( -"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?" - ); - &MARCkoha2marcOnefield( $sth, $record, "items.itemnumber", $itemnumber,$frameworkcode ); + +## Now calculate itempart of cutter +my ($cutterextra)=itemcalculator($dbh,$item->{'biblionumber'},$item->{'itemcallnumber'}); +&MARCkoha2marcOnefield($record,"cutterextra",$cutterextra,"holdings"); + ##NEU specific add cataloguers cardnumber as well -my $cardtag=C4::Context->preference('itemcataloguersubfield'); -if ($cardtag){ -$sth->execute($frameworkcode,"items.itemnumber"); -my ($itemtag,$subtag)=$sth->fetchrow; -my $me= C4::Context->userenv; -my $cataloguer=$me->{'cardnumber'} if ($me); -my $newtag= $record->field($itemtag); -$newtag->update($cardtag=>$cataloguer) if ($me); -$record->delete_field($newtag); -$record->append_fields($newtag); -} - # add the item - my $bib = &MARCadditem( $dbh, $record, $item->{'biblionumber'} ); -} - -sub MARCitemchange { -my ($dbh,$record,$itemfield,$newvalue)=@_; - my ($tagfield, $tagsubfield)=MARCfind_marc_from_kohafield($dbh,$itemfield,""); - if (($tagfield) && ($tagsubfield)) { - my $tag = $record->field($tagfield); - - if ( $tag) { - $tag->update($tagsubfield =>$newvalue); - $record->delete_field($tag); - $record->add_fields($tag); +my ($tag,$cardtag)=MARCfind_marc_from_kohafield("circid","holdings"); + if ($tag && $cardtag){ + my $me= C4::Context->userenv; + my $cataloguer=$me->{'cardnumber'} if ($me); + my $newtag= $record->field($tag); + $newtag->update($cardtag=>$cataloguer) if ($me); + $record->delete_field($newtag); + $record->insert_fields_ordered($newtag); } +##Add item to SQL +my $itemnumber = &OLDnewitems( $dbh, $item->{barcode},$record ); - } -} -sub NEWmoditem { - my ( $dbh, $record, $bibid, $itemnumber, $delete ) = @_; - - &MARCmoditem( $dbh, $record, $bibid, $itemnumber, $delete ); - my $frameworkcode=MARCfind_frameworkcode($dbh,$bibid); - my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode ); - OLDmoditem( $dbh, $olditem ); -} +# add the item to zebra it will add the biblio as well!!! + ZEBRAop( $dbh, $biblionumber,"specialUpdate","biblioserver" ); +return $itemnumber; +}## added new item -sub NEWdelitem { - my ( $dbh, $bibid, $itemnumber ) = @_; - my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); - &OLDdelitem( $dbh, $itemnumber ); - my $newrec=&MARCdelitem( $dbh, $bibid, $itemnumber ); -&MARCaddbiblio($newrec,$bibid,); } -# -# -# OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD -# -# - -=item $biblionumber = OLDnewbiblio($dbh,$biblio); - -adds a record in biblio table. Datas are in the hash $biblio. - -=item $biblionumber = OLDmodbiblio($dbh,$biblio); -modify a record in biblio table. Datas are in the hash $biblio. -=item OLDmodsubtitle($dbh,$bibnum,$subtitle); -modify subtitles in bibliosubtitle table. - -=item OLDmodaddauthor($dbh,$bibnum,$author); +sub NEWmoditem{ + my ( $dbh, $record, $biblionumber, $itemnumber ) = @_; +##Get a hash of this record as well +my $item=MARCmarc2koha($dbh,$record,"holdings"); +##Add itemnumber incase lost (old bug 090c was lost) --just incase +my ( $tagfield, $tagsubfield ) =MARCfind_marc_from_kohafield("itemnumber","holdings"); + my $newfield; +my $old_field = $record->field($tagfield); +if ($tagfield<10){ + $newfield = MARC::Field->new($tagfield, $itemnumber); +}else{ + if ($old_field){ + $old_field->update($tagsubfield=>$biblionumber); + $newfield=$old_field->clone(); + }else{ + $newfield = MARC::Field->new($tagfield, '', '', "$tagsubfield" => $itemnumber); + } +} + # drop old field and create new one... + + $record->delete_field($old_field); + $record->insert_fields_ordered($newfield); +##Add biblionumber incase lost on html +my ( $tagfield, $tagsubfield ) =MARCfind_marc_from_kohafield("biblionumber","holdings"); + my $newfield; +my $old_field = $record->field($tagfield); +if ($tagfield<10){ + $newfield = MARC::Field->new($tagfield, $biblionumber); +}else{ + if ($old_field){ + $old_field->update($tagsubfield=>$biblionumber); + $newfield=$old_field->clone(); + }else{ + $newfield = MARC::Field->new($tagfield, '', '', "$tagsubfield" => $biblionumber); + } +} + # drop old field and create new one... + $record->delete_field($old_field); + $record->insert_fields_ordered($newfield); + +###NEU specific add cataloguers cardnumber as well +my ($tag,$cardtag)=MARCfind_marc_from_kohafield("circid","holdings"); +if ($tag && $cardtag){ +my $me= C4::Context->userenv; +my $cataloger=$me->{'cardnumber'} if ($me); +my $oldtag=$record->field($tag); + if (!$oldtag){ + my $newtag= MARC::Field->new($tag, '', '', $cardtag => $cataloger) if ($me); + $record->insert_fields_ordered($newtag); + }else{ + $oldtag->update($cardtag=>$cataloger) if ($me); + $record->delete_field($oldtag); + $record->insert_fields_ordered($oldtag); + } +} +## We must add the indexing fields for LC Cutter in MARC record in case it changed +my ($cutterextra)=itemcalculator($dbh,$biblionumber,$item->{'itemcallnumber'}); +MARCkoha2marcOnefield($record,"cutterextra",$cutterextra,"holdings"); + OLDmoditem( $dbh, $record,$biblionumber,$itemnumber,$item->{barcode} ); + ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver"); +} -adds or modify additional authors -NOTE : Strange sub : seems to delete MANY and add only ONE author... maybe buggy ? +sub NEWdelitem { + my ( $dbh, $itemnumber ) = @_; + +my $sth=$dbh->prepare("SELECT biblionumber from items where itemnumber=?"); +$sth->execute($itemnumber); +my $biblionumber=$sth->fetchrow; +OLDdelitem( $dbh, $itemnumber ) ; +ZEBRAop($dbh,$biblionumber,"recordDelete","biblioserver"); -=item $errors = OLDmodsubject($dbh,$bibnum, $force, @subject); +} -modify/adds subjects -=item OLDmodbibitem($dbh, $biblioitem); -modify a biblioitem -=item OLDmodnote($dbh,$bibitemnum,$note +sub NEWaddbiblio { + my ( $dbh, $record,$frameworkcode ) = @_; + my $sth = $dbh->prepare("Select max(biblionumber) from biblio"); + $sth->execute; + my $data = $sth->fetchrow; + my $biblionumber = $data + 1; + $sth->finish; + # we must add biblionumber MARC::Record... + my ( $tagfield, $tagsubfield ) =MARCfind_marc_from_kohafield("biblionumber","biblios"); + my $newfield; +if ($tagfield<10){ + $newfield = MARC::Field->new($tagfield, $biblionumber); +}else{ + $newfield = MARC::Field->new($tagfield, '', '', "$tagsubfield" => "$biblionumber"); +} + # drop old field and create new one.. + $record->delete_field($newfield); + $record->insert_fields_ordered($newfield); -modify a note for a biblioitem - -=item OLDnewbiblioitem($dbh,$biblioitem); - -adds a biblioitem ($biblioitem is a hash with the values) - -=item OLDnewsubject($dbh,$bibnum); - -adds a subject - -=item OLDnewsubtitle($dbh,$bibnum,$subtitle); - -create a new subtitle - -=item ($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode); - -create a item. $item is a hash and $barcode the barcode. - -=item OLDmoditem($dbh,$item); - -modify item - -=item OLDdelitem($dbh,$itemnum); - -delete item - -=item OLDdeletebiblioitem($dbh,$biblioitemnumber); - -deletes a biblioitem -NOTE : not standard sub name. Should be OLDdelbiblioitem() - -=item OLDdelbiblio($dbh,$biblio); - -delete a biblio - -=cut - -sub OLDnewbiblio { - my ( $dbh, $biblio ) = @_; - - # my $dbh = &C4Connect; - my $sth = $dbh->prepare("Select max(biblionumber) from biblio"); - $sth->execute; - my $data = $sth->fetchrow_arrayref; - my $bibnum = $$data[0] + 1; - my $series = 0; - - if ( $biblio->{'seriestitle'} ) { $series = 1 } - $sth->finish; - $sth = - $dbh->prepare( -"insert into biblio set biblionumber = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?, unititle = ?" - ); - $sth->execute( - $bibnum, $biblio->{'title'}, - $biblio->{'author'}, $biblio->{'copyrightdate'}, - $biblio->{'serial'}, $biblio->{'seriestitle'}, - $biblio->{'notes'}, $biblio->{'abstract'}, - $biblio->{'unititle'}, - ); - - $sth->finish; - - # $dbh->disconnect; - return ($bibnum); +###NEU specific add cataloguers cardnumber as well +my ($tag,$cardtag)=MARCfind_marc_from_kohafield("indexedby","biblios"); +if ($tag && $cardtag){ +my $me= C4::Context->userenv; +my $cataloger=$me->{'cardnumber'} if ($me); +my $oldtag=$record->field($tag); + if (!$oldtag){ + my $newtag= MARC::Field->new($tag, '', '', $cardtag => $cataloger) if ($me); + $record->insert_fields_ordered($newtag); + }else{ + $oldtag->update($cardtag=>$cataloger) if ($me); + $record->delete_field($oldtag); + $record->insert_fields_ordered($oldtag); + } } +## We must add the indexing fields for LC in MARC record--TG + &MARCmodLCindex($dbh,$record); + +##Find itemtype + ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("itemtype","biblios"); +my $itemtype=$record->field($tagfield)->subfield($tagsubfield) if ($record->field($tagfield)); +##Find ISBN +($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("isbn","biblios") ; +my $isbn=$record->field($tagfield)->subfield($tagsubfield) if ($record->field($tagfield)); +##Find ISSN +($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("issn","biblios") ; +my $issn=$record->field($tagfield)->subfield($tagsubfield) if ($record->field($tagfield)); + $sth = $dbh->prepare("insert into biblio set biblionumber = ?, marc = ?, frameworkcode=?, itemtype=?,marcxml=?,title=?,author=?,isbn=?,issn=?" ); + $sth->execute( $biblionumber, $record->as_usmarc,$frameworkcode, $itemtype,MARC::File::XML::record( $record ) ,$record->title(),$record->author,$isbn,$issn ); -sub OLDmodbiblio { - my ( $dbh, $biblio ) = @_; - - # my $dbh = C4Connect; - my $query; - my $sth; - - $query = ""; - $sth = - $dbh->prepare( -"Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?" - ); - $sth->execute( - $biblio->{'title'}, $biblio->{'author'}, - $biblio->{'abstract'}, $biblio->{'copyrightdate'}, - $biblio->{'seriestitle'}, $biblio->{'serial'}, - $biblio->{'unititle'}, $biblio->{'notes'}, - $biblio->{'biblionumber'} - ); - - $sth->finish; - return ( $biblio->{'biblionumber'} ); -} # sub modbiblio - -sub OLDmodsubtitle { - my ( $dbh, $bibnum, $subtitle ) = @_; - my $sth = - $dbh->prepare( - "update bibliosubtitle set subtitle = ? where biblionumber = ?"); - $sth->execute( $subtitle, $bibnum ); - $sth->finish; -} # sub modsubtitle - -sub OLDmodaddauthor { - my ( $dbh, $bibnum, @authors ) = @_; - - # my $dbh = C4Connect; - my $sth = - $dbh->prepare("Delete from additionalauthors where biblionumber = ?"); - - $sth->execute($bibnum); - $sth->finish; - foreach my $author (@authors) { - if ( $author ne '' ) { - $sth = - $dbh->prepare( - "Insert into additionalauthors set author = ?, biblionumber = ?" - ); - - $sth->execute( $author, $bibnum ); - - $sth->finish; - } # if - } -} # sub modaddauthor - -sub OLDmodsubject { - my ( $dbh, $bibnum, $force, @subject ) = @_; - - # my $dbh = C4Connect; - my $count = @subject; - my $error; - for ( my $i = 0 ; $i < $count ; $i++ ) { - $subject[$i] =~ s/^ //g; - $subject[$i] =~ s/ $//g; - my $sth = - $dbh->prepare( -"select * from catalogueentry where entrytype = 's' and catalogueentry = ?" - ); - $sth->execute( $subject[$i] ); - - if ( my $data = $sth->fetchrow_hashref ) { - } - else { - if ( $force eq $subject[$i] || $force == 1 ) { - - # subject not in aut, chosen to force anway - # so insert into cataloguentry so its in auth file - my $sth2 = - $dbh->prepare( -"Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)" - ); - - $sth2->execute( $subject[$i] ) if ( $subject[$i] ); - $sth2->finish; - } - else { - $error = - "$subject[$i]\n does not exist in the subject authority file"; - my $sth2 = - $dbh->prepare( -"Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)" - ); - $sth2->execute( "$subject[$i] %", "% $subject[$i] %", - "% $subject[$i]" ); - while ( my $data = $sth2->fetchrow_hashref ) { - $error .= "
$data->{'catalogueentry'}"; - } # while - $sth2->finish; - } # else - } # else - $sth->finish; - } # else - if ( $error eq '' ) { - my $sth = - $dbh->prepare("Delete from bibliosubject where biblionumber = ?"); - $sth->execute($bibnum); - $sth->finish; - $sth = - $dbh->prepare( - "Insert into bibliosubject (subject,biblionumber) values (?,?)"); - my $query; - foreach $query (@subject) { - $sth->execute( $query, $bibnum ) if ( $query && $bibnum ); - } # foreach - $sth->finish; - } # if - - # $dbh->disconnect; - return ($error); -} # sub modsubject - -sub OLDmodbibitem { - my ( $dbh, $biblioitem ) = @_; - my $dbh = C4::Context->dbh; # FIXME unused to pass $dbh n input arg. - my $query; -##Recalculate LC in case it changed --TG - - $biblioitem->{'itemtype'} = $dbh->quote( $biblioitem->{'itemtype'} ); - $biblioitem->{'url'} = $dbh->quote( $biblioitem->{'url'} ); - $biblioitem->{'isbn'} = $dbh->quote( $biblioitem->{'isbn'} ); - $biblioitem->{'issn'} = $dbh->quote( $biblioitem->{'issn'} ); - $biblioitem->{'publishercode'} = $dbh->quote( $biblioitem->{'publishercode'} ); - $biblioitem->{'publicationyear'} = $dbh->quote( $biblioitem->{'publicationyear'} ); - $biblioitem->{'classification'} = $dbh->quote( $biblioitem->{'classification'} ); - $biblioitem->{'dewey'} = $dbh->quote( $biblioitem->{'dewey'} ); - $biblioitem->{'subclass'} = $dbh->quote( $biblioitem->{'subclass'} ); - $biblioitem->{'illus'} = $dbh->quote( $biblioitem->{'illus'} ); - $biblioitem->{'pages'} = $dbh->quote( $biblioitem->{'pages'} ); - $biblioitem->{'volumeddesc'} = $dbh->quote( $biblioitem->{'volumeddesc'} ); - $biblioitem->{'bnotes'} = $dbh->quote( $biblioitem->{'bnotes'} ); - $biblioitem->{'size'} = $dbh->quote( $biblioitem->{'size'} ); - $biblioitem->{'place'} = $dbh->quote( $biblioitem->{'place'} ); - - my ($lcsort) = calculatelc($biblioitem->{'classification'}).$biblioitem->{'subclass'}; - $lcsort = "NULL"; -# $lcsort=$dbh->quote($lcsort); - - $query = " - UPDATE biblioitems SET - itemtype = ".$biblioitem->{'itemtype'}.", - url = ".$biblioitem->{'url'}.", - isbn = ".$biblioitem->{'isbn'}.", - issn = ".$biblioitem->{'issn'}.", - publishercode = ".$biblioitem->{'publishercode'}.", - publicationyear = ".$biblioitem->{'publicationyear'}.", - classification = ".$biblioitem->{'classification'}.", - dewey = ".$biblioitem->{'dewey'}.", - subclass = ".$biblioitem->{'subclass'}.", - illus = ".$biblioitem->{'illus'}.", - pages = ".$biblioitem->{'pages'}.", - volumeddesc = ".$biblioitem->{'volumeddesc'}.", - notes = ".$biblioitem->{'bnotes'}.", - size = ".$biblioitem->{'size'}.", - place = ".$biblioitem->{'place'}.", - lcsort = ".$lcsort.""; - # where biblionumber = ".$biblioitem->{'biblionumber'}." - #"; - - my $sth = $dbh->prepare($query); - $sth->execute; - - if ( $dbh->errstr ) { - warn "[error]=> $query"; - } - -} # sub modbibitem - -sub OLDmodnote { - my ( $dbh, $bibitemnum, $note ) = @_; - - # my $dbh=C4Connect; - my $query = "update biblioitems set notes='$note' where - biblioitemnumber='$bibitemnum'"; - my $sth = $dbh->prepare($query); - $sth->execute; $sth->finish; - - # $dbh->disconnect; +### Do not add biblio to ZEBRA unless there is an item with it -- depends on system preference defaults to NO +if (C4::Context->preference('AddaloneBiblios')){ + ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver"); +} + return ($biblionumber); } -sub OLDnewbiblioitem { - my ( $dbh, $biblioitem ) = @_; - - # my $dbh = C4Connect; - my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems"); - my $data; - my $bibitemnum; - - $sth->execute; - $data = $sth->fetchrow_arrayref; - $bibitemnum = $$data[0] + 1; - - $sth->finish; - - $sth = $dbh->prepare( "insert into biblioitems set - biblioitemnumber = ?, biblionumber = ?, - volume = ?, number = ?, - classification = ?, itemtype = ?, - url = ?, isbn = ?, - issn = ?, dewey = ?, - subclass = ?, publicationyear = ?, - publishercode = ?, volumedate = ?, - volumeddesc = ?, illus = ?, - pages = ?, notes = ?, - size = ?, lccn = ?, - marc = ?, - - place = ?, lcsort=? - " - ); -my ($lcsort)=calculatelc($biblioitem->{'classification'}).$biblioitem->{'subclass'}; - $sth->execute( - $bibitemnum, $biblioitem->{'biblionumber'}, - $biblioitem->{'volume'}, $biblioitem->{'number'}, - $biblioitem->{'classification'}, $biblioitem->{'itemtype'}, - $biblioitem->{'url'}, $biblioitem->{'isbn'}, - $biblioitem->{'issn'}, $biblioitem->{'dewey'}, - $biblioitem->{'subclass'}, $biblioitem->{'publicationyear'}, - $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'}, - $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'}, - $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, - $biblioitem->{'size'}, $biblioitem->{'lccn'}, - $biblioitem->{'marc'}, $biblioitem->{'place'},$lcsort - ); - $sth->finish; +sub NEWmodbiblio { + my ( $dbh, $biblionumber,$record,$frameworkcode ) = @_; +##Add biblionumber incase lost on html +my ( $tagfield, $tagsubfield ) =MARCfind_marc_from_kohafield("biblionumber","biblios"); + my $newfield; +if ($tagfield<10){ + $newfield = MARC::Field->new($tagfield, $biblionumber); +}else{ + $newfield = MARC::Field->new($tagfield, '', '', "$tagsubfield" => $biblionumber); +} + # drop old field and create new one... + my $old_field = $record->field($tagfield); + $record->delete_field($old_field); + $record->insert_fields_ordered($newfield); - # $dbh->disconnect; - return ($bibitemnum); +###NEU specific add cataloguers cardnumber as well +my ($tag,$cardtag)=MARCfind_marc_from_kohafield("indexedby","biblios"); +if ($tag && $cardtag){ +my $me= C4::Context->userenv; +my $cataloger=$me->{'cardnumber'} if ($me); +my $oldtag=$record->field($tag); + if (!$oldtag){ + my $newtag= MARC::Field->new($tag, '', '', $cardtag => $cataloger) if ($me); + $record->insert_fields_ordered($newtag); + }else{ + $oldtag->update($cardtag=>$cataloger) if ($me); + $record->delete_field($oldtag); + $record->insert_fields_ordered($oldtag); + } } - -sub OLDnewsubject { - my ( $dbh, $bibnum ) = @_; - my $sth = - $dbh->prepare("insert into bibliosubject (biblionumber) values (?)"); - $sth->execute($bibnum); - $sth->finish; +## We must add the indexing fields for LC in MARC record--TG + MARCmodLCindex($dbh,$record); + OLDmodbiblio ($dbh,$record,$biblionumber,$frameworkcode); + my $ok=ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver"); + return ($biblionumber); } -sub OLDnewsubtitle { - my ( $dbh, $bibnum, $subtitle ) = @_; - my $sth = - $dbh->prepare( - "insert into bibliosubtitle set biblionumber = ?, subtitle = ?"); - $sth->execute( $bibnum, $subtitle ) if $subtitle; - $sth->finish; -} +# +# +# OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD +# +# sub OLDnewitems { - my ( $dbh, $item, $barcode ) = @_; - # my $dbh = C4Connect; - my $sth = $dbh->prepare("Select max(itemnumber) from items"); + my ( $dbh, $barcode,$record) = @_; + my $sth = $dbh->prepare("SELECT max(itemnumber) from items"); my $data; my $itemnumber; - my $error = ""; - $sth->execute; $data = $sth->fetchrow_hashref; $itemnumber = $data->{'max(itemnumber)'} + 1; $sth->finish; - $sth->finish; -## Now calculate lccalnumber -my ($cutterextra)=itemcalculator($dbh,$item->{'biblioitemnumber'},$item->{'itemcallnumber'}); -# FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix. - if ( $item->{'loan'} ) { - $item->{'notforloan'} = $item->{'loan'}; - } - - # if dateaccessioned is provided, use it. Otherwise, set to NOW() - if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) { - - $sth = $dbh->prepare( "Insert into items set - itemnumber = ?, biblionumber = ?, - multivolumepart = ?, - biblioitemnumber = ?, barcode = ?, - booksellerid = ?, dateaccessioned = NOW(), - homebranch = ?, holdingbranch = ?, - price = ?, replacementprice = ?, - replacementpricedate = NOW(), datelastseen = NOW(), - multivolume = ?, stack = ?, - itemlost = ?, wthdrawn = ?, - paidfor = ?, itemnotes = ?, - itemcallnumber =?, notforloan = ?, - location = ?, - Cutterextra=? - " - ); - $sth->execute( - $itemnumber, $item->{'biblionumber'}, - $item->{'multivolumepart'}, - $item->{'biblioitemnumber'},$barcode, - $item->{'booksellerid'}, - $item->{'homebranch'}, $item->{'holdingbranch'}, - $item->{'price'}, $item->{'replacementprice'}, - $item->{multivolume}, $item->{stack}, - $item->{itemlost}, $item->{wthdrawn}, - $item->{paidfor}, $item->{'itemnotes'}, - $item->{'itemcallnumber'}, $item->{'notforloan'}, - $item->{'location'},$cutterextra - ); - } - else { - $sth = $dbh->prepare( "Insert into items set - itemnumber = ?, biblionumber = ?, - multivolumepart = ?, - biblioitemnumber = ?, barcode = ?, - booksellerid = ?, dateaccessioned = ?, - homebranch = ?, holdingbranch = ?, - price = ?, replacementprice = ?, - replacementpricedate = NOW(), datelastseen = NOW(), - multivolume = ?, stack = ?, - itemlost = ?, wthdrawn = ?, - paidfor = ?, itemnotes = ?, - itemcallnumber =?, notforloan = ?, - location = ?, - Cutterextra=? - " - ); - $sth->execute( - $itemnumber, $item->{'biblionumber'}, - $item->{'multivolumepart'}, - $item->{'biblioitemnumber'},$barcode, - $item->{'booksellerid'}, $item->{'dateaccessioned'}, - $item->{'homebranch'}, $item->{'holdingbranch'}, - $item->{'price'}, $item->{'replacementprice'}, - $item->{multivolume}, $item->{stack}, - $item->{itemlost}, $item->{wthdrawn}, - $item->{paidfor}, $item->{'itemnotes'}, - $item->{'itemcallnumber'}, $item->{'notforloan'}, - $item->{'location'},$cutterextra - ); - } - if ( defined $sth->errstr ) { - $error .= $sth->errstr; - } + &MARCkoha2marcOnefield( $record, "itemnumber", $itemnumber,"holdings" ); + my ($biblionumbertag,$subf)=MARCfind_marc_from_kohafield( "biblionumber","holdings"); - return ( $itemnumber, $error ); +my $biblionumber; + if ($biblionumbertag <10){ + $biblionumber=$record->field($biblionumbertag)->data(); + }else{ + $biblionumber=$record->field($biblionumbertag)->subfield($subf); + } + $sth = $dbh->prepare( "Insert into items set itemnumber = ?, biblionumber = ?,barcode = ?,marc=? ,marcxml=?" ); + $sth->execute($itemnumber,$biblionumber,$barcode,$record->as_usmarc(),MARC::File::XML::record( $record)); + return $itemnumber; } sub OLDmoditem { - my ( $dbh, $item ) = @_; - $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'}; - -## Now calculate lccalnumber -my ($cutterextra)=itemcalculator($dbh,$item->{'bibitemnum'},$item->{'itemcallnumber'}); - my $query = "update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,homebranch=?,cutterextra=?, onloan=?"; - my @bind = ( - $item->{'barcode'}, $item->{'notes'}, - $item->{'itemcallnumber'}, $item->{'notforloan'}, - $item->{'location'}, $item->{multivolumepart}, - $item->{multivolume}, $item->{stack}, - $item->{wthdrawn},$item->{holdingbranch},$item->{homebranch},$cutterextra,$item->{onloan} - ); - if ( $item->{'lost'} ne '' ) { - $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?, - itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?, - location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,cutterextra=?,onloan=?"; - @bind = ( - $item->{'bibitemnum'}, $item->{'barcode'}, - $item->{'notes'}, $item->{'homebranch'}, - $item->{'lost'}, $item->{'wthdrawn'}, - $item->{'itemcallnumber'}, $item->{'notforloan'}, - $item->{'location'}, $item->{multivolumepart}, - $item->{multivolume}, $item->{stack}, - $item->{wthdrawn},$item->{holdingbranch},$cutterextra,$item->{onloan} - ); -# if ($item->{homebranch}) { -# $query.=",homebranch=?"; -# push @bind, $item->{homebranch}; -# } -# if ($item->{holdingbranch}) { -# $query.=",holdingbranch=?"; -# push @bind, $item->{holdingbranch}; -# } - } - $query.=" where itemnumber=?"; - push @bind,$item->{'itemnum'}; - if ( $item->{'replacement'} ne '' ) { - $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/; - } - my $sth = $dbh->prepare($query); - $sth->execute(@bind); + my ( $dbh, $record,$biblionumber,$itemnumber,$barcode ) = @_; + my $sth =$dbh->prepare("replace items set biblionumber=?,marc=?,marcxml=?,barcode=? , itemnumber=?"); + $sth->execute($biblionumber,$record->as_usmarc(),MARC::File::XML::record( $record),$barcode,$itemnumber); $sth->finish; - - # $dbh->disconnect; } sub OLDdelitem { - my ( $dbh, $itemnum ) = @_; + my ( $dbh, $itemnumber ) = @_; +my $sth = $dbh->prepare("select * from items where itemnumber=?"); + $sth->execute($itemnumber); + if ( my $data = $sth->fetchrow_hashref ) { + $sth->finish; + my $query = "replace deleteditems set "; + my @bind = (); + foreach my $temp ( keys %$data ) { + $query .= "$temp = ?,"; + push ( @bind, $data->{$temp} ); + } - # my $dbh=C4Connect; - my $sth = $dbh->prepare("select * from items where itemnumber=?"); - $sth->execute($itemnum); - my $data = $sth->fetchrow_hashref; - $sth->finish; - my $query = "Insert into deleteditems set "; - my @bind = (); - foreach my $temp ( keys %$data ) { - $query .= "$temp = ?,"; - push ( @bind, $data->{$temp} ); - } - $query =~ s/\,$//; - - # print $query; - $sth = $dbh->prepare($query); -# $sth->execute(@bind); -# $sth->finish; - $sth = $dbh->prepare("Delete from items where itemnumber=?"); - $sth->execute($itemnum); + #replacing the last , by ",?)" + $query =~ s/\,$//; + $sth = $dbh->prepare($query); + $sth->execute(@bind); + $sth->finish; + $sth = $dbh->prepare("Delete from items where itemnumber=?"); + $sth->execute($itemnumber); $sth->finish; - - # $dbh->disconnect; + } + $sth->finish; } -sub OLDdeletebiblioitem { - my ( $dbh, $biblioitemnumber ) = @_; - - # my $dbh = C4Connect; - my $sth = $dbh->prepare( "Select * from biblioitems -where biblioitemnumber = ?" - ); - my $results; - - $sth->execute($biblioitemnumber); - - if ( $results = $sth->fetchrow_hashref ) { +sub OLDmodbiblio { +# modifies the biblio table +my ($dbh,$record,$biblionumber,$frameworkcode) = @_; + if (!$frameworkcode){ + $frameworkcode=""; + } +my ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("itemtype","biblios"); +my $itemtype=$record->field($tagfield)->subfield($tagsubfield) if ($record->field($tagfield)); +my ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("isbn","biblios"); +my $isbn=$record->field($tagfield)->subfield($tagsubfield) if ($record->field($tagfield)); +my ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("issn","biblios"); +my $issn=$record->field($tagfield)->subfield($tagsubfield) if ($record->field($tagfield)); +$isbn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g; +$issn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g; +$isbn=~s/^\s+|\s+$//g; +$isbn=substr($isbn,0,13); + my $sth = $dbh->prepare("REPLACE biblio set biblionumber=?,marc=?,marcxml=?,frameworkcode=? ,itemtype=? , title=?,author=?,isbn=?,issn=?" ); + $sth->execute( $biblionumber,$record->as_usmarc() ,MARC::File::XML::record( $record), $frameworkcode,$itemtype, $record->title(),$record->author(),$isbn,$issn); $sth->finish; - $sth = - $dbh->prepare( -"Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype, - isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus , - pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" - ); - - $sth->execute( - $results->{biblioitemnumber}, $results->{biblionumber}, - $results->{volume}, $results->{number}, - $results->{classification}, $results->{itemtype}, - $results->{isbn}, $results->{issn}, - $results->{dewey}, $results->{subclass}, - $results->{publicationyear}, $results->{publishercode}, - $results->{volumedate}, $results->{volumeddesc}, - $results->{timestamp}, $results->{illus}, - $results->{pages}, $results->{notes}, - $results->{size}, $results->{url}, - $results->{lccn} - ); - my $sth2 = - $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?"); - $sth2->execute($biblioitemnumber); - $sth2->finish(); - } # if - $sth->finish; - - # Now delete all the items attached to the biblioitem - $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?"); - $sth->execute($biblioitemnumber); - my @results; -# while ( my $data = $sth->fetchrow_hashref ) { -# my $query = "Insert into deleteditems set "; -# my @bind = (); -# foreach my $temp ( keys %$data ) { -# $query .= "$temp = ?,"; -# push ( @bind, $data->{$temp} ); -# } -# $query =~ s/\,$//; -# my $sth2 = $dbh->prepare($query); -# $sth2->execute(@bind); -# } # while - $sth->finish; - $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?"); - $sth->execute($biblioitemnumber); - $sth->finish(); - - # $dbh->disconnect; -} # sub deletebiblioitem + return $biblionumber; +} sub OLDdelbiblio { - my ( $dbh, $biblio ) = @_; + my ( $dbh, $biblionumber ) = @_; my $sth = $dbh->prepare("select * from biblio where biblionumber=?"); - $sth->execute($biblio); + $sth->execute($biblionumber); if ( my $data = $sth->fetchrow_hashref ) { $sth->finish; - my $query = "Insert into deletedbiblio set "; + my $query = "replace deletedbiblio set "; my @bind = (); - foreach my $temp ( keys %$data ) { + foreach my $temp ( keys %$data ) { $query .= "$temp = ?,"; push ( @bind, $data->{$temp} ); - } + } #replacing the last , by ",?)" $query =~ s/\,$//; @@ -2098,412 +1256,210 @@ sub OLDdelbiblio { $sth->execute(@bind); $sth->finish; $sth = $dbh->prepare("Delete from biblio where biblionumber=?"); - $sth->execute($biblio); + $sth->execute($biblionumber); $sth->finish; } $sth->finish; } + # # -# old functions +# +#ZEBRA ZEBRA ZEBRA # # -sub itemcount { - my ($biblio) = @_; - my $dbh = C4::Context->dbh; - - # print $query; - my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?"); - $sth->execute($biblio); - my $data = $sth->fetchrow_hashref; - $sth->finish; - return ( $data->{'count(*)'} ); +sub ZEBRAopfiles{ +##Utility function to write an xml file to disk when the zebra server goes down +my ($dbh,$biblionumber,$record,$folder,$server)=@_; +#my $record = XMLgetbiblio($dbh,$biblionumber); +my $op; +my $zebradir = C4::Context->zebraconfig($server)->{directory}."/".$folder."/"; +my $zebraroot=C4::Context->zebraconfig($server)->{directory}; +my $serverbase=C4::Context->config($server); + unless (opendir(DIR, "$zebradir")) { +# warn "$zebradir not found"; + return; + } + closedir DIR; + my $filename = $zebradir.$biblionumber; +if ($record){ + open (OUTPUT,">", $filename.".xml"); + print OUTPUT $record; + close OUTPUT; } -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($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. +sub ZEBRAop { +### Puts the zebra update in queue writes in zebraserver table +my ($dbh,$biblionumber,$op,$server)=@_; +my ($record); -C<&modbiblio> updates the record defined by -C<$biblio-E{biblionumber}> with the values in C<$biblio>. - -C<&modbiblio> returns C<$biblio-E{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($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, @authors ) = @_; - my $dbh = C4::Context->dbh; - &OLDmodaddauthor( $dbh, $bibnum, @authors ); -} # sub modaddauthor - -=item modsubject +my $sth=$dbh->prepare("insert into zebraqueue (biblio_auth_number ,server,operation) values(?,?,?)"); +$sth->execute($biblionumber,$server,$op); +} - $error = &modsubject($biblionumber, $force, @subjects); -$force - a subject to force +sub ZEBRAopserver{ -$error - Error message, or undef if successful. +###Accepts a $server variable thus we can use it to update biblios, authorities or other zebra dbs +my ($record,$op,$server)=@_; +my @Zconnbiblio; +my @port; +my $Zpackage; +my $tried=0; +my $recon=0; +my $reconnect=0; +$record=Encode::encode("UTF-8",$record); +my $shadow=$server."shadow"; +reconnect: -=cut +$Zconnbiblio[0]=C4::Context->Zconnauth($server); +if ($record){ +my $Zpackage = $Zconnbiblio[0]->package(); +$Zpackage->option(action => $op); + $Zpackage->option(record => $record); +retry: + $Zpackage->send("update"); +my $i; +my $event; -sub modsubject { - my ( $bibnum, $force, @subject ) = @_; - my $dbh = C4::Context->dbh; - my $error = &OLDmodsubject( $dbh, $bibnum, $force, @subject ); - if ($error eq ''){ - # When MARC is off, ensures that the MARC biblio table gets updated with new - # subjects, of course, it deletes the biblio in marc, and then recreates. - # This check is to ensure that no MARC data exists to lose. - if (C4::Context->preference("MARC") eq '0'){ - my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum); - my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum); - &MARCmodbiblio($bibid, $MARCRecord); - } +while (($i = ZOOM::event(\@Zconnbiblio)) != 0) { + $event = $Zconnbiblio[0]->last_event(); + last if $event == ZOOM::Event::ZEND; +} + my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio[0]->error_x(); + if ($error==10007 && $tried<3) {## timeout --another 30 looonng seconds for this update + sleep 1; ## wait a sec! + $tried=$tried+1; + goto "retry"; + }elsif ($error==2 && $tried<2) {## timeout --temporary zebra error !whatever that means + sleep 2; ## wait two seconds! + $tried=$tried+1; + goto "retry"; + }elsif($error==10004 && $recon==0){##Lost connection -reconnect + sleep 1; ## wait a sec! + $recon=1; + $Zpackage->destroy(); + $Zconnbiblio[0]->destroy(); + goto "reconnect"; + }elsif ($error){ + # warn "Error-$server $op /errcode:, $error, /MSG:,$errmsg,$addinfo \n"; + $Zpackage->destroy(); + $Zconnbiblio[0]->destroy(); + # ZEBRAopfiles($dbh,$biblionumber,$record,$op,$server); + return 0; } - 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 ); + ## System preference batchMode=1 means wea are bulk importing + ## DO NOT COMMIT while in batchMode for faster operation + my $batchmode=C4::Context->preference('batchMode'); + if (C4::Context->$shadow >0 && !$batchmode){ + $Zpackage->send('commit'); + while (($i = ZOOM::event(\@Zconnbiblio)) != 0) { + $event = $Zconnbiblio[0]->last_event(); + last if $event == ZOOM::Event::ZEND; + } + my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio[0]->error_x(); + if ($error) { ## This is serious ZEBRA server is not updating + $Zpackage->destroy(); + $Zconnbiblio[0]->destroy(); + return 0; + } + }##commit +# +$Zpackage->destroy(); +$Zconnbiblio[0]->destroy(); +return 1; +} +return 0; } -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 - &MARCaddbiblio($MARCbiblio, $biblioitem->{biblionumber}, '' ); - return ($bibitemnum); +sub ZEBRA_readyXML{ +my ($dbh,$biblionumber)=@_; +my $biblioxml=XMLgetbiblio($dbh,$biblionumber); +my @itemxml=XMLgetallitems($dbh,$biblionumber); +my $zebraxml=collection_header(); +$zebraxml.=""; +$zebraxml.=$biblioxml; +$zebraxml.=""; + foreach my $item(@itemxml){ + $zebraxml.=$item if $item; + } +$zebraxml.=""; +$zebraxml.=""; +$zebraxml.=""; +return $zebraxml; } -sub newsubject { - my ($bibnum) = @_; - my $dbh = C4::Context->dbh; - &OLDnewsubject( $dbh, $bibnum ); +sub ZEBRA_readyXML_noheader{ +my ($dbh,$biblionumber)=@_; +my $biblioxml=XMLgetbiblio($dbh,$biblionumber); +my @itemxml=XMLgetallitems($dbh,$biblionumber); +my $zebraxml=""; +$zebraxml.=$biblioxml; +$zebraxml.=""; + foreach my $item(@itemxml){ + $zebraxml.=$item if $item; + } +$zebraxml.=""; +$zebraxml.=""; +return $zebraxml; } -sub newsubtitle { - my ( $bibnum, $subtitle ) = @_; - my $dbh = C4::Context->dbh; - &OLDnewsubtitle( $dbh, $bibnum, $subtitle ); +# +# +# various utility subs and those not complying to new rules +# +# + +sub newbiblio { +## Used in acqui management -- creates the biblio from hash rather than marc-record + my ($biblio) = @_; + my $dbh = C4::Context->dbh; +my $record=MARCkoha2marc($dbh,$biblio,"biblios"); +$record->encoding('UTF-8'); + my $biblionumber=NEWnewbiblio($dbh,$record); + return ($biblionumber); +} +sub modbiblio { +## Used in acqui management -- modifies the biblio from hash rather than marc-record + my ($biblio) = @_; + my $dbh = C4::Context->dbh; +my $record=MARCkoha2marc($dbh,$biblio,"biblios"); + my $biblionumber=NEWmodbiblio($dbh,$record,$biblio->{biblionumber}); + return ($biblionumber); } sub newitems { +## Used in acqui management -- creates the item from hash rather than marc-record 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; - my $sth = $dbh->prepare("Select * from items where barcode=?"); - for ( my $i = 0 ; $i < $count ; $i++ ) { - $barcodes[$i] = uc $barcodes[$i]; - $sth->execute( $barcodes[$i] ); - 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 = ""; - my $sth = - $dbh->prepare("Select count(*) from items where biblioitemnumber=?"); - $sth->execute($bibitemnum); - 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 ); -} - -=item GetBiblioItemByBiblioNumber - -NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration. - -=cut - -sub GetBiblioItemByBiblioNumber { - my ($biblionumber) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?"); - my $count = 0; - my @results; - - $sth->execute($biblionumber); - - while ( my $data = $sth->fetchrow_hashref ) { - push @results, $data; + $item->{barcode}=$barcode; +my $record=MARCkoha2marc($dbh,$item,"holdings"); + my $itemnumber= NEWnewitem($dbh,$record,$item->{biblionumber}); + } - - $sth->finish; - return @results; + return $itemnumber ; } -=head2 getbibliofromitemnumber - - $item = &getbibliofromitemnumber($env, $dbh, $itemnumber); - -Looks up the item with the given itemnumber. - -C<$env> and C<$dbh> are ignored. - -C<&itemnodata> returns a reference-to-hash whose keys are the fields -from the C, C, and C tables in the Koha -database. - -=cut -#' -sub getbibliofromitemnumber { - my ($env,$dbh,$itemnumber) = @_; - $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Select * from biblio,items,biblioitems - where items.itemnumber = ? - and biblio.biblionumber = items.biblionumber - and biblioitems.biblioitemnumber = items.biblioitemnumber"); -# print $query; - $sth->execute($itemnumber); - my $data=$sth->fetchrow_hashref; - $sth->finish; - return($data); -} - -sub getbiblio { - my ($biblionumber) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?"); - - # || die "Cannot prepare $query\n" . $dbh->errstr; - my $count = 0; - my @results; - - $sth->execute($biblionumber); - - # || 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 $sth = $dbh->prepare( "Select * from biblioitems where -biblioitemnumber = ?" - ); - my $count = 0; - my @results; - $sth->execute($biblioitemnum); - - 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 $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?"); - my $count = 0; - my @results; - - $sth->execute($biblionumber); - - while ( my $data = $sth->fetchrow_hashref ) { - $results[$count] = $data; - $count++; - } # while - - $sth->finish; - return ( $count, @results ); -} # sub - -=head2 getitemtypes - -FIXME :: do not use this function : use C4::Koha::GetItemTypes; - -=cut 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 @results; - - $sth->execute; - - # || die "Cannot execute $query\n" . $sth->errstr; - while ( my $data = $sth->fetchrow_hashref ) { - push @results, $data; - } # while - - $sth->finish; - return @results; -} # sub getitemtypes - -sub getstacks{ - my $dbh = C4::Context->dbh; - my $i=0; -my @results; -my $stackstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.stack"'); - $stackstatus->execute; - - my ($authorised_valuecode) = $stackstatus->fetchrow; - if ($authorised_valuecode) { - $stackstatus = $dbh->prepare("select * from authorised_values where category=? "); - $stackstatus->execute($authorised_valuecode); - - while (my $data = $stackstatus->fetchrow_hashref){ - $results[$i]=$data; - $i++; - }#while - }#if -$stackstatus->finish; - return ( $i, @results ); - -} - -sub getitemsbybiblioitem { - my ($biblioitemnum) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( "Select * from items, biblio where -biblio.biblionumber = items.biblionumber and biblioitemnumber -= ?" - ); - - # || die "Cannot prepare $query\n" . $dbh->errstr; + # || die "Cannot prepare $query" . $dbh->errstr; my $count = 0; my @results; - - $sth->execute($biblioitemnum); - + $sth->execute; # || die "Cannot execute $query\n" . $sth->errstr; while ( my $data = $sth->fetchrow_hashref ) { $results[$count] = $data; @@ -2512,309 +1468,37 @@ biblio.biblionumber = items.biblionumber and biblioitemnumber $sth->finish; return ( $count, @results ); -} # sub getitemsbybiblioitem - - -=head2 get_itemnumbers_of - - my @itemnumbers_of = get_itemnumbers_of(@biblionumbers); - -Given a list of biblionumbers, return the list of corresponding itemnumbers -for each biblionumber. - -Return a reference on a hash where keys are biblionumbers and values are -references on array of itemnumbers. - -=cut -sub get_itemnumbers_of { - my @biblionumbers = @_; - - my $dbh = C4::Context->dbh; - - my $query = ' -SELECT itemnumber, - biblionumber - FROM items - WHERE biblionumber IN (?'.(',?' x scalar @biblionumbers - 1).') -'; - my $sth = $dbh->prepare($query); - $sth->execute(@biblionumbers); - - my %itemnumbers_of; - - while (my ($itemnumber, $biblionumber) = $sth->fetchrow_array) { - push @{$itemnumbers_of{$biblionumber}}, $itemnumber; - } - - return \%itemnumbers_of; -} - +} # sub getitemtypes -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"; - } +sub getkohafields{ +#returns MySQL like fieldnames to emulate searches on sql like fieldnames +my $type=@_; +## Either opac or intranet to select appropriate fields +## Assumes intranet +$type="intra" unless $type; +if ($type eq "intranet"){ $type="intra";} +my $dbh = C4::Context->dbh; + my $i=0; +my @results; +$type=$type."show"; +my $sth=$dbh->prepare("SELECT * FROM koha_attr where $type=1 order by liblibrarian"); +$sth->execute(); +while (my $data=$sth->fetchrow_hashref){ + $results[$i]=$data; + $i++; + } +$sth->finish; +return ($i,@results); } -#------------------------------------------------ - -#--------------------------------------- -# 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 "
Looking for biblio
\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 "
Biblio exists with number $biblionumber
\n" if $debug; - } - else { - - # Doesn't exist. Add new one. - print "
Adding biblio
\n" if $debug; - ( $biblionumber, $error ) = &newbiblio($biblio); - if ($biblionumber) { - print "
Added with biblio number=$biblionumber
\n" - if $debug; - if ( $biblio->{subtitle} ) { - &newsubtitle( $biblionumber, $biblio->{subtitle} ); - } # if subtitle - } - else { - print "
Couldn't add biblio: $error
\n" if $debug; - } # if added - } - - return $biblionumber, $error; - -} # sub getoraddbiblio - -sub char_decode { - - # converts ISO 5426 coded string to UTF-8 - # 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\x41/Ä/gm; - s/\xc8\x45/Ë/gm; - s/\xc8\x49/Ï/gm; - s/\xc8\x61/ä/gm; - s/\xc8\x65/ë/gm; - s/\xc8\x69/ï/gm; - s/\xc8\x6F/ö/gm; - s/\xc8\x75/ü/gm; - s/\xc8\x76/ÿ/gm; - s/\xc9\x41/Ä/gm; - s/\xc9\x45/Ë/gm; - s/\xc9\x49/Ï/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" ) { - ##MARC-8 to UTF-8 - - 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/\xe6\x41/Ă/gm; - s/\xe6\x45/Ĕ/gm; - s/\xe6\x65/ĕ/gm; - s/\xe6\x61/ă/gm; - s/\xe8\x45/Ë/gm; - s/\xe8\x49/Ï/gm; - s/\xe8\x65/ë/gm; - s/\xe8\x69/ï/gm; - s/\xe8\x76/ÿ/gm; - s/\xe9\x41/A/gm; - s/\xe9\x4f/O/gm; - s/\xe9\x55/U/gm; - s/\xe9\x61/a/gm; - s/\xe9\x6f/o/gm; - s/\xe9\x75/u/gm; - s/\xea\x41/A/gm; - s/\xea\x61/a/gm; -#Additional Turkish characters - s/\x1b//gm; - s/\x1e//gm; - s/(\xf0)s/\xc5\x9f/gm; - s/(\xf0)S/\xc5\x9e/gm; - s/(\xf0)c/ç/gm; - s/(\xf0)C/Ç/gm; - s/\xe7\x49/\\xc4\xb0/gm; - s/(\xe6)G/\xc4\x9e/gm; - s/(\xe6)g/ğ\xc4\x9f/gm; - s/\xB8/ı/gm; - s/\xB9/£/gm; - s/(\xe8|\xc8)o/ö/gm ; - s/(\xe8|\xc8)O/Ö/gm ; - s/(\xe8|\xc8)u/ü/gm ; - s/(\xe8|\xc8)U/Ü/gm ; - s/\xc2\xb8/\xc4\xb1/gm; - s/¸/\xc4\xb1/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); -} sub DisplayISBN { +## Old style ISBN handling should be modified to accept 13 digits my ($isbn)=@_; my $seg1; if(substr($isbn, 0, 1) <=7) { @@ -2849,103 +1533,13 @@ sub DisplayISBN { my $seg4 = substr($x, -1, 1); return "$seg1-$seg2-$seg3-$seg4"; } -sub zebraopfiles{ - -my ($dbh,$biblionumber,$record,$folder,$server)=@_; -#my $record = XMLgetbiblio($dbh,$biblionumber); -my $op; -my $zebradir = C4::Context->zebraconfig($server)->{directory}."/".$folder."/"; - unless (opendir(DIR, "$zebradir")) { - warn "$zebradir not found"; - return; - } - closedir DIR; - my $filename = $zebradir.$biblionumber; -if ($record){ - open (OUTPUT,">", $filename.".xml"); - print OUTPUT $record; - - close OUTPUT; -} - - -} - - - - -sub zebraop{ -###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs - my ($dbh,$biblionumber,$op,$server) = @_; - my $dbh = C4::Context->dbh; - my @Zconnbiblio; - my $tried=0; - my $recon=0; - my $reconnect=0; - my $record; - my $shadow; - warn "Server is: ".$server; -reconnect: - $Zconnbiblio[0]=C4::Context->Zconnauth($server); - if ($server eq "biblioserver"){ - $record =XMLgetbiblio($dbh,$biblionumber); - $shadow="biblioservershadow"; - }elsif($server eq "authorityserver"){ - $record =C4::AuthoritiesMarc::XMLgetauthority($dbh,$biblionumber); - $shadow="authorityservershadow"; - } ## Add other servers as necessary - - my $Zpackage = $Zconnbiblio[0]->package(); - $Zpackage->option(action => $op); - $Zpackage->option(record => $record); -retry: - $Zpackage->send("update"); - my $i; - my $event; - - while (($i = ZOOM::event(\@Zconnbiblio)) != 0) { - $event = $Zconnbiblio[0]->last_event(); - last if $event == ZOOM::Event::ZEND; - } - my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio[0]->error_x(); - if ($error==10000 && $reconnect==0) { ## This is serious ZEBRA server is not available -reconnect - $reconnect=1; - my $res=system('sc start "Z39.50 Server" >c:/zebraserver/error.log'); - warn "Trying to restart ZEBRA Server"; - goto "reconnect"; - }elsif ($error==10007 && $tried<2) {## timeout --another 30 looonng seconds for this update - $tried=$tried+1; - goto "retry"; - }elsif($error==10004 && $recon==0){##Lost connection -reconnect - $recon=1; - goto "reconnect"; - }elsif ($error){ - warn "Error-$server $op $biblionumber /errcode:, $error, /MSG:,$errmsg,$addinfo \n"; - $Zpackage->destroy(); - $Zconnbiblio[0]->destroy(); - zebraopfiles($dbh,$biblionumber,$record,$op,$server); - return; - } - if (C4::Context->$shadow){ - $Zpackage->send('commit'); - while (($i = ZOOM::event(\@Zconnbiblio)) != 0) { - #waiting zebra to finish; - } - } - $Zpackage->destroy(); - $Zconnbiblio[0]->destroy(); - -} - - sub calculatelc{ +## Function to create padded LC call number for sorting items with their LC code. Not exported my ($classification)=@_; $classification=~s/^\s+|\s+$//g; my $i=0; my $lc2; my $lc1; - - for ($i=0; $iprepare("select classification, subclass from biblioitems where biblioitemnumber=?"); +## Sublimentary function to obtain sorted LC for items. Not exported +my ($dbh,$biblionumber,$callnumber)=@_; +my ($record,$frameworkcode)=MARCgetbiblio($dbh,$biblionumber); +my $biblio=MARCmarc2koha($dbh,$record,$frameworkcode,"biblios"); -$sth->execute($biblioitem); -my ($classification,$subclass)=$sth->fetchrow; -my $all=$classification." ".$subclass; +my $all=$biblio->{classification}." ".$biblio->{subclass}; my $total=length($all); -my $cutterextra=substr($callnumber,$total-1); +my $cutterextra=substr($callnumber,$total); return $cutterextra; } +#### This function allows decoding of only title and author out of a MARC record + sub func_title_author { + my ($tagno,$tagdata) = @_; + my ($titlef,$subf)=&MARCfind_marc_from_kohafield("title","biblios"); + my ($authf,$subf)=&MARCfind_marc_from_kohafield("author","biblios"); + return ($tagno == $titlef || $tagno == $authf); + } + END { } # module clean-up code here (global destructor) @@ -3010,593 +1612,5 @@ END { } # module clean-up code here (global destructor) Koha Developement team -Paul POULAIN paul.poulain@free.fr -=cut -# $Id$ -# $Log$ -# Revision 1.178 2006/08/21 09:51:15 toins -# Add a forgetted function : getbibliofromitemnumber -# -# Revision 1.177 2006/08/11 16:04:07 toins -# re-input an old function. -# -# Revision 1.176 2006/08/10 12:44:12 toins -# sync with dev_week. -# -# Revision 1.115.2.51.2.14 2006/07/15 19:22:46 kados -# comment out warns -# -# Revision 1.115.2.51.2.13 2006/07/03 16:05:26 kados -# fix shadow call to ZOOM -# -# Revision 1.115.2.51.2.12 2006/06/02 23:11:23 kados -# Committing my working dev_week. It's been tested only with -# searching, and there's quite a lot of config stuff to set up -# beforehand. As things get closer to a release, we'll be making -# some scripts to do it for us -# -# Revision 1.115.2.51.2.11 2006/05/28 18:49:12 tgarip1957 -# This is an unusual commit. The main purpose is a working model of Zebra on a modified rel2_2. -# Any questions regarding these commits should be asked to Joshua Ferraro unless you are Joshua whom I'll report to -# -# Revision 1.115.2.18 2005/08/02 07:45:44 tipaul -# fix for bug http://bugs.koha.org/cgi-bin/bugzilla/show_bug.cgi?id=1009 -# (Not all items fields mapped to MARC) -# -# Revision 1.115.2.17 2005/08/01 15:15:43 tipaul -# adding decoder for Ä string -# -# Revision 1.115.2.16 2005/07/28 19:56:15 tipaul -# * removing a useless & CPU consuming call to MARCgetbiblio -# * Leader management. -# If you create a MARC tag "000", with a subfield '@', it will be managed as the leader. -# Seems to work correctly. -# -# Now going to create a plugin for leader() -# -# Revision 1.115.2.15 2005/07/19 15:25:40 tipaul -# * fixing a bug in subfield order when MARCgetbiblio -# * getting rid with the limit "biblionumber & biblioitemnumber must be in the same tag". So, we can put biblionumber in 001 (field that has no subfields, so we can't put biblioitemnumber in this field), and use biblionumber as identifier in the MARC biblio too. Still to be deeply tested. -# * adding some diacritic decoding (Ä, Ü...) -# -# Revision 1.115.2.14 2005/06/27 23:24:06 hdl -# Display dashed ISBN -# -# Revision 1.115.2.13 2005/05/31 12:44:26 tipaul -# patch from Genji (Waylon R.) to update subjects in MARC tables when systempref has MARC=OFF -# -# Revision 1.115.2.12 2005/05/30 11:22:41 tipaul -# fixing a bug : when a field was repeated, the last field was also repeated. (Was due to the "empty" field in html between fields : to separate fields, in html, an empty field is automatically added. in MARChtml2marc, this empty field was not discarded correctly) -# -# Revision 1.115.2.11 2005/05/25 15:48:43 tipaul -# * removing my for variables already declared -# * updating biblio.unititle field as well as other fields in biblio table -# -# Revision 1.115.2.10 2005/05/25 09:30:50 hdl -# Adding NEWmodbiblioframework feature -# Used by addbiblio.pl when modifying a framework selection. -# -# Revision 1.115.2.9 2005/04/07 10:05:25 tipaul -# adding / to the list of symbols that are replace by spaces for searches -# -# Revision 1.115.2.8 2005/03/25 16:23:49 tipaul -# some improvements : -# * return immediatly when a subfield is empty -# * search duplicate on isbn must be done only when there is an isbn ;-) -# -# Revision 1.115.2.7 2005/03/10 15:52:28 tipaul -# * adding glass to opac marc detail. -# * changing glasses behaviour : It now appears only on subfields that have a "link" value. Avoid useless glasses and removes nothing. **** WARNING **** : if you don't change you MARC parameters, glasses DISAPPEAR, because no subfields have a link value. So you MUST "reactivate" them manually. If you want to enable the search glass on field 225$a (collection in UNIMARC), just put 225a to "link" field (Koha >> parameters >> framework >> 225 field >> subfield >> modify $a >> enter 225a in link input field (without quotes or anything else) -# * fixing bug with libopac -# -# Revision 1.115.2.6 2005/03/09 15:56:01 tipaul -# Changing MARCmoditem to be like MARCmodbiblio : a modif is a delete & create. -# Longer, but solves problems with repeated subfields. -# -# The previous version was not buggy except under certain circumstances (a repeated subfield, that does not exist usually in items) -# -# Revision 1.115.2.5 2005/02/24 13:54:04 tipaul -# exporting MARCdelsubfield sub. It's used in authority merging. -# Modifying it too to enable deletion of all subfields from a given tag/subfield or just one. -# -# Revision 1.115.2.4 2005/02/17 12:44:25 tipaul -# bug in acquisition : the title was also stored as subtitle. -# -# Revision 1.115.2.3 2005/02/10 13:14:36 tipaul -# * multiple main authors are now correctly handled in simple (non-MARC) view -# -# Revision 1.115.2.2 2005/01/11 16:02:35 tipaul -# in catalogue, modifs were not stored properly the non-MARC item DB. Affect only libraries without barcodes. -# -# Revision 1.115.2.1 2005/01/11 14:45:37 tipaul -# bugfix : issn were not stored correctly in non-MARC DB on biblio modification -# -# Revision 1.115 2005/01/06 14:32:17 tipaul -# improvement of speed for bulkmarcimport. -# A sub had been forgotten to use the C4::Context->marcfromkohafield array, that caches DB datas. -# this is only a little improvement for normal DB modif, but almost x2 the speed of bulkmarcimport... from 6records/seconds to more than 10. -# -# Revision 1.114 2005/01/03 10:48:33 tipaul -# * bugfix for the search on a MARC detail, when you clic on the magnifying glass (caused an internal server error) -# * partial support of the "linkage" MARC feature : if you enter a "link" on a MARC subfield, the magnifying glass won't search on the field, but on the linked field. I agree it's a partial support. Will be improved, but I need to investigate MARC21 & UNIMARC diffs on this topic. -# -# Revision 1.113 2004/12/10 16:27:53 tipaul -# limiting the number of search term to 8. There was no limit before, but 8 words seems to be the upper limit mySQL can deal with (in less than a second. tested on a DB with 13 000 items) -# In 2.4, a new DB structure will highly speed things and this limit will be removed. -# FindDuplicate is activated again, the perf problems were due to this problem. -# -# Revision 1.112 2004/12/08 10:14:42 tipaul -# * desactivate FindDuplicate -# * fix from Genji -# -# Revision 1.111 2004/11/25 17:39:44 tipaul -# removing useless &branches in package declaration -# -# Revision 1.110 2004/11/24 16:00:01 tipaul -# removing sub branches (commited by chris for MARC=OFF bugfix, but sub branches is already in Acquisition.pm) -# -# Revision 1.109 2004/11/24 15:58:31 tipaul -# * critical fix for acquisition (see RC3 release notes) -# * critical fix for duplicate finder -# -# Revision 1.108 2004/11/19 19:41:22 rangi -# Shifting branches() from deprecated C4::Catalogue to C4::Biblio -# Allowing the non marc interface acquisitions to work. -# -# Revision 1.107 2004/11/05 10:15:27 tipaul -# Improving FindDuplicate to find duplicate records on adding biblio -# -# Revision 1.106 2004/11/02 16:44:45 tipaul -# new feature : checking for duplicate biblio. -# -# For instance, it's only done on ISBN only. Will be improved soon. -# -# When a duplicate is detected, the biblio is not saved, but the user is asked for a confirmations. -# -# Revision 1.105 2004/09/23 16:15:37 tipaul -# indenting diff -# -# Revision 1.104 2004/09/16 15:06:46 tipaul -# enabling # (| still possible too) for repeatable subfields -# -# Revision 1.103 2004/09/06 14:17:34 tipaul -# some commented warning added + 1 major bugfix => drop empty fields, NOT fields containing 0 -# -# Revision 1.102 2004/09/06 10:00:19 tipaul -# adding a "location" field to the library. -# This field is useful when the callnumber contains no information on the room where the item is stored. -# With this field, we now have 3 levels of informations to find a book : -# * the branch. -# * the location. -# * the callnumber. -# -# This should be versatile enough to solve any storing method. -# This hack is quite simple, due to the nice Biblio.pm API. The MARC => koha db link is automatically managed. Just add the link in the parameters section. -# -# Revision 1.101 2004/08/18 16:01:37 tipaul -# modifs to support frameworkcodes -# -# Revision 1.100 2004/08/13 16:37:25 tipaul -# adding frameworkcode to API in some subs -# -# Revision 1.99 2004/07/30 13:54:50 doxulting -# Beginning of serial commit -# -# Revision 1.98 2004/07/15 09:48:10 tipaul -# * removing useless sub -# * minor bugfix in moditem (managing homebranch & holdingbranch) -# -# Revision 1.97 2004/07/02 15:53:53 tipaul -# bugfix (due to frameworkcode field) -# -# Revision 1.96 2004/06/29 16:07:10 tipaul -# last sync for 2.1.0 release -# -# Revision 1.95 2004/06/26 23:19:59 rangi -# Fixing modaddauthor, and adding getitemtypes. -# Also tidying up formatting of code -# -# Revision 1.94 2004/06/17 08:16:32 tipaul -# merging tag & subfield in marc_word for better perfs -# -# Revision 1.93 2004/06/11 15:38:06 joshferraro -# Changes MARCaddword to index words >= 1 char ... needed for more accurate -# searches using SearchMarc routines. -# -# Revision 1.92 2004/06/10 08:29:01 tipaul -# MARC authority management (continued) -# -# Revision 1.91 2004/06/03 10:03:01 tipaul -# * frameworks and itemtypes are independant -# * in the MARC editor, showing the + to duplicate a tag only if the tag is repeatable -# -# Revision 1.90 2004/05/28 08:25:53 tipaul -# hidding hidden & isurl constraints into MARC subfield structure -# -# Revision 1.89 2004/05/27 21:47:21 rangi -# Fix for bug 787 -# -# Revision 1.88 2004/05/18 15:23:49 tipaul -# framework management : 1 MARC framework for each itemtype -# -# Revision 1.87 2004/05/18 11:54:07 tipaul -# getitemtypes moved in Koha.pm -# -# Revision 1.86 2004/05/03 09:19:22 tipaul -# some fixes for mysql prepare & execute -# -# Revision 1.85 2004/04/02 14:55:48 tipaul -# renaming items.bulk field to items.itemcallnumber. -# Will be used to store call number for libraries that don't use dewey classification. -# Note it's related to ITEMS, not biblio. -# -# Revision 1.84 2004/03/24 17:18:30 joshferraro -# Fixes bug 749 by removing the comma on line 1488. -# -# Revision 1.83 2004/03/15 14:31:50 tipaul -# adding a minor check -# -# Revision 1.82 2004/03/07 05:47:31 acli -# Various updates/fixes from rel_2_0 -# Fixes for bugs 721 (templating), 727, and 734 -# -# Revision 1.81 2004/03/06 20:26:13 tipaul -# adding seealso feature in MARC searches -# -# 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 -# -# Revision 1.78.2.3 2004/02/10 13:15:46 tipaul -# removing 2 warnings -# -# Revision 1.78.2.2 2004/01/26 10:38:06 tipaul -# dealing correctly "bulk" field -# -# Revision 1.78.2.1 2004/01/13 17:29:53 tipaul -# * minor html fixes -# * adding publisher in acquisition process (& ordering basket by publisher) -# -# Revision 1.78 2003/12/09 15:57:28 tipaul -# rolling back to working char_decode sub -# -# Revision 1.77 2003/12/03 17:47:14 tipaul -# bugfixes for biblio deletion -# -# Revision 1.76 2003/12/03 01:43:41 slef -# conflict markers? -# -# Revision 1.75 2003/12/03 01:42:03 slef -# bug 662 fixes securing DBI -# -# Revision 1.74 2003/11/28 09:48:33 tipaul -# bugfix : misusing prepare & execute => now using prepare(?) and execute($var) -# -# Revision 1.73 2003/11/28 09:45:25 tipaul -# bugfix for iso2709 file import in the "notforloan" field. -# -# But notforloan field called "loan" somewhere, so in case "loan" is used, copied to "notforloan" to avoid a bug. -# -# Revision 1.72 2003/11/24 17:40:14 tipaul -# fix for #385 -# -# Revision 1.71 2003/11/24 16:28:49 tipaul -# biblio & item deletion now works fine in MARC editor. -# Stores deleted biblio/item in the marc field of the deletedbiblio/deleteditem table. -# -# Revision 1.70 2003/11/24 13:29:55 tipaul -# moving $id from beginning to end of file (70 commits... huge comments...) -# -# Revision 1.69 2003/11/24 13:27:17 tipaul -# fix for #380 (bibliosubject) -# -# Revision 1.68 2003/11/06 17:18:30 tipaul -# bugfix for #384 -# -# 1st draft for MARC biblio deletion. -# Still does not work well, but at least, Biblio.pm compiles & it should'nt break too many things -# (Note the trash in the MARCdetail, but don't use it, please :-) ) -# -# Revision 1.67 2003/10/25 08:46:27 tipaul -# minor fixes for bilbio deletion (still buggy) -# -# Revision 1.66 2003/10/17 10:02:56 tipaul -# Indexing only words longer than 2 letters. Was >=2 before, & 2 letters words usually means nothing. -# -# Revision 1.65 2003/10/14 09:45:29 tipaul -# adding rebuildnonmarc.pl script : run this script when you change a link between marc and non MARC DB. It rebuilds the non-MARC DB (long operation) -# -# Revision 1.64 2003/10/06 15:20:51 tipaul -# fix for 536 (subtitle error) -# -# Revision 1.63 2003/10/01 13:25:49 tipaul -# seems a char encoding problem modified something in char_decode sub... changing back to something that works... -# -# Revision 1.62 2003/09/17 14:21:13 tipaul -# fixing bug that makes a MARC biblio disappear when using full acquisition (order => recieve ==> MARC editor). -# Before this 2 lines fix, the MARC biblio was deleted during recieve, and had to be entirely recreated :-( -# -# Revision 1.61 2003/09/17 10:24:39 tipaul -# notforloan value in itemtype was overwritting notforloan value in a given item. -# I changed this behaviour : -# if notforloan is set for a given item, and NOT for all items from this itemtype, the notforloan is kept. -# If notforloan is set for itemtype, it's used (and impossible to loan a specific item from this itemtype) -# -# Revision 1.60 2003/09/04 14:11:23 tipaul -# fix for 593 (data duplication in MARC-DB) -# -# Revision 1.58 2003/08/06 12:54:52 tipaul -# fix for publicationyear : extracting numeric value from MARC string, like for copyrightdate. -# (note that copyrightdate still extracted to get numeric format) -# -# Revision 1.57 2003/07/15 23:09:18 slef -# change show columns to use biblioitems bnotes too -# -# Revision 1.56 2003/07/15 11:34:52 slef -# fixes from paul email -# -# Revision 1.55 2003/07/15 00:02:49 slef -# Work on bug 515... can we do a single-side rename of notes to bnotes? -# -# Revision 1.54 2003/07/11 11:51:32 tipaul -# *** empty log message *** -# -# Revision 1.52 2003/07/10 10:37:19 tipaul -# fix for copyrightdate problem, #514 -# -# Revision 1.51 2003/07/02 14:47:17 tipaul -# fix for #519 : items.dateaccessioned imports incorrectly -# -# Revision 1.49 2003/06/17 11:21:13 tipaul -# improvments/fixes for z3950 support. -# * Works now even on ADD, not only on MODIFY -# * able to search on ISBN, author, title -# -# Revision 1.48 2003/06/16 09:22:53 rangi -# Just added an order clause to getitemtypes -# -# Revision 1.47 2003/05/20 16:22:44 tipaul -# fixing typo in Biblio.pm POD -# -# Revision 1.46 2003/05/19 13:45:18 tipaul -# support for subtitles, additional authors, subject. -# This supports is only for MARC <-> OLD-DB link. It worked previously, but values entered as MARC were not reported to OLD-DB, neither values entered as OLD-DB were reported to MARC. -# Note that some OLD-DB subs are strange (dummy ?) see OLDmodsubject, OLDmodsubtitle, OLDmodaddiauthor in C4/Biblio.pm -# For example it seems impossible to have more that 1 addi author and 1 subtitle. In MARC it's not the case. So, if you enter more than one, I'm afraid only the LAST will be stored. -# -# Revision 1.45 2003/04/29 16:50:49 tipaul -# really proud of this commit :-) -# z3950 search and import seems to works fine. -# Let me explain how : -# * a "search z3950" button is added in the addbiblio template. -# * when clicked, a popup appears and z3950/search.pl is called -# * z3950/search.pl calls addz3950search in the DB -# * the z3950 daemon retrieve the records and stores them in z3950results AND in marc_breeding table. -# * as long as there as searches pending, the popup auto refresh every 2 seconds, and says how many searches are pending. -# * when the user clicks on a z3950 result => the parent popup is called with the requested biblio, and auto-filled -# -# Note : -# * character encoding support : (It's a nightmare...) In the z3950servers table, a "encoding" column has been added. You can put "UNIMARC" or "USMARC" in this column. Depending on this, the char_decode in C4::Biblio.pm replaces marc-char-encode by an iso 8859-1 encoding. Note that in the breeding import this value has been added too, for a better support. -# * the marc_breeding and z3950* tables have been modified : they have an encoding column and the random z3950 number is stored too for convenience => it's the key I use to list only requested biblios in the popup. -# -# Revision 1.44 2003/04/28 13:07:14 tipaul -# Those fixes solves the "internal server error" with MARC::Record 1.12. -# It was due to an illegal contruction in Koha : we tried to retrive subfields from <10 tags. -# That's not possible. MARC::Record accepted this in 0.93 version, but it was fixed after. -# Now, the construct/retrieving is OK ! -# -# Revision 1.43 2003/04/10 13:56:02 tipaul -# Fix some bugs : -# * worked in 1.9.0, but not in 1.9.1 : -# - modif of a biblio didn't work -# - empty fields where not shown when modifying a biblio. empty fields managed by the library (ie in tab 0->9 in MARC parameter table) MUST be entered, even if not presented. -# -# * did not work before : -# - repeatable subfields now works correctly. Enter 2 subfields separated by | and they will be splitted during saving. -# - dropped the last subfield of the MARC form :-( -# -# Internal changes : -# - MARCmodbiblio now works by deleting and recreating the biblio. It's not perf optimized, but MARC is a "do_something_impossible_to_trace" standard, so, it's the best solution. not a problem for me, as biblio are rarely modified. -# Note the MARCdelbiblio has been rewritted to enable deletion of a biblio WITHOUT deleting items. -# -# Revision 1.42 2003/04/04 08:41:11 tipaul -# last commits before 1.9.1 -# -# Revision 1.41 2003/04/01 12:26:43 tipaul -# fixes -# -# Revision 1.40 2003/03/11 15:14:03 tipaul -# pod updating -# -# Revision 1.39 2003/03/07 16:35:42 tipaul -# * moving generic functions to Koha.pm -# * improvement of SearchMarc.pm -# * bugfixes -# * code cleaning -# -# Revision 1.38 2003/02/27 16:51:59 tipaul -# * moving prepare / execute to ? form. -# * some # cleaning -# * little bugfix. -# * road to 1.9.2 => acquisition and cataloguing merging -# -# Revision 1.37 2003/02/12 11:03:03 tipaul -# Support for 000 -> 010 fields. -# Those fields doesn't have subfields. -# In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@". -# Note it's only virtual : when rebuilding the MARC::Record, the koha API handle correctly "@" subfields => the resulting MARC record has a 00x field without subfield. -# -# Revision 1.36 2003/02/12 11:01:01 tipaul -# Support for 000 -> 010 fields. -# Those fields doesn't have subfields. -# In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@". -# Note it's only virtual : when rebuilding the MARC::Record, the koha API handle correctly "@" subfields => the resulting MARC record has a 00x field without subfield. -# -# Revision 1.35 2003/02/03 18:46:00 acli -# Minor factoring in C4/Biblio.pm, plus change to export the per-tag -# 'mandatory' property to a per-subfield 'tag_mandatory' template parameter, -# so that addbiblio.tmpl can distinguish between mandatory subfields in a -# mandatory tag and mandatory subfields in an optional tag -# -# Not-minor factoring in acqui.simple/addbiblio.pl to make the if-else blocks -# smaller, and to add some POD; need further testing for this -# -# Added function to check if a MARC subfield name is "koha-internal" (instead -# of checking it for 'lib' and 'tag' everywhere); temporarily added to Koha.pm -# -# Use above function in acqui.simple/additem.pl and search.marc/search.pl -# -# Revision 1.34 2003/01/28 14:50:04 tipaul -# fixing MARCmodbiblio API and reindenting code -# -# Revision 1.33 2003/01/23 12:22:37 tipaul -# adding char_decode to decode MARC21 or UNIMARC extended chars -# -# Revision 1.32 2002/12/16 15:08:50 tipaul -# small but important bugfix (fixes a problem in export) -# -# Revision 1.31 2002/12/13 16:22:04 tipaul -# 1st draft of marc export -# -# Revision 1.30 2002/12/12 21:26:35 tipaul -# YAB ! (Yet Another Bugfix) => related to biblio modif -# (some warning cleaning too) -# -# Revision 1.29 2002/12/12 16:35:00 tipaul -# adding authentification with Auth.pm and -# MAJOR BUGFIX on marc biblio modification -# -# Revision 1.28 2002/12/10 13:30:03 tipaul -# fugfixes from Dombes Abbey work -# -# Revision 1.27 2002/11/19 12:36:16 tipaul -# road to 1.3.2 -# various bugfixes, improvments, and migration from acquisition.pm to biblio.pm -# -# Revision 1.26 2002/11/12 15:58:43 tipaul -# road to 1.3.2 : -# * many bugfixes -# * adding value_builder : you can map a subfield in the marc_subfield_structure to a sub stored in "value_builder" directory. In this directory you can create screen used to build values with any method. In this commit is a 1st draft of the builder for 100$a unimarc french subfield, which is composed of 35 digits, with 12 differents values (only the 4th first are provided for instance) -# -# Revision 1.25 2002/10/25 10:58:26 tipaul -# Road to 1.3.2 -# * bugfixes and improvements -# -# Revision 1.24 2002/10/24 12:09:01 arensb -# Fixed "no title" warning when generating HTML documentation from POD. -# -# Revision 1.23 2002/10/16 12:43:08 arensb -# Added some FIXME comments. -# -# Revision 1.22 2002/10/15 13:39:17 tipaul -# removing Acquisition.pm -# deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments -# -# Revision 1.21 2002/10/13 11:34:14 arensb -# Replaced expressions of the form "$x = $x $y" with "$x = $y". -# Thus, $x = $x+2 becomes $x += 2, and so forth. -# -# Revision 1.20 2002/10/13 08:28:32 arensb -# Deleted unused variables. -# Removed trailing whitespace. -# -# Revision 1.19 2002/10/13 05:56:10 arensb -# Added some FIXME comments. -# -# Revision 1.18 2002/10/11 12:34:53 arensb -# Replaced &requireDBI with C4::Context->dbh -# -# Revision 1.17 2002/10/10 14:48:25 tipaul -# bugfixes -# -# Revision 1.16 2002/10/07 14:04:26 tipaul -# road to 1.3.1 : viewing MARC biblio -# -# Revision 1.15 2002/10/05 09:49:25 arensb -# Merged with arensb-context branch: use C4::Context->dbh instead of -# &C4Connect, and generally prefer C4::Context over C4::Database. -# -# Revision 1.14 2002/10/03 11:28:18 tipaul -# Extending Context.pm to add stopword management and using it in MARC-API. -# First benchmarks show a medium speed improvement, which is nice as this part is heavily called. -# -# Revision 1.13 2002/10/02 16:26:44 tipaul -# road to 1.3.1 -# -# Revision 1.12.2.4 2002/10/05 07:09:31 arensb -# Merged in changes from main branch. -# -# Revision 1.12.2.3 2002/10/05 06:12:10 arensb -# Added a whole mess of FIXME comments. -# -# Revision 1.12.2.2 2002/10/05 04:03:14 arensb -# Added some missing semicolons. -# -# Revision 1.12.2.1 2002/10/04 02:24:01 arensb -# Use C4::Connect instead of C4::Database, C4::Connect->dbh instead -# C4Connect. -# -# Revision 1.12.2.3 2002/10/05 06:12:10 arensb -# Added a whole mess of FIXME comments. -# -# Revision 1.12.2.2 2002/10/05 04:03:14 arensb -# Added some missing semicolons. -# -# Revision 1.12.2.1 2002/10/04 02:24:01 arensb -# Use C4::Connect instead of C4::Database, C4::Connect->dbh instead -# C4Connect. -# -# Revision 1.12 2002/10/01 11:48:51 arensb -# Added some FIXME comments, mostly marking duplicate functions. -# -# Revision 1.11 2002/09/24 13:49:26 tipaul -# long WAS the road to 1.3.0... -# coming VERY SOON NOW... -# modifying installer and buildrelease to update the DB -# -# Revision 1.10 2002/09/22 16:50:08 arensb -# Added some FIXME comments. -# -# Revision 1.9 2002/09/20 12:57:46 tipaul -# long is the road to 1.4.0 -# * MARCadditem and MARCmoditem now wroks -# * various bugfixes in MARC management -# !!! 1.3.0 should be released very soon now. Be careful !!! -# -# 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 -# -# Revision 1.6 2002/07/25 13:40:31 tipaul -# pod documenting the API. -# -# Revision 1.5 2002/07/24 16:11:37 tipaul -# Now, the API... -# Database.pm and Output.pm are almost not modified (var test...) -# -# Biblio.pm is almost completly rewritten. -# -# WHAT DOES IT ??? ==> END of Hitchcock suspens -# -# 1st, it does... nothing... -# Every old API should be there. So if MARC-stuff is not done, the behaviour is EXACTLY the same (if there is no added bug, of course). So, if you use normal acquisition, you won't find anything new neither on screen or old-DB tables ... -# -# All old-API functions have been cloned. for example, the "newbiblio" sub, now has become : -# * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio -# * a "OLDnewbiblio" sub, which is a copy/paste of the previous newbiblio sub. Then, when you want to add the MARC-DB stuff, you can modify the newbiblio sub without modifying the OLDnewbiblio one. If we correct a bug in 1.2 in newbiblio, we can do the same in main branch by correcting OLDnewbiblio. -# * The MARC stuff is usually done through a sub named MARCxxx where xxx is the same as OLDxxx. For example, newbiblio calls MARCnewbiblio. the MARCxxx subs use a MARC::Record as parameter. -# The last thing to solve was to manage biblios through real MARC import : they must populate the old-db, but must populate the MARC-DB too, without loosing information (if we go from MARC::Record to old-data then back to MARC::Record, we loose A LOT OF ROWS). To do this, there are subs beginning by "NEWxxx" : they manage datas with MARC::Record datas. they call OLDxxx sub too (to populate old-DB), but MARCxxx subs too, with a complete MARC::Record ;-) -# -# 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. -# diff --git a/C4/BookShelves.pm b/C4/BookShelves.pm index 381dacbab2..aac2618a7d 100755 --- a/C4/BookShelves.pm +++ b/C4/BookShelves.pm @@ -24,9 +24,12 @@ package C4::BookShelves; use strict; require Exporter; -use DBI; use C4::Context; use C4::Circulation::Circ2; +use C4::AcademicInfo; +use C4::Search; +use C4::Date; +use C4::Biblio; use vars qw($VERSION @ISA @EXPORT); # set the version for version checking @@ -53,13 +56,21 @@ items to and from bookshelves. =cut @ISA = qw(Exporter); -@EXPORT = qw(&GetShelfList &GetShelfContents &GetShelf - &AddToShelf &AddToShelfFromBiblio - &RemoveFromShelf &AddShelf &ModifShelf - &RemoveShelf &ShelfPossibleAction - ); - -my $dbh = C4::Context->dbh; +@EXPORT = qw(&GetShelfList &GetShelfContents &AddToShelf &AddToShelfFromBiblio + &RemoveFromShelf &AddShelf &RemoveShelf + &ShelfPossibleAction + + &GetShelfListExt &AddShelfExt &EditShelfExt &RemoveShelfExt + &GetShelfInfo &GetShelfContentsExt &RemoveFromShelfExt + &GetShelfListOfExt &AddToShelfExt + + &AddRequestToShelf &CountShelfRequest &GetShelfRequests + &RejectShelfRequest &CatalogueShelfRequest &GetShelfRequestOwner + &GetShelfRequest); + + +my $dbh; + $dbh = C4::Context->dbh; =item ShelfPossibleAction @@ -116,12 +127,13 @@ sub GetShelfList { my ($owner,$mincategory) = @_; # mincategory : 2 if the list is for "look". 3 if the list is for "Select bookshelf for adding a book". # bookshelves of the owner are always selected, whatever the category - my $sth=$dbh->prepare("SELECT bookshelf.shelfnumber, bookshelf.shelfname,owner,surname,firstname,category, + my $sth=$dbh->prepare("SELECT bookshelf.shelfnumber, bookshelf.shelfname,owner,surname,firstname, category, count(shelfcontents.itemnumber) as count FROM bookshelf LEFT JOIN shelfcontents ON bookshelf.shelfnumber = shelfcontents.shelfnumber left join borrowers on bookshelf.owner = borrowers.borrowernumber + where owner=? or category>=? GROUP BY bookshelf.shelfnumber order by shelfname"); $sth->execute($owner,$mincategory); @@ -129,20 +141,17 @@ sub GetShelfList { while (my ($shelfnumber, $shelfname,$owner,$surname,$firstname,$category,$count) = $sth->fetchrow) { $shelflist{$shelfnumber}->{'shelfname'}=$shelfname; $shelflist{$shelfnumber}->{'count'}=$count; - $shelflist{$shelfnumber}->{'category'}=$category; $shelflist{$shelfnumber}->{'owner'}=$owner; - $shelflist{$shelfnumber}->{surname} = $surname; - $shelflist{$shelfnumber}->{firstname} = $firstname; + $shelflist{$shelfnumber}->{'surname'} = $surname; + $shelflist{$shelfnumber}->{'firstname'} = $firstname; + $shelflist{$shelfnumber}->{'category'} = $category; + + } + return(\%shelflist); } -sub GetShelf { - my ($shelfnumber) = @_; - my $sth=$dbh->prepare("select shelfnumber,shelfname,owner,category from bookshelf where shelfnumber=?"); - $sth->execute($shelfnumber); - return $sth->fetchrow; -} =item GetShelfContents $itemlist = &GetShelfContents($env, $shelfnumber); @@ -204,8 +213,8 @@ sub AddToShelfFromBiblio { if ($sth->rows) { # already on shelf } else { - $sth=$dbh->prepare("insert into shelfcontents (shelfnumber, itemnumber, flags) values (?, ?, 0)"); - $sth->execute($shelfnumber, $itemnumber); + $sth=$dbh->prepare("insert into shelfcontents (shelfnumber, itemnumber, flags,biblionumber) values (?, ?, 0,?)"); + $sth->execute($shelfnumber, $itemnumber,$biblionumber); } } @@ -240,27 +249,22 @@ success, or an error message giving the reason for failure. C<$env> is ignored. =cut - +#' +# FIXME - Perhaps this could/should return the number of the new bookshelf +# as well? sub AddShelf { - my ($env, $shelfname, $owner, $category) = @_; + my ($env, $shelfname,$owner,$category) = @_; my $sth=$dbh->prepare("select * from bookshelf where shelfname=?"); $sth->execute($shelfname); if ($sth->rows) { - return(1, "Shelf \"$shelfname\" already exists"); + return(1, "Shelf \"$shelfname\" already exists"); } else { - $sth=$dbh->prepare("insert into bookshelf (shelfname,owner,category) values (?,?,?)"); - $sth->execute($shelfname,$owner,$category); - my $shelfnumber = $dbh->{'mysql_insertid'}; - return (0, "Done",$shelfnumber); + $sth=$dbh->prepare("insert into bookshelf (shelfname,owner,category) values (?,?,?)"); + $sth->execute($shelfname,$owner,$category); + return (0, "Done"); } } -sub ModifShelf { - my ($shelfnumber, $shelfname, $owner, $category) = @_; - my $sth = $dbh->prepare("update bookshelf set shelfname=?,owner=?,category=? where shelfnumber=?"); - $sth->execute($shelfname,$owner,$category,$shelfnumber); -} - =item RemoveShelf ($status, $msg) = &RemoveShelf($env, $shelfnumber); @@ -290,21 +294,327 @@ sub RemoveShelf { } } +sub GetShelfListOfExt { + my ($owner) = @_; + my $sth; + if ($owner) { + $sth = $dbh->prepare("SELECT * FROM bookshelf WHERE (owner = ?) or category>=2 ORDER BY shelfname"); + $sth->execute($owner); + } else { + $sth = $dbh->prepare("SELECT * FROM bookshelf where category<2 ORDER BY shelfname"); + $sth->execute(); + } + + my $sth2 = $dbh->prepare("SELECT count(biblionumber) as bibliocount FROM shelfcontents WHERE (shelfnumber = ?)"); + + my @results; + while (my $row = $sth->fetchrow_hashref) { + $sth2->execute($row->{'shelfnumber'}); + $row->{'bibliocount'} = $sth2->fetchrow; + if ($row->{'category'} == 1) { + $row->{'private'} = 1; + } else { + $row->{'public'} = 1; + } + push @results, $row; + } + return \@results; +} + +sub GetShelfListExt { + my ($owner,$mincategory,$id_intitution, $intra) = @_; + + my $sth1 = $dbh->prepare("SELECT * FROM careers WHERE id_institution = ?"); + $sth1->execute($id_intitution); + my @results; + + my $total_shelves = 0; + while (my $row1 = $sth1->fetchrow_hashref) { + + my @shelves; + my $sth2; + if ($intra) { + $sth2=$dbh->prepare("SELECT + bookshelf.shelfnumber, bookshelf.shelfname,owner,surname,firstname, category, + count(shelfcontents.biblionumber) as count + FROM + bookshelf + LEFT JOIN shelfcontents ON bookshelf.shelfnumber = shelfcontents.shelfnumber + LEFT JOIN borrowers ON bookshelf.owner = borrowers.borrowernumber + LEFT JOIN bookshelves_careers ON bookshelves_careers.shelfnumber = bookshelf.shelfnumber + WHERE + (id_career = ?) + GROUP BY bookshelf.shelfnumber + ORDER BY shelfname"); + $sth2->execute($row1->{'id_career'}); + + } else { + $sth2=$dbh->prepare("SELECT + bookshelf.shelfnumber, bookshelf.shelfname,owner,surname,firstname, category, + count(shelfcontents.biblionumber) as count + FROM + bookshelf + LEFT JOIN shelfcontents ON bookshelf.shelfnumber = shelfcontents.shelfnumber + LEFT JOIN borrowers ON bookshelf.owner = borrowers.borrowernumber + LEFT JOIN bookshelves_careers ON bookshelves_careers.shelfnumber = bookshelf.shelfnumber + WHERE + (owner = ? OR category >= ?) AND (id_career = ?) + GROUP BY bookshelf.shelfnumber + ORDER BY shelfname"); + $sth2->execute($owner,$mincategory,$row1->{'id_career'}); + } + + $row1->{'shelfcount'} = 0; + while (my $row2 = $sth2->fetchrow_hashref) { + if ($owner == $row2->{'owner'}) { + $row2->{'canmanage'} = 1; + } + if ($row2->{'category'} == 1) { + $row2->{'private'} = 1; + } else { + $row2->{'public'} = 1; + } + $row1->{'shelfcount'}++; + $total_shelves++; + push @shelves, $row2; + } + $row1->{'shelvesloop'} = \@shelves; + push @results, $row1; + } + + return($total_shelves, \@results); +} + +sub AddShelfExt { + my ($shelfname,$owner,$category,$careers) = @_; + my $sth = $dbh->prepare("SELECT * FROM bookshelf WHERE shelfname = ?"); + $sth->execute($shelfname); + if ($sth->rows) { + return 0; + } else { + $sth = $dbh->prepare("INSERT INTO bookshelf (shelfname,owner,category) VALUES (?,?,?)"); + $sth->execute($shelfname,$owner,$category); + my $shelfnumber = $dbh->{'mysql_insertid'}; + + foreach my $row (@{$careers}) { + $sth = $dbh->prepare("INSERT INTO bookshelves_careers VALUES (?,?)"); + $sth->execute($shelfnumber, $row); + } + return $shelfnumber; + } +} + +sub EditShelfExt { + my ($shelfnumber,$shelfname,$category,$careers) = @_; + my $sth = $dbh->prepare("SELECT * FROM bookshelf WHERE shelfname = ? AND NOT shelfnumber = ? "); + $sth->execute($shelfname, $shelfnumber); + if ($sth->rows) { + return 0; + } else { + $sth = $dbh->prepare("UPDATE bookshelf SET shelfname = ?, category = ? WHERE shelfnumber = ?"); + $sth->execute($shelfname,$category,$shelfnumber); + + $sth = $dbh->prepare("DELETE FROM bookshelves_careers WHERE shelfnumber = ?"); + $sth->execute($shelfnumber); + + foreach my $row (@{$careers}) { + $sth = $dbh->prepare("INSERT INTO bookshelves_careers VALUES (?,?)"); + $sth->execute($shelfnumber, $row); + } + return $shelfnumber; + } +} + + +sub RemoveShelfExt { + my ($shelfnumber) = @_; + my $sth = $dbh->prepare("DELETE FROM bookshelves_careers WHERE shelfnumber = ?"); + $sth->execute($shelfnumber); + my $sth = $dbh->prepare("DELETE FROM shelfcontents WHERE shelfnumber = ?"); + $sth->execute($shelfnumber); + $sth = $dbh->prepare("DELETE FROM bookshelf WHERE shelfnumber = ?"); + $sth->execute($shelfnumber); + return 1; +} + +sub GetShelfInfo { + my ($shelfnumber, $owner) = @_; + my $sth = $dbh->prepare("SELECT * FROM bookshelf WHERE shelfnumber = ?"); + $sth->execute($shelfnumber); + my $result = $sth->fetchrow_hashref; + + if ($result->{'owner'} == $owner) { + $result->{'canmanage'} = 1; + } + + my $sth = $dbh->prepare("SELECT id_career FROM bookshelves_careers WHERE shelfnumber = ?"); + $sth->execute($shelfnumber); + my @careers; + while (my $row = $sth->fetchrow) { + push @careers, $row; + } + $result->{'careers'} = \@careers; + return $result; +} + +sub GetShelfContentsExt { + my ($shelfnumber) = @_; + my $sth = $dbh->prepare("SELECT biblionumber FROM shelfcontents WHERE shelfnumber = ? ORDER BY biblionumber"); + $sth->execute($shelfnumber); + my @biblios; + my $even = 0; + while (my ($biblionumber) = $sth->fetchrow) { + my $biblio=ZEBRA_readyXML_noheader($dbh,$biblionumber); + push @biblios,$biblio; + } +my (@results)=parsefields($dbh,"opac",@biblios); + + return (\@results); +} + +sub RemoveFromShelfExt { + my ($biblionumber, $shelfnumber) = @_; + my $sth = $dbh->prepare("DELETE FROM shelfcontents WHERE shelfnumber = ? AND biblionumber = ?"); + $sth->execute($shelfnumber,$biblionumber); +} + +sub AddToShelfExt { + my ($biblionumber, $shelfnumber) = @_; + my $sth = $dbh->prepare("SELECT * FROM shelfcontents WHERE shelfnumber = ? AND biblionumber = ?"); + $sth->execute($shelfnumber, $biblionumber); + if ($sth->rows) { + return 0 + } else { + $sth = $dbh->prepare("INSERT INTO shelfcontents (shelfnumber, biblionumber) VALUES (?, ?)"); + $sth->execute($shelfnumber, $biblionumber); + } +} + +sub AddRequestToShelf { + my ($shelfnumber, $requestType, $requestName, $comments) = @_; + my $sth = $dbh->prepare("INSERT INTO shelf_requests (shelfnumber, request_name, request_type, status, request_date, comments) VALUES (?,?,?,?, CURRENT_DATE(),?)"); + $sth->execute($shelfnumber, $requestName, $requestType, "PENDING", $comments); + return $dbh->{'mysql_insertid'}; +} + +sub CountShelfRequest { + my ($shelfnumber, $status) = @_; + my $sth; + if ($shelfnumber) { + $sth = $dbh->prepare("SELECT count(idRequest) FROM shelf_requests WHERE shelfnumber = ? AND status = ?"); + $sth->execute($shelfnumber, $status); + } else { + $sth = $dbh->prepare("SELECT count(idRequest) FROM shelf_requests WHERE status = ?"); + $sth->execute($status); + } + my ($count) = $sth->fetchrow_array; + return $count; +} + +sub GetShelfRequests { + my ($shelfnumber, $status, $type) = @_; + my @params; + my $query = "SELECT * FROM shelf_requests SR INNER JOIN bookshelf BS ON SR.shelfnumber = BS.shelfnumber WHERE status = ?"; + push @params, $status; + if ($shelfnumber) { + $query.= " AND shelfnumber = ?"; + push @params, $shelfnumber; + } + if ($type) { + $query.= " AND request_type = ?"; + push @params, $type; + } + $query.= " ORDER BY SR.shelfnumber, SR.request_date"; + my $sth = $dbh->prepare($query); + $sth->execute(@params); + my @results; + + my $color = 0; + while (my $row = $sth->fetchrow_hashref) { + my $borrdata = borrdata('',$row->{'owner'}); + $row->{'surname'} = $borrdata->{'surname'}; + $row->{'firstname'} = $borrdata->{'firstname'}; + $row->{'cardnumber'} = $borrdata->{'cardnumber'}; + $row->{'request_date'} = format_date($row->{'request_date'}); + $row->{$row->{'request_type'}} = 1; + $row->{$row->{'status'}} = 1; + $row->{'color'} = $color = not $color; + push @results, $row; + } + return (\@results); +} + +sub RejectShelfRequest { + my ($idRequest) = @_; + #get the type and name request + my $sth = $dbh->prepare("SELECT request_type, request_name FROM shelf_requests WHERE idRequest = ?"); + $sth->execute($idRequest); + my ($request_type, $request_name) = $sth->fetchrow_array; + #if the request is a file, then unlink the file + if ($request_type eq 'file') { + unlink($ENV{'DOCUMENT_ROOT'}."/uploaded-files/shelf-files/$idRequest-$request_name"); + } + #change tha request status to REJECTED + $sth = $dbh->prepare("UPDATE shelf_requests SET status = ? WHERE idRequest = ?"); + $sth->execute("REJECTED", $idRequest); + return 1; +} + +sub GetShelfRequestOwner { + my ($idRequest) = @_; + my $sth = $dbh->prepare("SELECT owner FROM shelf_requests R INNER JOIN bookshelf S ON R.shelfnumber = S.shelfnumber WHERE idRequest = ?"); + $sth->execute($idRequest); + my ($owner) = $sth->fetchrow_array; + my $bordata = &borrdata(undef, $owner); + #print "Content-type: text/plain \n\n --- $owner ----- $bordata->{'emailaddress'}" ; + return ($bordata); +} + +sub GetShelfRequest { + my ($idRequest) = @_; + my $sth = $dbh->prepare("SELECT * FROM shelf_requests R INNER JOIN bookshelf S ON R.shelfnumber = S.shelfnumber WHERE idRequest = ?"); + $sth->execute($idRequest); + my $request_data = $sth->fetchrow_hashref; + return $request_data; +} + +sub CatalogueShelfRequest { + my ($idRequest, $shelfnumber, $biblionumber) = @_; + #find the last request status + my $sth = $dbh->prepare("SELECT status, biblionumber FROM shelf_requests WHERE idRequest = ?"); + $sth->execute($idRequest); + my ($prev_status, $prev_biblionumber) = $sth->fetchrow_array; + #if the status was not seted, inserts an entry in shelfcontents + if ($prev_status ne "CATALOGUED") { + $sth = $dbh->prepare("INSERT INTO shelfcontents (shelfnumber, biblionumber) VALUES (?,?)"); + $sth->execute($shelfnumber, $biblionumber); + #if the request was previously catalogued, delete the entry in shelfcontens + } elsif ($prev_status ne "REJECTED") { + $sth = $dbh->prepare("DELETE FROM shelfcontents WHERE shelfnumber = ? AND biblionumber = ?"); + $sth->execute($shelfnumber, $prev_biblionumber); + } + #change the status to catalogued + $sth = $dbh->prepare("UPDATE shelf_requests SET status = ?, biblionumber = ? WHERE idRequest = ?"); + $sth->execute("CATALOGUED", $biblionumber, $idRequest); + return 1; +} + END { } # module clean-up code here (global destructor) 1; # # $Log$ -# Revision 1.15 2004/12/16 11:30:58 tipaul -# adding bookshelf features : -# * create bookshelf on the fly -# * modify a bookshelf name & status -# -# Revision 1.14 2004/12/15 17:28:23 tipaul -# adding bookshelf features : -# * create bookshelf on the fly -# * modify a bookshelf (this being not finished, will commit the rest soon) +# Revision 1.16 2006/08/25 21:07:08 tgarip1957 +# New set of routines for HEAD. +# Uses a complete new ZEBRA Indexing. +# ZEBRA is now XML and comprises of a KOHA meta record. Explanatory notes will be on koha-devel +# Fixes UTF8 problems +# Fixes bug with authorities +# SQL database major changes. +# Separate biblioograaphic and holdings records. Biblioitems table depreceated +# etc. etc. +# Wait for explanatory document on koha-devel # # Revision 1.13 2004/03/11 16:06:20 tipaul # *** empty log message *** diff --git a/C4/Bookfund.pm b/C4/Bookfund.pm index 5e7a0de386..257075a624 100755 --- a/C4/Bookfund.pm +++ b/C4/Bookfund.pm @@ -273,7 +273,7 @@ sub GetBookFundBreakdown { my $query = " SELECT quantity,datereceived,freight,unitprice, listprice,ecost,quantityreceived AS qrev, - subscription,title,itemtype,aqorders.biblionumber, + subscription,biblio.title,itemtype,aqorders.biblionumber, aqorders.booksellerinvoicenumber, quantity-quantityreceived AS tleft, aqorders.ordernumber AS ordnum,entrydate,budgetdate, @@ -281,7 +281,7 @@ sub GetBookFundBreakdown { FROM aqorderbreakdown, aqbasket, aqorders - LEFT JOIN biblioitems ON biblioitems.biblioitemnumber=aqorders.biblioitemnumber + LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber WHERE bookfundid=? AND aqorders.ordernumber=aqorderbreakdown.ordernumber AND aqorders.basketno=aqbasket.basketno diff --git a/C4/Breeding.pm b/C4/Breeding.pm index 030da534f3..9dc55f30b4 100644 --- a/C4/Breeding.pm +++ b/C4/Breeding.pm @@ -19,9 +19,10 @@ package C4::Breeding; use strict; use C4::Biblio; +use C4::Search; use MARC::File::USMARC; +use MARC::Record; require Exporter; - use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # set the version for version checking @@ -32,8 +33,6 @@ $VERSION = 0.01; C4::Breeding : script to add a biblio in marc_breeding table. =head1 SYNOPSIS - - use C4::Scan; &ImportBreeding($marcrecords,$overwrite_biblio,$filename,$z3950random); C<$marcrecord> => the MARC::Record @@ -58,27 +57,33 @@ sub ImportBreeding { my ($marcrecords,$overwrite_biblio,$filename,$encoding,$z3950random) = @_; my @marcarray = split /\x1D/, $marcrecords; my $dbh = C4::Context->dbh; - my $searchisbn = $dbh->prepare("select biblioitemnumber from biblioitems where isbn=?"); - my $searchissn = $dbh->prepare("select biblioitemnumber from biblioitems where issn=?"); - my $searchbreeding = $dbh->prepare("select id from marc_breeding -where isbn=? and title=?"); - my $insertsql = $dbh->prepare("insert into marc_breeding (file,isbn,title,author,marc,encoding,z3950random) values(?,?,?,?,?,?,?)"); - my $replacesql = $dbh->prepare("update marc_breeding set file=?,isbn=?,title=?,author=?,marc=?,encoding=?,z3950random=? where id=?"); +my @kohafields; +my @values; +my @relations; +my $sort; +my @and_or; +my @results; +my $count; + my $searchbreeding = $dbh->prepare("select id from marc_breeding where isbn=? and title=?"); +my $findbreedingid = $dbh->prepare("select max(id) from marc_breeding"); + + my $insertsql = $dbh->prepare("insert into marc_breeding (file,isbn,title,author,marc,encoding,z3950random,classification,subclass) values(?,?,?,?,?,?,?,?,?)"); + my $replacesql = $dbh->prepare("update marc_breeding set file=?,isbn=?,title=?,author=?,marc=?,encoding=?,z3950random=?,classification=?,subclass=? where id=?"); $encoding = C4::Context->preference("marcflavour") unless $encoding; # fields used for import results my $imported=0; my $alreadyindb = 0; my $alreadyinfarm = 0; my $notmarcrecord = 0; + my $breedingid; for (my $i=0;$i<=$#marcarray;$i++) { - my $marcrecord = MARC::File::USMARC::decode($marcarray[$i]."\x1D"); + my $marcrecord = MARC::File::USMARC::decode($marcarray[$i]."\x1D","","UTF-8",1); my @warnings = $marcrecord->warnings(); if (scalar($marcrecord->fields()) == 0) { $notmarcrecord++; } else { + my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,''); - $oldbiblio->{title} = char_decode($oldbiblio->{title},$encoding); - $oldbiblio->{author} = char_decode($oldbiblio->{author},$encoding); # if isbn found and biblio does not exist, add it. If isbn found and biblio exists, overwrite or ignore depending on user choice # drop every "special" char : spaces, - ... $oldbiblio->{isbn} =~ s/ |-|\.//g, @@ -87,20 +92,27 @@ where isbn=? and title=?"); $oldbiblio->{issn} = substr($oldbiblio->{issn},0,10); # search if biblio exists my $biblioitemnumber; + if ( !$z3950random){ if ($oldbiblio->{isbn}) { - $searchisbn->execute($oldbiblio->{isbn}); - ($biblioitemnumber) = $searchisbn->fetchrow; + push @kohafields,"isbn"; + push @values,$oldbiblio->{isbn}; + push @relations,""; + push @and_or,""; + ($count,@results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations); } else { - if ($oldbiblio->{issn}) { - $searchissn->execute($oldbiblio->{issn}); - ($biblioitemnumber) = $searchissn->fetchrow; - } + push @kohafields,"issn"; + push @values,$oldbiblio->{issn}; + push @relations,""; + push @and_or,""; + $sort=""; + ($count,@results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations); } - if ($biblioitemnumber) { + } + if ($count>0 && !$z3950random) { $alreadyindb++; } else { # search in breeding farm - my $breedingid; + if ($oldbiblio->{isbn}) { $searchbreeding->execute($oldbiblio->{isbn},$oldbiblio->{title}); ($breedingid) = $searchbreeding->fetchrow; @@ -114,16 +126,18 @@ where isbn=? and title=?"); my $recoded; $recoded = $marcrecord->as_usmarc(); if ($breedingid && $overwrite_biblio eq 1) { - $replacesql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded,$encoding,$z3950random,$breedingid); + $replacesql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$marcarray[$i]."\x1D",$encoding,$z3950random,$oldbiblio->{classification},$oldbiblio->{subclass},$breedingid); } else { - $insertsql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded,$encoding,$z3950random); + $insertsql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$marcarray[$i]."\x1D",$encoding,$z3950random,$oldbiblio->{classification},$oldbiblio->{subclass}); + $findbreedingid->execute; + $breedingid=$findbreedingid->fetchrow; } $imported++; } } } } - return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported); + return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid); } @@ -147,7 +161,7 @@ sub BreedingSearch { my $sth; my @results; - $query = "Select id,file,isbn,title,author from marc_breeding where "; + $query = "Select id,file,isbn,title,author,classification,subclass from marc_breeding where "; if ($z3950random) { $query .= "z3950random = ?"; @bind=($z3950random); diff --git a/C4/Calendar.pm b/C4/Calendar/Calendar.pm similarity index 93% rename from C4/Calendar.pm rename to C4/Calendar/Calendar.pm index 73fe549c0c..14252945da 100644 --- a/C4/Calendar.pm +++ b/C4/Calendar/Calendar.pm @@ -1,562 +1,582 @@ -package C4::Calendar; - -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. -# -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA - -use strict; -require Exporter; -use vars qw($VERSION @EXPORT); - -use C4::Database; -use Date::Manip; -# use Date::Calc; - -# set the version for version checking -$VERSION = 0.01; - -=head1 NAME - -C4::Calendar::Calendar - Koha module dealing with holidays. - -=head1 SYNOPSIS - - use C4::Calendar::Calendar; - -=head1 DESCRIPTION - -This package is used to deal with holidays. Through this package, you can set all kind of holidays for the library. - -=head1 FUNCTIONS - -=over 2 - -=cut - -@EXPORT = qw(&new - &change_branchcode - &get_week_days_holidays - &get_day_month_holidays - &get_exception_holidays - &get_single_holidays - &insert_week_day_holiday - &insert_day_month_holiday - &insert_single_holiday - &insert_exception_holiday - &delete_holiday - &isHoliday - &addDate - &daysBetween); - -=item new - - $calendar = C4::Calendar::Calendar->new(branchcode => $branchcode); - -C<$branchcode> Is the branch code wich you want to use calendar. - -=cut - -sub new { - my $classname = shift @_; - my %options = @_; - - my %hash; - my $self = bless(\%hash, $classname); - - foreach my $optionName (keys %options) { - $self->{lc($optionName)} = $options{$optionName}; - } - - $self->_init; - - return $self; -} - -sub _init { - my $self = shift @_; - - my $dbh = C4::Context->dbh(); - my $week_days_sql = $dbh->prepare("select weekday, title, description from repeatable_holidays where ('$self->{branchcode}' = branchcode) and (NOT(ISNULL(weekday)))"); - $week_days_sql->execute; - my %week_days_holidays; - while (my ($weekday, $title, $description) = $week_days_sql->fetchrow) { - $week_days_holidays{$weekday}{title} = $title; - $week_days_holidays{$weekday}{description} = $description; - } - $week_days_sql->finish; - $self->{'week_days_holidays'} = \%week_days_holidays; - - my $day_month_sql = $dbh->prepare("select day, month, title, description from repeatable_holidays where ('$self->{branchcode}' = branchcode) and ISNULL(weekday)"); - $day_month_sql->execute; - my %day_month_holidays; - while (my ($day, $month, $title, $description) = $day_month_sql->fetchrow) { - $day_month_holidays{"$month/$day"}{title} = $title; - $day_month_holidays{"$month/$day"}{description} = $description; - } - $day_month_sql->finish; - $self->{'day_month_holidays'} = \%day_month_holidays; - - my $exception_holidays_sql = $dbh->prepare("select day, month, year, title, description from special_holidays where ('$self->{branchcode}' = branchcode) and (isexception = 1)"); - $exception_holidays_sql->execute; - my %exception_holidays; - while (my ($day, $month, $year, $title, $description) = $exception_holidays_sql->fetchrow) { - $exception_holidays{"$year/$month/$day"}{title} = $title; - $exception_holidays{"$year/$month/$day"}{description} = $description; - } - $exception_holidays_sql->finish; - $self->{'exception_holidays'} = \%exception_holidays; - - my $holidays_sql = $dbh->prepare("select day, month, year, title, description from special_holidays where ('$self->{branchcode}' = branchcode) and (isexception = 0)"); - $holidays_sql->execute; - my %single_holidays; - while (my ($day, $month, $year, $title, $description) = $holidays_sql->fetchrow) { - $single_holidays{"$year/$month/$day"}{title} = $title; - $single_holidays{"$year/$month/$day"}{description} = $description; - } - $holidays_sql->finish; - $self->{'single_holidays'} = \%single_holidays; -} - -=item change_branchcode - - $calendar->change_branchcode(branchcode => $branchcode) - -Change the calendar branch code. This means to change the holidays structure. - -C<$branchcode> Is the branch code wich you want to use calendar. - -=cut - -sub change_branchcode { - my ($self, $branchcode) = @_; - my %options = @_; - - foreach my $optionName (keys %options) { - $self->{lc($optionName)} = $options{$optionName}; - } - $self->_init; - - return $self; -} - -=item get_week_days_holidays - - $week_days_holidays = $calendar->get_week_days_holidays(); - -Returns a hash reference to week days holidays. - -=cut - -sub get_week_days_holidays { - my $self = shift @_; - my $week_days_holidays = $self->{'week_days_holidays'}; - return $week_days_holidays; -} - -=item get_day_month_holidays - - $day_month_holidays = $calendar->get_day_month_holidays(); - -Returns a hash reference to day month holidays. - -=cut - -sub get_day_month_holidays { - my $self = shift @_; - my $day_month_holidays = $self->{'day_month_holidays'}; - return $day_month_holidays; -} - -=item get_exception_holidays - - $exception_holidays = $calendar->exception_holidays(); - -Returns a hash reference to exception holidays. This kind of days are those -which stands for a holiday, but you wanted to make an exception for this particular -date. - -=cut - -sub get_exception_holidays { - my $self = shift @_; - my $exception_holidays = $self->{'exception_holidays'}; - return $exception_holidays; -} - -=item get_single_holidays - - $single_holidays = $calendar->get_single_holidays(); - -Returns a hash reference to single holidays. This kind of holidays are those which -happend just one time. - -=cut - -sub get_single_holidays { - my $self = shift @_; - my $single_holidays = $self->{'single_holidays'}; - return $single_holidays; -} - -=item insert_week_day_holiday - - insert_week_day_holiday(weekday => $weekday, - title => $title, - description => $description); - -Inserts a new week day for $self->{branchcode}. - -C<$day> Is the week day to make holiday. - -C<$title> Is the title to store for the holiday formed by $year/$month/$day. - -C<$description> Is the description to store for the holiday formed by $year/$month/$day. - -=cut - -sub insert_week_day_holiday { - my $self = shift @_; - my %options = @_; - - my $dbh = C4::Context->dbh(); - my $insertHoliday = $dbh->prepare("insert into repeatable_holidays (id,branchcode,weekday,day,month,title,description) values ('', '$self->{branchcode}', $options{weekday}, NULL, NULL, '$options{title}', '$options{description}')"); - $insertHoliday->execute; - $insertHoliday->finish; - - $self->{'week_days_holidays'}->{$options{weekday}}{title} = $options{title}; - $self->{'week_days_holidays'}->{$options{weekday}}{description} = $options{description}; - return $self; -} - -=item insert_day_month_holiday - - insert_day_month_holiday(day => $day, - month => $month, - title => $title, - description => $description); - -Inserts a new day month holiday for $self->{branchcode}. - -C<$day> Is the day month to make the date to insert. - -C<$month> Is month to make the date to insert. - -C<$title> Is the title to store for the holiday formed by $year/$month/$day. - -C<$description> Is the description to store for the holiday formed by $year/$month/$day. - -=cut - -sub insert_day_month_holiday { - my $self = shift @_; - my %options = @_; - - my $dbh = C4::Context->dbh(); - my $insertHoliday = $dbh->prepare("insert into repeatable_holidays (id,branchcode,weekday,day,month,title,description) values ('', '$self->{branchcode}', NULL, $options{day}, $options{month}, '$options{title}', '$options{description}')"); - $insertHoliday->execute; - $insertHoliday->finish; - - $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{title} = $options{title}; - $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{description} = $options{description}; - return $self; -} - -=item insert_single_holiday - - insert_single_holiday(day => $day, - month => $month, - year => $year, - title => $title, - description => $description); - -Inserts a new single holiday for $self->{branchcode}. - -C<$day> Is the day month to make the date to insert. - -C<$month> Is month to make the date to insert. - -C<$year> Is year to make the date to insert. - -C<$title> Is the title to store for the holiday formed by $year/$month/$day. - -C<$description> Is the description to store for the holiday formed by $year/$month/$day. - -=cut - -sub insert_single_holiday { - my $self = shift @_; - my %options = @_; - - my $dbh = C4::Context->dbh(); - my $isexception = 0; - my $insertHoliday = $dbh->prepare("insert into special_holidays (id,branchcode,day,month,year,isexception,title,description) values ('', '$self->{branchcode}', $options{day}, $options{month}, $options{year}, $isexception, '$options{title}', '$options{description}')"); - $insertHoliday->execute; - $insertHoliday->finish; - - $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title}; - $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; - return $self; -} - -=item insert_exception_holiday - - insert_exception_holiday(day => $day, - month => $month, - year => $year, - title => $title, - description => $description); - -Inserts a new exception holiday for $self->{branchcode}. - -C<$day> Is the day month to make the date to insert. - -C<$month> Is month to make the date to insert. - -C<$year> Is year to make the date to insert. - -C<$title> Is the title to store for the holiday formed by $year/$month/$day. - -C<$description> Is the description to store for the holiday formed by $year/$month/$day. - -=cut - -sub insert_exception_holiday { - my $self = shift @_; - my %options = @_; - - my $dbh = C4::Context->dbh(); - my $isexception = 1; - my $insertException = $dbh->prepare("insert into special_holidays (id,branchcode,day,month,year,isexception,title,description) values ('', '$self->{branchcode}', $options{day}, $options{month}, $options{year}, $isexception, '$options{title}', '$options{description}')"); - $insertException->execute; - $insertException->finish; - - $self->{'exceptions_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title}; - $self->{'exceptions_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; - return $self; -} - -=item delete_holiday - - delete_holiday(weekday => $weekday - day => $day, - month => $month, - year => $year); - -Delete a holiday for $self->{branchcode}. - -C<$weekday> Is the week day to delete. - -C<$day> Is the day month to make the date to delete. - -C<$month> Is month to make the date to delete. - -C<$year> Is year to make the date to delete. - -=cut - -sub delete_holiday { - my $self = shift @_; - my %options = @_; - - # Verify what kind of holiday that day is. For example, if it is - # a repeatable holiday, this should check if there are some exception - # for that holiday rule. Otherwise, if it is a regular holiday, it´s - # ok just deleting it. - - my $dbh = C4::Context->dbh(); - my $isSingleHoliday = $dbh->prepare("select id from special_holidays where (branchcode = '$self->{branchcode}') and (day = $options{day}) and (month = $options{month}) and (year = $options{year})"); - $isSingleHoliday->execute; - if ($isSingleHoliday->rows) { - my $id = $isSingleHoliday->fetchrow; - $isSingleHoliday->finish; # Close the last query - - my $deleteHoliday = $dbh->prepare("delete from special_holidays where (id = $id)"); - $deleteHoliday->execute; - $deleteHoliday->finish; # Close the last query - delete($self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}); - } else { - $isSingleHoliday->finish; # Close the last query - - my $isWeekdayHoliday = $dbh->prepare("select id from repeatable_holidays where (branchcode = '$self->{branchcode}') and (weekday = $options{weekday})"); - $isWeekdayHoliday->execute; - if ($isWeekdayHoliday->rows) { - my $id = $isWeekdayHoliday->fetchrow; - $isWeekdayHoliday->finish; # Close the last query - - my $updateExceptions = $dbh->prepare("update special_holidays set isexception = 0 where (WEEKDAY(CONCAT(special_holidays.year,'-',special_holidays.month,'-',special_holidays.day)) = $options{weekday}) and (branchcode = '$self->{branchcode}')"); - $updateExceptions->execute; - $updateExceptions->finish; # Close the last query - - my $deleteHoliday = $dbh->prepare("delete from repeatable_holidays where (id = $id)"); - $deleteHoliday->execute; - $deleteHoliday->finish; - delete($self->{'week_days_holidays'}->{$options{weekday}}); - } else { - $isWeekdayHoliday->finish; # Close the last query - - my $isDayMonthHoliday = $dbh->prepare("select id from repeatable_holidays where (branchcode = '$self->{branchcode}') (day = $options{day}) and (month = $options{month})"); - $isDayMonthHoliday->execute; - if ($isDayMonthHoliday->rows) { - my $id = $isDayMonthHoliday->fetchrow; - $isDayMonthHoliday->finish; - my $updateExceptions = $dbh->prepare("update special_holidays set isexception = 0 where (special_holidays.branchcode = '$self->{branchcode}') and (special_holidays.day = $options{day}) and (special_holidays.month = $options{month})"); - $updateExceptions->execute; - $updateExceptions->finish; # Close the last query - - my $deleteHoliday = $dbh->prepare("delete from repeatable_holidays where (id = $id)"); - $deleteHoliday->execute; - $deleteHoliday->finish; # Close the last query - $isDayMonthHoliday->finish; # Close the last query - delete($self->{'day_month_holidays'}->{"$options{month}/$options{day}"}); - } - } - } - return $self; -} - -=item isHoliday - - $isHoliday = isHoliday($day, $month $year); - - -C<$day> Is the day to check wether if is a holiday or not. - -C<$month> Is the month to check wether if is a holiday or not. - -C<$year> Is the year to check wether if is a holiday or not. - -=cut - -sub isHoliday { - my ($self, $day, $month, $year) = @_; - - my $weekday = Date_DayOfWeek($month, $day, $year) % 7; - - my $weekDays = $self->get_week_days_holidays(); - my $dayMonths = $self->get_day_month_holidays(); - my $exceptions = $self->get_exception_holidays(); - my $singles = $self->get_single_holidays(); - - if (defined($exceptions->{"$year/$month/$day"})) { - return 0; - } else { - if ((exists($weekDays->{$weekday})) || - (exists($dayMonths->{"$month/$day"})) || - (exists($singles->{"$year/$month/$day"}))) { - return 1; - } else { - return 0; - } - } - -} - -=item addDate - - my ($day, $month, $year) = $calendar->addDate($day, $month, $year, $offset) - -C<$day> Is the starting day of the interval. - -C<$month> Is the starting month of the interval. - -C<$year> Is the starting year of the interval. - -C<$offset> Is the number of days that this function has to count from $date. - -=cut - -sub addDate { - my ($self, $day, $month, $year, $offset) = @_; - - if ($offset < 0) { # In case $offset is negative - $offset = $offset*(-1); - } - - my $daysMode = C4::Context->preference('useDaysMode'); - if ($daysMode eq 'normal') { - ($year, $month, $day) = &Date::Calc::Add_Delta_Days($year, $month, $day, ($offset - 1)); - } else { - while ($offset > 0) { - if (!($self->isHoliday($day, $month, $year))) { - $offset = $offset - 1; - } - if ($offset > 0) { - ($year, $month, $day) = &Date::Calc::Add_Delta_Days($year, $month, $day, 1); - } - } - } - - return($day, $month, $year); -} - -=item daysBetween - - my $daysBetween = $calendar->daysBetween($dayFrom, $monthFrom, $yearFrom, - $dayTo, $monthTo, $yearTo) - -C<$dayFrom> Is the starting day of the interval. - -C<$monthFrom> Is the starting month of the interval. - -C<$yearFrom> Is the starting year of the interval. - -C<$dayTo> Is the ending day of the interval. - -C<$monthTo> Is the ending month of the interval. - -C<$yearTo> Is the ending year of the interval. - -=cut - -sub daysBetween { - my ($self, $dayFrom, $monthFrom, $yearFrom, $dayTo, $monthTo, $yearTo) = @_; - - my $daysMode = C4::Context->preference('useDaysMode'); - my $count = 1; - my $continue = 1; - if ($daysMode eq 'normal') { - while ($continue) { - if (($yearFrom != $yearTo) || ($monthFrom != $monthTo) || ($dayFrom != $dayTo)) { - ($yearFrom, $monthFrom, $dayFrom) = &Date::Calc::Add_Delta_Days($yearFrom, $monthFrom, $dayFrom, 1); - $count++; - } else { - $continue = 0; - } - } - } else { - while ($continue) { - if (($yearFrom != $yearTo) || ($monthFrom != $monthTo) || ($dayFrom != $dayTo)) { - if (!($self->isHoliday($dayFrom, $monthFrom, $yearFrom))) { - $count++; - } - ($yearFrom, $monthFrom, $dayFrom) = &Date::Calc::Add_Delta_Days($yearFrom, $monthFrom, $dayFrom, 1); - } else { - $continue = 0; - } - } - } - return($count); -} - -1; - -__END__ - -=back - -=head1 AUTHOR - -Koha Physics Library UNLP - +package C4::Calendar::Calendar; + +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +require Exporter; +use vars qw($VERSION @EXPORT); + +use C4::Context; + +#use Date::Calc; + +# set the version for version checking +$VERSION = 0.01; + +=head1 NAME + +C4::Calendar::Calendar - Koha module dealing with holidays. + +=head1 SYNOPSIS + + use C4::Calendar::Calendar; + +=head1 DESCRIPTION + +This package is used to deal with holidays. Through this package, you can set all kind of holidays for the library. + +=head1 FUNCTIONS + +=over 2 + +=cut + +@EXPORT = qw(&new + &change_branchcode + &get_week_days_holidays + &get_day_month_holidays + &get_exception_holidays + &get_single_holidays + &insert_week_day_holiday + &insert_day_month_holiday + &insert_single_holiday + &insert_exception_holiday + &delete_holiday + &isHoliday + &addDate + &daysBetween); + +=item new + + $calendar = C4::Calendar::Calendar->new(branchcode => $branchcode); + +C<$branchcode> Is the branch code wich you want to use calendar. + +=cut + +sub new { + my $classname = shift @_; + my %options = @_; + + my %hash; + my $self = bless(\%hash, $classname); + + foreach my $optionName (keys %options) { + $self->{lc($optionName)} = $options{$optionName}; + } + + $self->_init; + + return $self; +} + +sub _init { + my $self = shift @_; + + my $dbh = C4::Context->dbh(); + my $week_days_sql = $dbh->prepare("select weekday, title, description from repeatable_holidays where ('$self->{branchcode}' = branchcode) and (NOT(ISNULL(weekday)))"); + $week_days_sql->execute; + my %week_days_holidays; + while (my ($weekday, $title, $description) = $week_days_sql->fetchrow) { + $week_days_holidays{$weekday}{title} = $title; + $week_days_holidays{$weekday}{description} = $description; + } + $week_days_sql->finish; + $self->{'week_days_holidays'} = \%week_days_holidays; + + my $day_month_sql = $dbh->prepare("select day, month, title, description from repeatable_holidays where ('$self->{branchcode}' = branchcode) and ISNULL(weekday)"); + $day_month_sql->execute; + my %day_month_holidays; + while (my ($day, $month, $title, $description) = $day_month_sql->fetchrow) { + $day_month_holidays{"$month/$day"}{title} = $title; + $day_month_holidays{"$month/$day"}{description} = $description; + } + $day_month_sql->finish; + $self->{'day_month_holidays'} = \%day_month_holidays; + + my $exception_holidays_sql = $dbh->prepare("select day, month, year, title, description from special_holidays where ('$self->{branchcode}' = branchcode) and (isexception = 1)"); + $exception_holidays_sql->execute; + my %exception_holidays; + while (my ($day, $month, $year, $title, $description) = $exception_holidays_sql->fetchrow) { + $exception_holidays{"$year/$month/$day"}{title} = $title; + $exception_holidays{"$year/$month/$day"}{description} = $description; + } + $exception_holidays_sql->finish; + $self->{'exception_holidays'} = \%exception_holidays; + + my $holidays_sql = $dbh->prepare("select day, month, year, title, description from special_holidays where ('$self->{branchcode}' = branchcode) and (isexception = 0)"); + $holidays_sql->execute; + my %single_holidays; + while (my ($day, $month, $year, $title, $description) = $holidays_sql->fetchrow) { + $single_holidays{"$year/$month/$day"}{title} = $title; + $single_holidays{"$year/$month/$day"}{description} = $description; + } + $holidays_sql->finish; + $self->{'single_holidays'} = \%single_holidays; +} + +=item change_branchcode + + $calendar->change_branchcode(branchcode => $branchcode) + +Change the calendar branch code. This means to change the holidays structure. + +C<$branchcode> Is the branch code wich you want to use calendar. + +=cut + +sub change_branchcode { + my ($self, $branchcode) = @_; + my %options = @_; + + foreach my $optionName (keys %options) { + $self->{lc($optionName)} = $options{$optionName}; + } + $self->_init; + + return $self; +} + +=item get_week_days_holidays + + $week_days_holidays = $calendar->get_week_days_holidays(); + +Returns a hash reference to week days holidays. + +=cut + +sub get_week_days_holidays { + my $self = shift @_; + my $week_days_holidays = $self->{'week_days_holidays'}; + return $week_days_holidays; +} + +=item get_day_month_holidays + + $day_month_holidays = $calendar->get_day_month_holidays(); + +Returns a hash reference to day month holidays. + +=cut + +sub get_day_month_holidays { + my $self = shift @_; + my $day_month_holidays = $self->{'day_month_holidays'}; + return $day_month_holidays; +} + +=item get_exception_holidays + + $exception_holidays = $calendar->exception_holidays(); + +Returns a hash reference to exception holidays. This kind of days are those +which stands for a holiday, but you wanted to make an exception for this particular +date. + +=cut + +sub get_exception_holidays { + my $self = shift @_; + my $exception_holidays = $self->{'exception_holidays'}; + return $exception_holidays; +} + +=item get_single_holidays + + $single_holidays = $calendar->get_single_holidays(); + +Returns a hash reference to single holidays. This kind of holidays are those which +happend just one time. + +=cut + +sub get_single_holidays { + my $self = shift @_; + my $single_holidays = $self->{'single_holidays'}; + return $single_holidays; +} + +=item insert_week_day_holiday + + insert_week_day_holiday(weekday => $weekday, + title => $title, + description => $description); + +Inserts a new week day for $self->{branchcode}. + +C<$day> Is the week day to make holiday. + +C<$title> Is the title to store for the holiday formed by $year/$month/$day. + +C<$description> Is the description to store for the holiday formed by $year/$month/$day. + +=cut + +sub insert_week_day_holiday { + my $self = shift @_; + my %options = @_; + + my $dbh = C4::Context->dbh(); + my $insertHoliday = $dbh->prepare("insert into repeatable_holidays (id,branchcode,weekday,day,month,title,description) values ('', '$self->{branchcode}', $options{weekday}, NULL, NULL, '$options{title}', '$options{description}')"); + $insertHoliday->execute; + $insertHoliday->finish; + + $self->{'week_days_holidays'}->{$options{weekday}}{title} = $options{title}; + $self->{'week_days_holidays'}->{$options{weekday}}{description} = $options{description}; + return $self; +} + +=item insert_day_month_holiday + + insert_day_month_holiday(day => $day, + month => $month, + title => $title, + description => $description); + +Inserts a new day month holiday for $self->{branchcode}. + +C<$day> Is the day month to make the date to insert. + +C<$month> Is month to make the date to insert. + +C<$title> Is the title to store for the holiday formed by $year/$month/$day. + +C<$description> Is the description to store for the holiday formed by $year/$month/$day. + +=cut + +sub insert_day_month_holiday { + my $self = shift @_; + my %options = @_; + + my $dbh = C4::Context->dbh(); + my $insertHoliday = $dbh->prepare("insert into repeatable_holidays (id,branchcode,weekday,day,month,title,description) values ('', '$self->{branchcode}', NULL, $options{day}, $options{month}, '$options{title}', '$options{description}')"); + $insertHoliday->execute; + $insertHoliday->finish; + + $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{title} = $options{title}; + $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{description} = $options{description}; + return $self; +} + +=item insert_single_holiday + + insert_single_holiday(day => $day, + month => $month, + year => $year, + title => $title, + description => $description); + +Inserts a new single holiday for $self->{branchcode}. + +C<$day> Is the day month to make the date to insert. + +C<$month> Is month to make the date to insert. + +C<$year> Is year to make the date to insert. + +C<$title> Is the title to store for the holiday formed by $year/$month/$day. + +C<$description> Is the description to store for the holiday formed by $year/$month/$day. + +=cut + +sub insert_single_holiday { + my $self = shift @_; + my %options = @_; + + my $dbh = C4::Context->dbh(); + my $isexception = 0; + my $insertHoliday = $dbh->prepare("insert into special_holidays (id,branchcode,day,month,year,isexception,title,description) values ('', '$self->{branchcode}', $options{day}, $options{month}, $options{year}, $isexception, '$options{title}', '$options{description}')"); + $insertHoliday->execute; + $insertHoliday->finish; + + $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title}; + $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; + return $self; +} + +=item insert_exception_holiday + + insert_exception_holiday(day => $day, + month => $month, + year => $year, + title => $title, + description => $description); + +Inserts a new exception holiday for $self->{branchcode}. + +C<$day> Is the day month to make the date to insert. + +C<$month> Is month to make the date to insert. + +C<$year> Is year to make the date to insert. + +C<$title> Is the title to store for the holiday formed by $year/$month/$day. + +C<$description> Is the description to store for the holiday formed by $year/$month/$day. + +=cut + +sub insert_exception_holiday { + my $self = shift @_; + my %options = @_; + + my $dbh = C4::Context->dbh(); + my $isexception = 1; + my $insertException = $dbh->prepare("insert into special_holidays (id,branchcode,day,month,year,isexception,title,description) values ('', '$self->{branchcode}', $options{day}, $options{month}, $options{year}, $isexception, '$options{title}', '$options{description}')"); + $insertException->execute; + $insertException->finish; + + $self->{'exceptions_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title}; + $self->{'exceptions_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; + return $self; +} + +=item delete_holiday + + delete_holiday(weekday => $weekday + day => $day, + month => $month, + year => $year); + +Delete a holiday for $self->{branchcode}. + +C<$weekday> Is the week day to delete. + +C<$day> Is the day month to make the date to delete. + +C<$month> Is month to make the date to delete. + +C<$year> Is year to make the date to delete. + +=cut + +sub delete_holiday { + my $self = shift @_; + my %options = @_; + + # Verify what kind of holiday that day is. For example, if it is + # a repeatable holiday, this should check if there are some exception + # for that holiday rule. Otherwise, if it is a regular holiday, it´s + # ok just deleting it. + + my $dbh = C4::Context->dbh(); + my $isSingleHoliday = $dbh->prepare("select id from special_holidays where (branchcode = '$self->{branchcode}') and (day = $options{day}) and (month = $options{month}) and (year = $options{year})"); + $isSingleHoliday->execute; + if ($isSingleHoliday->rows) { + my $id = $isSingleHoliday->fetchrow; + $isSingleHoliday->finish; # Close the last query + + my $deleteHoliday = $dbh->prepare("delete from special_holidays where (id = $id)"); + $deleteHoliday->execute; + $deleteHoliday->finish; # Close the last query + delete($self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}); + } else { + $isSingleHoliday->finish; # Close the last query + + my $isWeekdayHoliday = $dbh->prepare("select id from repeatable_holidays where (branchcode = '$self->{branchcode}') and (weekday = $options{weekday})"); + $isWeekdayHoliday->execute; + if ($isWeekdayHoliday->rows) { + my $id = $isWeekdayHoliday->fetchrow; + $isWeekdayHoliday->finish; # Close the last query + + my $updateExceptions = $dbh->prepare("update special_holidays set isexception = 0 where (WEEKDAY(CONCAT(special_holidays.year,'-',special_holidays.month,'-',special_holidays.day)) = $options{weekday}) and (branchcode = '$self->{branchcode}')"); + $updateExceptions->execute; + $updateExceptions->finish; # Close the last query + + my $deleteHoliday = $dbh->prepare("delete from repeatable_holidays where (id = $id)"); + $deleteHoliday->execute; + $deleteHoliday->finish; + delete($self->{'week_days_holidays'}->{$options{weekday}}); + } else { + $isWeekdayHoliday->finish; # Close the last query + + my $isDayMonthHoliday = $dbh->prepare("select id from repeatable_holidays where (branchcode = '$self->{branchcode}') (day = $options{day}) and (month = $options{month})"); + $isDayMonthHoliday->execute; + if ($isDayMonthHoliday->rows) { + my $id = $isDayMonthHoliday->fetchrow; + $isDayMonthHoliday->finish; + my $updateExceptions = $dbh->prepare("update special_holidays set isexception = 0 where (special_holidays.branchcode = '$self->{branchcode}') and (special_holidays.day = $options{day}) and (special_holidays.month = $options{month})"); + $updateExceptions->execute; + $updateExceptions->finish; # Close the last query + + my $deleteHoliday = $dbh->prepare("delete from repeatable_holidays where (id = $id)"); + $deleteHoliday->execute; + $deleteHoliday->finish; # Close the last query + $isDayMonthHoliday->finish; # Close the last query + delete($self->{'day_month_holidays'}->{"$options{month}/$options{day}"}); + } + } + } + return $self; +} + +=item isHoliday + + $isHoliday = isHoliday($day, $month $year); + + +C<$day> Is the day to check wether if is a holiday or not. + +C<$month> Is the month to check wether its a holiday or not. + +C<$year> Is the year to check wether if its a holiday or not. + +=cut + +sub isHoliday { + my ($self, $day, $month, $year) = @_; + + my $weekday = Date_DayOfWeek($month, $day, $year) % 7; + my $weekDays = $self->get_week_days_holidays(); + my $dayMonths = $self->get_day_month_holidays(); + my $exceptions = $self->get_exception_holidays(); + my $singles = $self->get_single_holidays(); + + if (defined($exceptions->{"$year/$month/$day"})) { + return 0; + } else { + if ((exists($weekDays->{$weekday})) || + (exists($dayMonths->{"$month/$day"})) || + (exists($singles->{"$year/$month/$day"}))) { + return 1; + } else { + return 0; + } + } + +} + +=item addDate + + my ($day, $month, $year) = $calendar->addDate($day, $month, $year, $offset) + +C<$day> Is the starting day of the interval. + +C<$month> Is the starting month of the interval. + +C<$year> Is the starting year of the interval. + +C<$offset> Is the number of days that this function has to count from $date. + +=cut + +sub addDate { + my ($self, $day, $month, $year, $offset) = @_; + if ($offset < 0) { # In case $offset is negative + $offset = $offset*(-1); + } + + my $daysMode = C4::Context->preference('useDaysMode'); + if ($daysMode eq 'normal') { + ($year, $month, $day) = Add_Delta_Days($year, $month, $day, ($offset - 1)); + } else { + while ($offset > 0) { + if (!($self->isHoliday($day, $month, $year))) { + $offset = $offset - 1; + } + if ($offset > 0) { + ($year, $month, $day) = Add_Delta_Days($year, $month, $day, 1); + } + } + } + return($day, $month, $year); +} + +=item daysBetween + + my $daysBetween = $calendar->daysBetween($dayFrom, $monthFrom, $yearFrom, + $dayTo, $monthTo, $yearTo) + +C<$dayFrom> Is the starting day of the interval. + +C<$monthFrom> Is the starting month of the interval. + +C<$yearFrom> Is the starting year of the interval. + +C<$dayTo> Is the ending day of the interval. + +C<$monthTo> Is the ending month of the interval. + +C<$yearTo> Is the ending year of the interval. + +=cut + +sub daysBetween { + my ($self, $dayFrom, $monthFrom, $yearFrom, $dayTo, $monthTo, $yearTo) = @_; + + my $daysMode = C4::Context->preference('useDaysMode'); + my $count = 1; + my $continue = 1; + if ($daysMode eq 'normal') { + while ($continue) { + if (($yearFrom != $yearTo) || ($monthFrom != $monthTo) || ($dayFrom != $dayTo)) { + ($yearFrom, $monthFrom, $dayFrom) = Add_Delta_Days($yearFrom, $monthFrom, $dayFrom, 1); + $count++; + } else { + $continue = 0; + } + } + } else { + while ($continue) { + if (($yearFrom != $yearTo) || ($monthFrom != $monthTo) || ($dayFrom != $dayTo)) { + if (!($self->isHoliday($dayFrom, $monthFrom, $yearFrom))) { + $count++; + } + ($yearFrom, $monthFrom, $dayFrom) = Add_Delta_Days($yearFrom, $monthFrom, $dayFrom, 1); + } else { + $continue = 0; + } + } + } + return($count); +} + +sub Date_DayOfWeek{ +my ($month, $day, $year)=@_; +my $date=$year."-".$month."-".$day; +my $dbh=C4::Context->dbh; +my $sth=$dbh->prepare("SELECT DAYOFWEEK(?)"); +$sth->execute($date); +my $dayofweek=$sth->fetchrow; +return $dayofweek; +} + +sub Add_Delta_Days{ +my ($year, $month, $day, $offset)=@_; +my $date=$year."-".$month."-".$day; +my $dbh=C4::Context->dbh; +my $sth=$dbh->prepare(" SELECT DATE_ADD(?, INTERVAL ? DAY)"); +$sth->execute($date,$offset); + $date=$sth->fetchrow; + ($year, $month, $day)=split /-/,$date; +return ($year, $month, $day); +} + + + +1; + +__END__ + +=back + +=head1 AUTHOR + +Koha Physics Library UNLP +Modified by Tumer Garip NUE Grand Library --No more Date::Manip =cut \ No newline at end of file diff --git a/C4/Circulation/Circ2.pm b/C4/Circulation/Circ2.pm index 3d1ba9529d..53313206d2 100755 --- a/C4/Circulation/Circ2.pm +++ b/C4/Circulation/Circ2.pm @@ -29,15 +29,16 @@ package C4::Circulation::Circ2; use strict; # use warnings; require Exporter; -use DBI; + use C4::Context; use C4::Stats; use C4::Reserves2; use C4::Koha; use C4::Accounts2; use C4::Biblio; -use Date::Manip; -use C4::Biblio; +use C4::Calendar::Calendar; +use C4::Search; +use C4::Members; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @@ -66,223 +67,203 @@ Also deals with stocktaking. @ISA = qw(Exporter); @EXPORT = qw( - &getpatroninformation - ¤tissues - &getissues - &getiteminformation - &renewstatus - &renewbook - &canbookbeissued - &issuebook - &returnbook - &find_reserves - &transferbook - &decode - &calc_charges - &listitemsforinventory - &itemseen - &fixdate - get_current_return_date_of + ¤tissues + &getissues + &getiteminformation + &renewstatus + &renewbook + &canbookbeissued + &issuebook + &returnbook + &find_reserves + &transferbook + &decode + &calc_charges + &listitemsforinventory + &itemseen + &fixdate + &itemissues + &patronflags + get_current_return_date_of get_transfert_infos &checktransferts &GetReservesForBranch &GetReservesToBranch &GetTransfersFromBib - &getBranchIp - &dotranfer - ); -# &GetBranches &getprinters &getbranch &getprinter => moved to C4::Koha.pm - -=head2 itemseen + &getBranchIp); -&itemseen($itemnum) -Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking -C<$itemnum> is the item number - -=cut +# &getbranches &getprinters &getbranch &getprinter => moved to C4::Koha.pm +=item itemissues -sub itemseen { - my ($itemnum) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("update items set itemlost=0, datelastseen = now() where items.itemnumber = ?"); - $sth->execute($itemnum); - return; -} + @issues = &itemissues($biblionumber, $biblio); -=head2 itemborrowed +Looks up information about who has borrowed the bookZ<>(s) with the +given biblionumber. -&itemseen($itemnum) -Mark item as borrowed. Is called when an item is issued. -C<$itemnum> is the item number +C<$biblio> is ignored. -=cut - -sub itemborrowed { - my ($itemnum) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("update items set itemlost=0, datelastborrowed = now() where items.itemnumber = ?"); - $sth->execute($itemnum); - return; -} - -sub listitemsforinventory { - my ($minlocation,$maxlocation,$datelastseen,$offset,$size) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("select itemnumber,barcode,itemcallnumber,title,author from items,biblio where items.biblionumber=biblio.biblionumber and itemcallnumber>= ? and itemcallnumber <=? and (datelastseen< ? or datelastseen is null) order by itemcallnumber,title"); - $sth->execute($minlocation,$maxlocation,$datelastseen); - my @results; - while (my $row = $sth->fetchrow_hashref) { - $offset-- if ($offset); - if ((!$offset) && $size) { - push @results,$row; - $size--; - } - } - return \@results; -} - -=head2 getpatroninformation - - ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, $cardnumber); - -Looks up a patron and returns information about him or her. If -C<$borrowernumber> is true (nonzero), C<&getpatroninformation> looks -up the borrower by number; otherwise, it looks up the borrower by card -number. - -C<$env> is effectively ignored, but should be a reference-to-hash. - -C<$borrower> is a reference-to-hash whose keys are the fields of the -borrowers table in the Koha database. In addition, -C<$borrower-E{flags}> is a hash giving more detailed information -about the patron. Its keys act as flags : - - if $borrower->{flags}->{LOST} { - # Patron's card was reported lost - } - -Each flag has a C key, giving a human-readable explanation of -the flag. If the state of a flag means that the patron should not be -allowed to borrow any more books, then it will have a C key -with a true value. - -The possible flags are: - -=head3 CHARGES +C<&itemissues> returns an array of references-to-hash. The keys +include the fields from the C table in the Koha database. +Additional keys include: =over 4 -Shows the patron's credit or debt, if any. - -=back - -=head3 GNA - -=over 4 - -(Gone, no address.) Set if the patron has left without giving a -forwarding address. - -=back - -=head3 LOST +=item C -=over 4 +If the item is currently on loan, this gives the due date. -Set if the patron's card has been reported as lost. +If the item is not on loan, then this is either "Available" or +"Cancelled", if the item has been withdrawn. -=back +=item C -=head3 DBARRED +If the item is currently on loan, this gives the card number of the +patron who currently has the item. -=over 4 +=item C, C, C -Set if the patron has been debarred. +These give the timestamp for the last three times the item was +borrowed. -=back +=item C, C, C -=head3 NOTES +The card number of the last three patrons who borrowed this item. -=over 4 +=item C, C, C -Any additional notes about the patron. +The borrower number of the last three patrons who borrowed this item. =back -=head3 ODUES - -=over 4 - -Set if the patron has overdue items. This flag has several keys: - -C<$flags-E{ODUES}{itemlist}> is a reference-to-array listing the -overdue items. Its elements are references-to-hash, each describing an -overdue item. The keys are selected fields from the issues, biblio, -biblioitems, and items tables of the Koha database. +=cut +#' +sub itemissues { + my ($dbh,$data, $biblio)=@_; + + my $sth = $dbh->prepare("Select * from items where items.biblionumber = ?"); + + my $i = 0; + my @results; + + $sth->execute($biblio); + + + # Find out who currently has this item. + # FIXME - Wouldn't it be better to do this as a left join of + # some sort? Currently, this code assumes that if + # fetchrow_hashref() fails, then the book is on the shelf. + # fetchrow_hashref() can fail for any number of reasons (e.g., + # database server crash), not just because no items match the + # search criteria. + my $sth2 = $dbh->prepare("select * from issues,borrowers +where itemnumber = ? +and returndate is NULL +and issues.borrowernumber = borrowers.borrowernumber"); + + $sth2->execute($data->{'itemnumber'}); + if (my $data2 = $sth2->fetchrow_hashref) { + + $data->{'date_due'} = $data2->{'date_due'}; + $data->{'datelastborrowed'} = $data2->{'issue_date'}; + $data->{'card'} = $data2->{'cardnumber'}; + $data->{'borrower'} = $data2->{'borrowernumber'}; + } -C<$flags-E{ODUES}{itemlist}> is a string giving a text listing of -the overdue items, one per line. + $sth2->finish; -=back + # Find the last 2 people who borrowed this item. + $sth2 = $dbh->prepare("select * from issues, borrowers + where itemnumber = ? + and issues.borrowernumber = borrowers.borrowernumber + and returndate is not NULL + order by returndate desc,timestamp desc ,limit 2") ; + $sth2->execute($data->{'itemnumber'}) ; +# for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item +my $i2=0; + while (my $data2 = $sth2->fetchrow_hashref) { + $data->{"timestamp$i2"} = $data2->{'timestamp'}; + $data->{"card$i2"} = $data2->{'cardnumber'}; + $data->{"borrower$i2"} = $data2->{'borrowernumber'}; +$data->{'datelastborrowed'} = $data2->{'issue_date'} unless $data->{'datelastborrowed'}; + $i2++; + } # while +# } # for -=head3 WAITING + $sth2->finish; + -=over 4 + $sth->finish; + return($data); +} -Set if any items that the patron has reserved are available. -C<$flags-E{WAITING}{itemlist}> is a reference-to-array listing the -available items. Each element is a reference-to-hash whose keys are -fields from the reserves table of the Koha database. -=back +=head2 itemseen -=back +&itemseen($dbh,$itemnum) +Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking +C<$itemnum> is the item number =cut +sub itemseen { + my ($dbh,$itemnumber) = @_; +my $sth=$dbh->prepare("select biblionumber from items where itemnumber=?"); + $sth->execute($itemnumber); +my ($biblionumber)=$sth->fetchrow; +MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'itemlost',"0",1); +# find today's date +my ($sec,$min,$hour,$mday,$mon,$year) = localtime(); + $year += 1900; + $mon += 1; + my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0", + $year,$mon,$mday,$hour,$min,$sec); +MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'datelastseen', $timestamp); +} +sub itemseenbarcode { + my ($dbh,$barcode) = @_; +my $sth=$dbh->prepare("select biblionumber,itemnumber from items where barcode=$barcode"); + $sth->execute(); +my ($biblionumber,$itemnumber)=$sth->fetchrow; +MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'itemlost',"0",1); +my ($sec,$min,$hour,$mday,$mon,$year) = localtime(); + $year += 1900; + $mon += 1; +my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",$year,$mon,$mday,$hour,$min,$sec); +MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'datelastseen', $timestamp); +} -sub getpatroninformation { -# returns - my ($env, $borrowernumber,$cardnumber) = @_; - my $dbh = C4::Context->dbh; - my $query; - my $sth; - if ($borrowernumber) { - $sth = $dbh->prepare("select * from borrowers where borrowernumber=?"); - $sth->execute($borrowernumber); - } elsif ($cardnumber) { - $sth = $dbh->prepare("select * from borrowers where cardnumber=?"); - $sth->execute($cardnumber); - } else { - $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine"; - return(); - } - my $borrower = $sth->fetchrow_hashref; - my $amount = checkaccount($env, $borrowernumber, $dbh); - $borrower->{'amountoutstanding'} = $amount; - my $flags = patronflags($env, $borrower, $dbh); - my $accessflagshash; - - $sth=$dbh->prepare("select bit,flag from userflags"); - $sth->execute; - while (my ($bit, $flag) = $sth->fetchrow) { - if ($borrower->{'flags'} && $borrower->{'flags'} & 2**$bit) { - $accessflagshash->{$flag}=1; - } +sub listitemsforinventory { + my ($minlocation,$datelastseen,$offset,$size) = @_; + my $count=0; + my @results; + my @kohafields; + my @values; + my @relations; + my $sort; + my @and_or; + if ($datelastseen){ + push @kohafields, "classification","datelastseen"; + push @values,$minlocation,$datelastseen; + push @relations,"\@attr 5=1 \@attr 6=3 \@attr 4=1 ","\@attr 2=1 "; + push @and_or,"\@and"; + $sort="lcsort"; + ($count,@results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations,$sort,\@and_or,0,"",$offset,$size); + }else{ + push @kohafields, "classification"; + push @values,$minlocation; + push @relations,"\@attr 5=1 \@attr 6=3 \@attr 4=1 "; + push @and_or,""; + $sort="lcsort"; + ($count,@results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations,$sort,\@and_or,0,"",$offset,$size); } - $sth->finish; - $borrower->{'flags'}=$flags; - $borrower->{'authflags'} = $accessflagshash; - - # find out how long the membership lasts - my $sth=$dbh->prepare("select enrolmentperiod from categories where categorycode = ?"); - $sth->execute($borrower->{'categorycode'}); - my $enrolment = $sth->fetchrow; - $borrower->{'enrolmentperiod'} = $enrolment; - return ($borrower); #, $flags, $accessflagshash); + + return @results; } + + + =head2 decode =over 4 @@ -368,37 +349,20 @@ True if the item may not be borrowed. sub getiteminformation { -# returns a hash of item information given either the itemnumber or the barcode +# returns a hash of item information together with biblio given either the itemnumber or the barcode my ($env, $itemnumber, $barcode) = @_; - my $dbh = C4::Context->dbh; - my $sth; - if ($itemnumber) { - $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.itemnumber=? and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber"); - $sth->execute($itemnumber); - } elsif ($barcode) { - $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.barcode=? and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber"); - $sth->execute($barcode); - } else { - $env->{'apierror'}="getiteminformation() subroutine must be called with either an itemnumber or a barcode"; - # Error condition. - return(); - } - my $iteminformation=$sth->fetchrow_hashref; - $sth->finish; + my $dbh=C4::Context->dbh; + my ($itemrecord)=MARCgetitem($dbh,$itemnumber,$barcode); + my $iteminformation=MARCmarc2koha($dbh,$itemrecord,"holdings"); +##Now get full biblio details from MARC if ($iteminformation) { - $sth=$dbh->prepare("select date_due from issues where itemnumber=? and isnull(returndate)"); - $sth->execute($iteminformation->{'itemnumber'}); - my ($date_due) = $sth->fetchrow; - $iteminformation->{'date_due'}=$date_due; - $sth->finish; - ($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}=''); - $sth=$dbh->prepare("select * from itemtypes where itemtype=?"); - $sth->execute($iteminformation->{'itemtype'}); - my $itemtype=$sth->fetchrow_hashref; - # if specific item notforloan, don't use itemtype notforloan field. - # otherwise, use itemtype notforloan value to see if item can be issued. - $iteminformation->{'notforloan'}=$itemtype->{'notforloan'} unless $iteminformation->{'notforloan'}; - $sth->finish; +my ($record)=MARCgetbiblio($dbh,$iteminformation->{'biblionumber'}); +my $biblio=MARCmarc2koha($dbh,$record,"biblios"); + foreach my $field (keys %$biblio){ + $iteminformation->{$field}=$biblio->{$field}; + } + $iteminformation->{'date_due'}="" if $iteminformation->{'date_due'} eq "0000-00-00"; + ($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}=''); } return($iteminformation); } @@ -462,28 +426,18 @@ The item was eligible to be transferred. Barring problems communicating with the =cut -#' -# FIXME - This function tries to do too much, and its API is clumsy. -# If it didn't also return books, it could be used to change the home -# branch of a book while the book is on loan. -# -# Is there any point in returning the item information? The caller can -# look that up elsewhere if ve cares. -# -# This leaves the ($dotransfer, $messages) tuple. This seems clumsy. -# If the transfer succeeds, that's all the caller should need to know. -# Thus, this function could simply return 1 or 0 to indicate success -# or failure, and set $C4::Circulation::Circ2::errmsg in case of -# failure. Or this function could return undef if successful, and an -# error message in case of failure (this would feel more like C than -# Perl, though). +##This routine is reverted to origional state +##This routine is used when a book physically arrives at a branch due to user returning it there +## so record the fact that holdingbranch is changed. sub transferbook { # transfer book code.... - my ($tbr, $barcode, $ignoreRs) = @_; + my ($tbr, $barcode, $ignoreRs,$user) = @_; my $messages; my %env; + my $dbh=C4::Context->dbh; my $dotransfer = 1; my $branches = GetBranches(); + my $iteminformation = getiteminformation(\%env, 0, $barcode); # bad barcode.. if (not $iteminformation) { @@ -515,55 +469,44 @@ sub transferbook { my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'}); if ($resfound and not $ignoreRs) { $resrec->{'ResFound'} = $resfound; -# $messages->{'ResFound'} = $resrec; - $dotransfer = 1; + $messages->{'ResFound'} = $resrec; + $dotransfer = 0; } - + #actually do the transfer.... if ($dotransfer) { - dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr); - my $dbh= C4::Context->dbh; - my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"items.holdingbranch"); - my $bibid = MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $iteminformation->{'biblionumber'} ); - my $marcitem = MARCgetitem($dbh, $bibid, $iteminformation->{'itemnumber'}); - if ($marcitem->field($tagfield)){ - $marcitem->field($tagfield)->update($tagsubfield=> $tbr); - MARCmoditem($dbh,$marcitem,$bibid,$iteminformation->{'itemnumber'}); - } + dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr,$user); $messages->{'WasTransfered'} = 1; } return ($dotransfer, $messages, $iteminformation); } # Not exported -# FIXME - This is only used in &transferbook. Why bother making it a -# separate function? + sub dotransfer { - my ($itm, $fbr, $tbr) = @_; +## The book has arrived at this branch because it has been returned there +## So we update the fact the book is in that branch not that we want to send the book to that branch + + my ($itm, $fbr, $tbr,$user) = @_; my $dbh = C4::Context->dbh; - $itm = $dbh->quote($itm); - $fbr = $dbh->quote($fbr); - $tbr = $dbh->quote($tbr); + #new entry in branchtransfers.... - $dbh->do("INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch) - VALUES ($itm, $fbr, now(), $tbr)"); + my $sth=$dbh->prepare("INSERT INTO branchtransfers (itemnumber, frombranch, datearrived, tobranch,comments) VALUES (?, ?, now(), ?,?)"); + $sth->execute($itm, $fbr, $tbr,$user); #update holdingbranch in items ..... - $dbh->do("UPDATE items set holdingbranch = $tbr WHERE items.itemnumber = $itm"); - &itemseen($itm); - &domarctransfer($dbh,$itm); + &domarctransfer($dbh,$itm,$tbr); +## Item seen taken out of this loop to optimize ZEBRA updates +# &itemseen($dbh,$itm); return; } -##New sub to dotransfer in marc tables as well. Not exported -TG 10/04/2006 sub domarctransfer{ - -my ($dbh,$itemnumber) = @_; -$itemnumber=~s /\'//g; ##itemnumber seems to come with quotes-TG -my $sth=$dbh->prepare("select biblionumber,holdingbranch from items where itemnumber=$itemnumber"); +my ($dbh,$itemnumber,$holdingbranch) = @_; +$itemnumber=~s /\'//g; +my $sth=$dbh->prepare("select biblionumber from items where itemnumber=$itemnumber"); $sth->execute(); -while (my ($biblionumber,$holdingbranch)=$sth->fetchrow ){ -&MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'items.holdingbranch',$holdingbranch,0); -} -return; +my ($biblionumber)=$sth->fetchrow; +MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'holdingbranch',$holdingbranch,1); + $sth->finish; } =head2 canbookbeissued @@ -657,51 +600,62 @@ if the borrower borrows to much things # check if a book can be issued. # returns an array with errors if any + + + + + + + + + + sub TooMany ($$){ my $borrower = shift; my $iteminformation = shift; my $cat_borrower = $borrower->{'categorycode'}; my $branch_borrower = $borrower->{'branchcode'}; my $dbh = C4::Context->dbh; - - - my $sth = $dbh->prepare('select itemtype from biblioitems where biblionumber = ?'); + my $sth = $dbh->prepare('select itemtype from biblio where biblionumber = ?'); $sth->execute($iteminformation->{'biblionumber'}); my $type = $sth->fetchrow; $sth = $dbh->prepare('select * from issuingrules where categorycode = ? and itemtype = ? and branchcode = ?'); -# my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s.biblioitemnumber and s.itemtype like ?"); - my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s1, items s2 where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s2.itemnumber and s1.itemtype like ? and s1.biblioitemnumber = s2.biblioitemnumber"); + my $sth2 = $dbh->prepare("select COUNT(*) from issues i, items it, biblio b where i.borrowernumber = ? and i.returndate is null and i.itemnumber = it.itemnumber and b.biblionumber=it.biblionumber and b.itemtype like ?"); my $sth3 = $dbh->prepare('select COUNT(*) from issues where borrowernumber = ? and returndate is null'); my $alreadyissued; + # check the 3 parameters + #print "content-type: text/plain \n\n"; + #print "$cat_borrower, $type, $branch_borrower"; $sth->execute($cat_borrower, $type, $branch_borrower); my $result = $sth->fetchrow_hashref; -# warn "==>".$result->{maxissueqty}; - - # Currently, using defined($result) ie on an entire hash reports whether memory - # for that aggregate has ever been allocated. As $result is used all over the place - # it would rarely return as undefined. - if (defined($result->{maxissueqty})) { - $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); - my $alreadyissued = $sth2->fetchrow; - if ($result->{'maxissueqty'} <= $alreadyissued){ - return ("a $alreadyissued / ".($result->{maxissueqty}+0)); - } else { + if (defined($result->{maxissueqty})) { + # print "content-type: text/plain \n\n"; + #print "$cat_borrower, $type, $branch_borrower"; + $sth2->execute($borrower->{'borrowernumber'}, $type); + my $alreadyissued = $sth2->fetchrow; + # print "***" . $alreadyissued; + #print "----". $result->{'maxissueqty'}; + if ($result->{'maxissueqty'} <= $alreadyissued) { + return ("a $alreadyissued /",($result->{'maxissueqty'}+0)); + }else { return; - } + } } + # check for branch=* $sth->execute($cat_borrower, $type, ""); - $result = $sth->fetchrow_hashref; - if (defined($result->{maxissueqty})) { - $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); + $result = $sth->fetchrow_hashref; + if (defined($result->{maxissueqty})) { + $sth2->execute($borrower->{'borrowernumber'}, $type); my $alreadyissued = $sth2->fetchrow; - if ($result->{'maxissueqty'} <= $alreadyissued){ + if ($result->{'maxissueqty'} <= $alreadyissued){ return ("b $alreadyissued / ".($result->{maxissueqty}+0)); } else { return; } } + # check for itemtype=* $sth->execute($cat_borrower, "*", $branch_borrower); $result = $sth->fetchrow_hashref; @@ -715,7 +669,8 @@ sub TooMany ($$){ return; } } - # check for borrowertype=* + + #check for borrowertype=* $sth->execute("*", $type, $branch_borrower); $result = $sth->fetchrow_hashref; if (defined($result->{maxissueqty})) { @@ -728,6 +683,7 @@ sub TooMany ($$){ } } + #check for borrowertype=*;itemtype=* $sth->execute("*", "*", $branch_borrower); $result = $sth->fetchrow_hashref; if (defined($result->{maxissueqty})) { @@ -779,6 +735,8 @@ sub TooMany ($$){ } + + sub canbookbeissued { my ($env,$borrower,$barcode,$year,$month,$day,$inprocess) = @_; my %needsconfirmation; # filled with problems that needs confirmations @@ -803,7 +761,7 @@ sub canbookbeissued { if ($borrower->{flags}->{'DBARRED'}) { $issuingimpossible{DEBARRED} = 1; } - if (&Date_Cmp(&ParseDate($borrower->{dateexpiry}),&ParseDate("today"))<0) { + if (DATE_diff($borrower->{expiry},'CURRENT_DATE')<0) { $issuingimpossible{EXPIRED} = 1; } # @@ -814,16 +772,17 @@ sub canbookbeissued { my $amount = checkaccount($env,$borrower->{'borrowernumber'}, $dbh,$duedate); if(C4::Context->preference("IssuingInProcess")){ my $amountlimit = C4::Context->preference("noissuescharge"); - if ($amount > $amountlimit && !$inprocess) { - $issuingimpossible{DEBT} = sprintf("%.2f",$amount); - } elsif ($amount <= $amountlimit && !$inprocess) { - $needsconfirmation{DEBT} = sprintf("%.2f",$amount); - } + if ($amount > $amountlimit && !$inprocess) { + $issuingimpossible{DEBT} = sprintf("%.2f",$amount); + } elsif ($amount <= $amountlimit && !$inprocess) { + $needsconfirmation{DEBT} = sprintf("%.2f",$amount); + } } else { - if ($amount >0) { - $needsconfirmation{DEBT} = $amount; - } - } + if ($amount >0) { + $needsconfirmation{DEBT} = $amount; + } + } + # # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS @@ -837,40 +796,45 @@ sub canbookbeissued { unless ($iteminformation->{barcode}) { $issuingimpossible{UNKNOWN_BARCODE} = 1; } - if ($iteminformation->{'notforloan'} && $iteminformation->{'notforloan'} > 0) { + if ($iteminformation->{'notforloan'} > 0) { $issuingimpossible{NOT_FOR_LOAN} = 1; } - if ($iteminformation->{'itemtype'} &&$iteminformation->{'itemtype'} eq 'REF') { + if ($iteminformation->{'itemtype'} eq 'REF') { $issuingimpossible{NOT_FOR_LOAN} = 1; } - if ($iteminformation->{'wthdrawn'} && $iteminformation->{'wthdrawn'} == 1) { + if ($iteminformation->{'wthdrawn'} == 1) { $issuingimpossible{WTHDRAWN} = 1; } - if ($iteminformation->{'restricted'} && $iteminformation->{'restricted'} == 1) { + if ($iteminformation->{'restricted'} == 1) { $issuingimpossible{RESTRICTED} = 1; } - if (C4::Context->preference("IndependantBranches")){ + if ($iteminformation->{'shelf'} eq 'Res') { + $issuingimpossible{IN_RESERVE} = 1; + } +if (C4::Context->preference("IndependantBranches")){ my $userenv = C4::Context->userenv; if (($userenv)&&($userenv->{flags} != 1)){ $issuingimpossible{NOTSAMEBRANCH} = 1 if ($iteminformation->{'holdingbranch'} ne $userenv->{branch} ) ; } } - - - # # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER # my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'}); - if ($currentborrower && $currentborrower eq $borrower->{'borrowernumber'}) { + if ($currentborrower eq $borrower->{'borrowernumber'}) { # Already issued to current borrower. Ask whether the loan should # be renewed. my ($renewstatus) = renewstatus($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); if ($renewstatus == 0) { # no more renewals allowed $issuingimpossible{NO_MORE_RENEWALS} = 1; } else { - # $needsconfirmation{RENEW_ISSUE} = 1; + if (C4::Context->preference("strictrenewals")){ + ###if this is set do not allow automatic renewals + ##the new renew script will do same strict checks as issues and return error codes + $needsconfirmation{RENEW_ISSUE} = 1; + } + } } elsif ($currentborrower) { # issued to someone else @@ -878,7 +842,7 @@ sub canbookbeissued { # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})"; $needsconfirmation{ISSUED_TO_ANOTHER} = "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})"; } -# See if the item is on reserve. +# See if the item is on RESERVE my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'}); if ($restype) { my $resbor = $res->{'borrowernumber'}; @@ -889,7 +853,7 @@ sub canbookbeissued { my $branches = GetBranches(); my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'}; $needsconfirmation{RESERVE_WAITING} = "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)"; - # CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't belong in a checking subroutine. + # CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); } elsif ($restype eq "Reserved") { # The item is on reserve for someone else. my ($resborrower, $flags)=getpatroninformation($env, $resbor,0); @@ -898,16 +862,14 @@ sub canbookbeissued { $needsconfirmation{RESERVED} = "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})"; } } - if(C4::Context->preference("LibraryName") eq "Horowhenua Library Trust"){ - if ($borrower->{'categorycode'} eq 'W'){ + if(C4::Context->preference("LibraryName") eq "Horowhenua Library Trust"){ + if ($borrower->{'categorycode'} eq 'W'){ my %issuingimpossible; - return(\%issuingimpossible,\%needsconfirmation); - } else { - return(\%issuingimpossible,\%needsconfirmation); - } - } else { - return(\%issuingimpossible,\%needsconfirmation); - } + return(\%issuingimpossible,\%needsconfirmation); + } + } + + return(\%issuingimpossible,\%needsconfirmation); } =head2 issuebook @@ -934,9 +896,9 @@ C<$date> contains the max date of return. calculated if empty. sub issuebook { my ($env,$borrower,$barcode,$date,$cancelreserve) = @_; my $dbh = C4::Context->dbh; -# my ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, 0); - my $iteminformation = getiteminformation($env, 0, $barcode); -# warn "B : ".$borrower->{borrowernumber}." / I : ".$iteminformation->{'itemnumber'}; + my ($itemrecord)=MARCgetitem($dbh,"",$barcode); + my $iteminformation=MARCmarc2koha($dbh,$itemrecord,"holdings"); + my $error; # # check if we just renew the issue. # @@ -948,7 +910,12 @@ sub issuebook { $iteminformation->{'charge'} = $charge; } &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'}); - renewbook($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); + if (C4::Context->preference("strictrenewals")){ + $error=renewstatus($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); + renewbook($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}) if ($error>1); + }else{ + renewbook($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); + } } else { # # NOT a renewal @@ -957,30 +924,33 @@ sub issuebook { # This book is currently on loan, but not to the person # who wants to borrow it now. mark it returned before issuing to the new borrower returnbook($iteminformation->{'barcode'}, $env->{'branchcode'}); +#warn "return : ".$borrower->{borrowernumber}." / I : ".$iteminformation->{'itemnumber'}; + } # See if the item is on reserve. my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'}); +#warn "$restype,$res"; if ($restype) { my $resbor = $res->{'borrowernumber'}; if ($resbor eq $borrower->{'borrowernumber'}) { # The item is on reserve to the current patron FillReserve($res); - warn "FillReserve"; +# warn "FillReserve"; } elsif ($restype eq "Waiting") { - warn "Waiting"; +# warn "Waiting"; # The item is on reserve and waiting, but has been # reserved by some other patron. my ($resborrower, $flags)=getpatroninformation($env, $resbor,0); my $branches = GetBranches(); my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'}; - if ($cancelreserve){ + if ($cancelreserve){ CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); - } else { + } else { # set waiting reserve to first in reserve queue as book isn't waiting now UpdateReserve(1, $res->{'biblionumber'}, $res->{'borrowernumber'}, $res->{'branchcode'}); } } elsif ($restype eq "Reserved") { -# warn "Reserved"; +#warn "Reserved"; # The item is on reserve for someone else. my ($resborrower, $flags)=getpatroninformation($env, $resbor,0); my $branches = GetBranches(); @@ -989,24 +959,31 @@ sub issuebook { # cancel reserves on this item CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); # also cancel reserve on biblio related to this item - #my $st_Fbiblio = $dbh->prepare("select biblionumber from items where itemnumber=?"); - #$st_Fbiblio->execute($res->{'itemnumber'}); - #my $biblionumber = $st_Fbiblio->fetchrow; - #CancelReserve($biblionumber,0,$res->{'borrowernumber'}); - #warn "CancelReserve $res->{'itemnumber'}, $res->{'borrowernumber'}"; + # my $st_Fbiblio = $dbh->prepare("select biblionumber from items where itemnumber=?"); + # $st_Fbiblio->execute($res->{'itemnumber'}); + # my $biblionumber = $st_Fbiblio->fetchrow; +# CancelReserve($iteminformation->{'biblionumber'},0,$res->{'borrowernumber'}); +# warn "CancelReserve $res->{'itemnumber'}, $res->{'borrowernumber'}"; } else { -# my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'}); -# transferbook($tobrcd,$barcode, 1); -# warn "transferbook"; + my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'}); + transferbook($tobrcd,$barcode, 1); + warn "transferbook"; } } } - # Record in the database the fact that the book was issued. - my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values (?,?,?,?)"); + + my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode,issue_date) values (?,?,?,?,NOW())"); my $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'}); - my $datedue=time+($loanlength)*86400; - my @datearr = localtime($datedue); - my $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3]; + my $dateduef; + my @datearr = localtime(); + $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-". $datearr[3]; + + my $calendar = C4::Calendar::Calendar->new(branchcode => $borrower->{'branchcode'}); + my ($yeardue, $monthdue, $daydue) = split /-/, $dateduef; + ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue, $monthdue, $yeardue, $loanlength); + $dateduef = "$yeardue-".sprintf ("%0.2d", $monthdue)."-". sprintf("%0.2d",$daydue); + +#warn $dateduef; if ($date) { $dateduef=$date; } @@ -1017,20 +994,30 @@ sub issuebook { $sth->execute($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}, $dateduef, $env->{'branchcode'}); $sth->finish; $iteminformation->{'issues'}++; - $sth=$dbh->prepare("update items set issues=?, holdingbranch=? where itemnumber=?"); - $sth->execute($iteminformation->{'issues'},C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'}); - $sth->finish; - &itemseen($iteminformation->{'itemnumber'}); - itemborrowed($iteminformation->{'itemnumber'}); +##Record in MARC the new data ,date_due as due date,issue count and the borrowernumber + &MARCkoha2marcOnefield($itemrecord, "issues", $iteminformation->{'issues'},"holdings"); + &MARCkoha2marcOnefield($itemrecord, "date_due", $dateduef,"holdings"); + &MARCkoha2marcOnefield($itemrecord, "borrowernumber", $borrower->{'borrowernumber'},"holdings"); + &MARCkoha2marcOnefield($itemrecord, "itemlost", "0","holdings"); + # find today's date as timestamp + my ($sec,$min,$hour,$mday,$mon,$year) = localtime(); + $year += 1900; + $mon += 1; + my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0", + $year,$mon,$mday,$hour,$min,$sec); + &MARCkoha2marcOnefield($itemrecord, "datelastseen", $timestamp,"holdings"); + ##Now update the zebradb + NEWmoditem($dbh,$itemrecord,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'}); # If it costs to borrow this book, charge it to the patron's account. my ($charge,$itemtype)=calc_charges($env, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}); if ($charge > 0) { createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge); $iteminformation->{'charge'}=$charge; } - # Record the fact that this book was issued. + # Record the fact that this book was issued in SQL &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'}); } +return($error); } =head2 getLoanLength @@ -1049,7 +1036,7 @@ sub getLoanLength { # check with borrowertype, itemtype and branchcode, then without one of those parameters $sth->execute($borrowertype,$itemtype,$branchcode); my $loanlength = $sth->fetchrow_hashref; - return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; + return $loanlength->{issuelength} if defined($loanlength); $sth->execute($borrowertype,$itemtype,""); $loanlength = $sth->fetchrow_hashref; @@ -1153,7 +1140,8 @@ sub returnbook { my $doreturn = 1; die '$branch not defined' unless defined $branch; # just in case (bug 170) # get information on item - my ($iteminformation) = getiteminformation(\%env, 0, $barcode); + my ($itemrecord)=MARCgetitem($dbh,"",$barcode); + my $iteminformation=MARCmarc2koha($dbh,$itemrecord,"holdings"); if (not $iteminformation) { $messages->{'BadBarcode'} = $barcode; $doreturn = 0; @@ -1167,7 +1155,7 @@ sub returnbook { # check if the book is in a permanent collection.... my $hbr = $iteminformation->{'homebranch'}; my $branches = GetBranches(); - if ($hbr && $branches->{$hbr}->{'PE'}) { + if ($branches->{$hbr}->{'PE'}) { $messages->{'IsPermanent'} = $hbr; } # check that the book has been cancelled @@ -1175,69 +1163,77 @@ sub returnbook { $messages->{'wthdrawn'} = 1; $doreturn = 0; } -# new op dev : if the book returned in an other branch update the holding branch - # update issues, thereby returning book (should push this out into another subroutine my ($borrower) = getpatroninformation(\%env, $currentborrower, 0); if ($doreturn) { my $sth = $dbh->prepare("update issues set returndate = now() where (borrowernumber = ?) and (itemnumber = ?) and (returndate is null)"); $sth->execute($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); - -# FIXME the holdingbranch is updated if the document is returned in an other location . - if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'}){ - my $sth_upd_location = $dbh->prepare("UPDATE items SET holdingbranch=? WHERE itemnumber=?"); - $sth_upd_location->execute(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'}); - $sth_upd_location->finish; - $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'}; - } - $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right? - } - itemseen($iteminformation->{'itemnumber'}); + + $sth->finish; + &MARCkoha2marcOnefield($itemrecord, "date_due", "","holdings"); + &MARCkoha2marcOnefield($itemrecord, "borrowernumber", "","holdings"); + } + my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1); + my ($sec,$min,$hour,$mday,$mon,$year) = localtime(); + $year += 1900; + $mon += 1; + my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0", + $year,$mon,$mday,$hour,$min,$sec); + &MARCkoha2marcOnefield($itemrecord, "datelastseen", $timestamp,"holdings"); + + ($borrower) = getpatroninformation(\%env, $currentborrower, 0); # transfer book to the current branch - -# FIXME function transfered still always used ???? -# my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1); -# if ($transfered) { -# $messages->{'WasTransfered'} = 1; # FIXME is the "= 1" right? -# } - + + if ($transfered) { + $messages->{'WasTransfered'} = 1; # FIXME is the "= 1" right? + } # fix up the accounts..... if ($iteminformation->{'itemlost'}) { fixaccountforlostandreturned($iteminformation, $borrower); $messages->{'WasLost'} = 1; # FIXME is the "= 1" right? - } + &MARCkoha2marcOnefield($itemrecord, "itemlost", "","holdings"); + } +####WARNING-- FIXME######### +### The following new script is commented out +## I did not understand what it is supposed to do. +## If a book is returned at one branch it is automatically recorded being in that branch by +## transferbook script. This scrip tries to find out whether it was sent thre +## Well whether sent or not it is physically there and transferbook records this fact in MARCrecord as well +## If this script is trying to do something else it should be uncommented and also add support for updating MARC record --TG # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # check if we have a transfer for this document - my $checktransfer = checktransferts($iteminformation->{'itemnumber'}); +# my $checktransfer = checktransferts($iteminformation->{'itemnumber'}); # if we have a return, we update the line of transfers with the datearrived - if ($checktransfer){ - my $sth = $dbh->prepare("update branchtransfers set datearrived = now() where itemnumber= ? AND datearrived IS NULL"); - $sth->execute($iteminformation->{'itemnumber'}); - $sth->finish; +# if ($checktransfer){ +# my $sth = $dbh->prepare("update branchtransfers set datearrived = now() where itemnumber= ? AND datearrived IS NULL"); +# $sth->execute($iteminformation->{'itemnumber'}); +# $sth->finish; # now we check if there is a reservation with the validate of transfer if we have one, we can set it with the status 'W' - my $updateWaiting = SetWaitingStatus($iteminformation->{'itemnumber'}); - } +# my $updateWaiting = SetWaitingStatus($iteminformation->{'itemnumber'}); +# } # if we don't have a transfer on run, we check if the document is not in his homebranch and there is not a reservation, we transfer this one to his home branch directly if system preference Automaticreturn is turn on . - else { - my $checkreserves = CheckReserves($iteminformation->{'itemnumber'}); - if (($iteminformation->{'homebranch'} ne $iteminformation->{'holdingbranch'}) and (not $checkreserves) and (C4::Context->preference("AutomaticItemReturn") == 1)){ - my $automatictransfer = dotransfer($iteminformation->{'itemnumber'},$iteminformation->{'holdingbranch'},$iteminformation->{'homebranch'}); - $messages->{'WasTransfered'} = 1; - } - } +# else { +# my $checkreserves = CheckReserves($iteminformation->{'itemnumber'}); +# if (($iteminformation->{'homebranch'} ne $iteminformation->{'holdingbranch'}) and (not $checkreserves) and (C4::Context->preference("AutomaticItemReturn") == 1)){ +# my $automatictransfer = dotransfer($iteminformation->{'itemnumber'},$iteminformation->{'holdingbranch'},$iteminformation->{'homebranch'}); +# $messages->{'WasTransfered'} = 1; +# } +# } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # fix up the overdues in accounts... fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); + &MARCkoha2marcOnefield($itemrecord, "itemoverdue", "","holdings"); # find reserves..... -# if we don't have a reserve with the status W, we launch the Checkreserves routine my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'}); if ($resfound) { # my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'}); $resrec->{'ResFound'} = $resfound; $messages->{'ResFound'} = $resrec; } + ##Now update the zebradb + NEWmoditem($dbh,$itemrecord,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'}); # update stats? # Record the fact that this book was returned. UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'}); @@ -1331,9 +1327,9 @@ sub fixaccountforlostandreturned { values (?,?,?,?)"); $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset); $usth->finish; - $usth = $dbh->prepare("update items set paidfor='' where itemnumber=?"); - $usth->execute($itm); - $usth->finish; +# $usth = $dbh->prepare("update items set paidfor='' where itemnumber=?"); +# $usth->execute($itm); +# $usth->finish; } $sth->finish; return; @@ -1359,7 +1355,7 @@ sub fixoverduesonreturn { $sth->execute($brn,$itm); # alter fine to show that the book has been returned if (my $data = $sth->fetchrow_hashref) { - my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (acccountno = ?)"); + my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)"); $usth->execute($brn,$itm,$data->{'accountno'}); $usth->finish(); } @@ -1367,7 +1363,7 @@ sub fixoverduesonreturn { return; } -# Not exported + # # NOTE!: If you change this function, be sure to update the POD for # &getpatroninformation. @@ -1400,7 +1396,7 @@ sub patronflags { # Original subroutine for Circ2.pm my %flags; my ($env, $patroninformation, $dbh) = @_; - my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh); + my $amount = C4::Accounts2::checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh); if ($amount > 0) { my %flaginfo; my $noissuescharge = C4::Context->preference("noissuescharge"); @@ -1414,25 +1410,25 @@ sub patronflags { $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount; $flags{'CHARGES'} = \%flaginfo; } - if ($patroninformation->{'gonenoaddress'} && $patroninformation->{'gonenoaddress'} == 1) { + if ($patroninformation->{'gonenoaddress'} == 1) { my %flaginfo; $flaginfo{'message'} = 'Borrower has no valid address.'; $flaginfo{'noissues'} = 1; $flags{'GNA'} = \%flaginfo; } - if ($patroninformation->{'lost'} && $patroninformation->{'lost'} == 1) { + if ($patroninformation->{'lost'} == 1) { my %flaginfo; $flaginfo{'message'} = 'Borrower\'s card reported lost.'; $flaginfo{'noissues'} = 1; $flags{'LOST'} = \%flaginfo; } - if ($patroninformation->{'debarred'} && $patroninformation->{'debarred'} == 1) { + if ($patroninformation->{'debarred'} == 1) { my %flaginfo; $flaginfo{'message'} = 'Borrower is Debarred.'; $flaginfo{'noissues'} = 1; $flags{'DBARRED'} = \%flaginfo; } - if ($patroninformation->{'borrowernotes'} && $patroninformation->{'borrowernotes'}) { + if ($patroninformation->{'borrowernotes'}) { my %flaginfo; $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}"; $flags{'NOTES'} = \%flaginfo; @@ -1466,19 +1462,22 @@ sub checkoverdues { #checks whether a borrower has overdue items my ($env, $bornum, $dbh)=@_; my @datearr = localtime; - my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3]; + my $today = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]); my @overdueitems; my $count = 0; - my $sth = $dbh->prepare("SELECT * FROM issues,biblio,biblioitems,items - WHERE items.biblioitemnumber = biblioitems.biblioitemnumber - AND items.biblionumber = biblio.biblionumber - AND issues.itemnumber = items.itemnumber + my $sth = $dbh->prepare("SELECT issues.* , i.biblionumber as biblionumber FROM issues, items i + WHERE i.itemnumber=issues.itemnumber AND issues.borrowernumber = ? AND issues.returndate is NULL AND issues.date_due < ?"); $sth->execute($bornum,$today); while (my $data = $sth->fetchrow_hashref) { - push (@overdueitems, $data); + my ($record)=MARCgetbiblio($dbh,$data->{biblionumber}); + my $bibliodata=MARCmarc2koha($dbh,$record,"biblios"); + foreach my $field (keys % $data){ + $bibliodata->{$field}=$data->{$field}; + } + push (@overdueitems, $bibliodata); $count++; } $sth->finish; @@ -1502,7 +1501,6 @@ sub currentborrower { # FIXME - Not exported, but used in 'updateitem.pl' anyway. sub checkreserve_to_delete { -# Stolen from Main.pm # Check for reserves for biblio my ($env,$dbh,$itemnum)=@_; my $resbor = ""; @@ -1527,8 +1525,7 @@ sub checkreserve_to_delete { where (borrowernumber=?) and reservedate=? and reserveconstraints.biblionumber=? - and (items.itemnumber=? and - items.biblioitemnumber = reserveconstraints.biblioitemnumber)"); + and (items.itemnumber=? )"); $csth->execute($data->{'borrowernumber'},$data->{'biblionumber'},$data->{'reservedate'},$itemnum); if (my $cdata=$csth->fetchrow_hashref) {$found = 1;} if ($const eq 'o') { @@ -1591,7 +1588,7 @@ sub currentissues { # FIXME - Since $today will be used in either case, move it # out of the two if-blocks. my @datearr = localtime(time()); - my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3]; + my $today = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]); # FIXME - MySQL knows about dates. Just use # and issues.timestamp = curdate(); $crit=" and issues.timestamp like '$today%' "; @@ -1602,7 +1599,7 @@ sub currentissues { # FIXME - Since $today will be used in either case, move it # out of the two if-blocks. my @datearr = localtime(time()); - my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3]; + my $today = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]); # FIXME - MySQL knows about dates. Just use # and issues.timestamp < curdate(); $crit=" and !(issues.timestamp like '$today%') "; @@ -1610,28 +1607,15 @@ sub currentissues { # FIXME - Does the caller really need every single field from all # four tables? - my $sth=$dbh->prepare("select * from issues,items,biblioitems,biblio where + my $sth=$dbh->prepare("select * from issues,items where borrowernumber=? and issues.itemnumber=items.itemnumber and - items.biblionumber=biblio.biblionumber and - items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null + returndate is null $crit order by issues.date_due"); $sth->execute($borrowernumber); while (my $data = $sth->fetchrow_hashref) { - # FIXME - The Dewey code is a string, not a number. - $data->{'dewey'}=~s/0*$//; - ($data->{'dewey'} == 0) && ($data->{'dewey'}=''); - # FIXME - Could use - # $todaysdate = POSIX::strftime("%Y%m%d", localtime) - # or better yet, just reuse $today which was calculated above. - # This function isn't going to run until midnight, is it? - # Alternately, use - # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime) - # if ($data->{'date_due'} lt $todaysdate) - # ... - # Either way, the date should be be formatted outside of the - # loop. + my @datearr = localtime(time()); - my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]); + my $todaysdate = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]); my $datedue=$data->{'date_due'}; $datedue=~s/-//g; if ($datedue < $todaysdate) { @@ -1666,65 +1650,44 @@ of the Koha database. =cut #' sub getissues { -# New subroutine for Circ2.pm my ($borrower) = @_; my $dbh = C4::Context->dbh; my $borrowernumber = $borrower->{'borrowernumber'}; my %currentissues; - my $select = "SELECT items.*,issues.timestamp AS timestamp, - issues.date_due AS date_due, - items.barcode AS barcode, - biblio.title AS title, - biblio.author AS author, - biblioitems.dewey AS dewey, - itemtypes.description AS itemtype, - biblioitems.subclass AS subclass, - biblioitems.classification AS classification - FROM issues,items,biblioitems,biblio, itemtypes + my $bibliodata; + my @results; + my @datearr = localtime(time()); + my $todaysdate = (1900+$datearr[5])."-".sprintf ("%0.2d", ($datearr[4]+1))."-".sprintf ("%0.2d", $datearr[3]); + my $counter = 0; + my $select = "SELECT * + FROM issues,items WHERE issues.borrowernumber = ? AND issues.itemnumber = items.itemnumber - AND items.biblionumber = biblio.biblionumber - AND items.biblioitemnumber = biblioitems.biblioitemnumber - AND itemtypes.itemtype = biblioitems.itemtype AND issues.returndate IS NULL - ORDER BY issues.date_due DESC"; + ORDER BY issues.date_due"; # print $select; my $sth=$dbh->prepare($select); $sth->execute($borrowernumber); - my $counter = 0; while (my $data = $sth->fetchrow_hashref) { - $data->{'dewey'} =~ s/0*$//; - ($data->{'dewey'} == 0) && ($data->{'dewey'} = ''); - # FIXME - The Dewey code is a string, not a number. - # FIXME - Use POSIX::strftime to get a text version of today's - # date. That's what it's for. - # FIXME - Move the date calculation outside of the loop. - my @datearr = localtime(time()); - my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]); - - # FIXME - Instead of converting the due date to YYYYMMDD, just - # use - # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime); - # ... - # if ($date->{date_due} lt $todaysdate) - my $datedue = $data->{'date_due'}; - $datedue =~ s/-//g; - if ($datedue < $todaysdate) { - $data->{'overdue'} = 1; + my ($record)=MARCgetbiblio($dbh,$data->{biblionumber},1); + $bibliodata=MARCmarc2koha($dbh,$record,"biblios"); + foreach my $field (keys %$data){ + $bibliodata->{$field}=$data->{$field}; } - $currentissues{$counter} = $data; + $bibliodata->{'date_due'} = $data->{'date_due'}; + if ($bibliodata->{'date_due'} lt $todaysdate) { + $bibliodata->{'overdue'} = 1; + } + $currentissues{$counter} = $bibliodata; $counter++; - # FIXME - This is ludicrous. If you want to return an - # array of values, just use an array. That's what - # they're there for. } $sth->finish; + return(\%currentissues); } # Not exported sub checkwaiting { -#Stolen from Main.pm # check for reserves waiting my ($env,$dbh,$bornum)=@_; my @itemswaiting; @@ -1763,49 +1726,100 @@ already renewed the loan. sub renewstatus { # check renewal status - my ($env,$bornum,$itemno)=@_; - my $dbh = C4::Context->dbh; + ##If system preference "strictrenewals" is used This script will try to return $renewok=2 or $renewok=3 as error messages + ## + my ($env,$bornum,$itemnumber)=@_; + my $dbh=C4::Context->dbh; my $renews = 1; - my $renewokay = 0; + my $resfound; + my $resrec; + my $renewokay; ## # Look in the issues table for this item, lent to this borrower, # and not yet returned. - +my $borrower=getpatroninformation($dbh,$bornum,undef); + if (C4::Context->preference("LibraryName") eq "NEU Grand Library"){ + ## faculty members and privileged get renewal whatever the case may be + if ($borrower->{'categorycode'} eq 'F' ||$borrower->{'categorycode'} eq 'P'){ + $renewokay = 1; + } + } # FIXME - I think this function could be redone to use only one SQL call. - my $sth1 = $dbh->prepare("select * from issues + my $sth1 = $dbh->prepare("select * from issues,items where (borrowernumber = ?) - and (itemnumber = ?) - and returndate is null"); - $sth1->execute($bornum,$itemno); + and (issues.itemnumber = ?) + and returndate is null + and items.itemnumber=issues.itemnumber"); + $sth1->execute($bornum,$itemnumber); if (my $data1 = $sth1->fetchrow_hashref) { # Found a matching item - # See if this item may be renewed. This query is convoluted - # because it's a bit messy: given the item number, we need to find - # the biblioitem, which gives us the itemtype, which tells us - # whether it may be renewed. - my $sth2 = $dbh->prepare("SELECT renewalsallowed from items,biblioitems,itemtypes - where (items.itemnumber = ?) - and (items.biblioitemnumber = biblioitems.biblioitemnumber) - and (biblioitems.itemtype = itemtypes.itemtype)"); - $sth2->execute($itemno); + # See if this item may be renewed. + my ($record)=MARCgetbiblio($dbh,$data1->{biblionumber}); + + my $bibliodata=MARCmarc2koha($dbh,$record,"biblios"); + my $sth2 = $dbh->prepare("select renewalsallowed from itemtypes where itemtypes.itemtype=?"); + $sth2->execute($bibliodata->{itemtype}); if (my $data2=$sth2->fetchrow_hashref) { - $renews = $data2->{'renewalsallowed'}; + $renews = $data2->{'renewalsallowed'}; } - if ($renews && $renews > $data1->{'renewals'}) { - $renewokay = 1; + if ($renews > $data1->{'renewals'}) { + $renewokay= 1; + }else{ + if (C4::Context->preference("strictrenewals")){ + $renewokay=3 unless $renewokay==1; + } } $sth2->finish; - my ($resfound, $resrec) = CheckReserves($itemno); + ($resfound, $resrec) = CheckReserves($itemnumber); if ($resfound) { - $renewokay = 0; + if (C4::Context->preference("strictrenewals")){ + $renewokay=4; + }else{ + $renewokay = 0; + } } - ($resfound, $resrec) = CheckReserves($itemno); - if ($resfound) { - $renewokay = 0; - } + }## item found + ($resfound, $resrec) = CheckReserves($itemnumber); + if ($resfound) { + if (C4::Context->preference("strictrenewals")){ + $renewokay=4; + }else{ + $renewokay = 0; + } + } +# } + $sth1->finish; +if (C4::Context->preference("strictrenewals")){ + ### A new system pref "allowRenewalsBefore" prevents the renewal before a set amount of days left before expiry + ## Try to find whether book can be renewed at this date + my $loanlength; + + my $allowRenewalsBefore = C4::Context->preference("allowRenewalsBefore"); + my @nowarr = localtime(time); + my $now = (1900+$nowarr[5])."-".($nowarr[4]+1)."-".$nowarr[3]; + + # Find the issues record for this book### + my $sth=$dbh->prepare("select date_due from issues where itemnumber=? and returndate is null"); + $sth->execute($itemnumber); + my $issuedata=$sth->fetchrow; + $sth->finish; + + #calculates the date on the we are allowed to renew the item + $sth = $dbh->prepare("SELECT (DATE_SUB( ?, INTERVAL ? DAY))"); + $sth->execute($issuedata, $allowRenewalsBefore); + my $startdate = $sth->fetchrow; + + $sth->finish; + ### Fixme we have a Date_diff function use that + $sth = $dbh->prepare("SELECT DATEDIFF(CURRENT_DATE,?)"); + $sth->execute($startdate); + my $difference = $sth->fetchrow; + $sth->finish; + if ($difference < 0) { + $renewokay=2 unless $renewokay==1; } - $sth1->finish; +}##strictrenewals return($renewokay); } @@ -1834,50 +1848,82 @@ C<$datedue> should be in the form YYYY-MM-DD. =cut sub renewbook { + my ($env,$bornum,$itemnumber,$datedue)=@_; # mark book as renewed - my ($env,$bornum,$itemno,$datedue)=@_; - my $dbh = C4::Context->dbh; - # If the due date wasn't specified, calculate it by adding the - # book's loan length to today's date. - if ($datedue eq "" ) { - #debug_msg($env, "getting date"); - my $iteminformation = getiteminformation($env, $itemno,0); - my $borrower = getpatroninformation($env,$bornum,0); - my $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'}); - $datedue = UnixDate(DateCalc("today","$loanlength days"),"%Y-%m-%d"); + my $loanlength; +my $dbh=C4::Context->dbh; +my $iteminformation = getiteminformation($env, $itemnumber,0); + my $sth=$dbh->prepare("select date_due from issues where itemnumber=? and returndate is null "); + $sth->execute($itemnumber); + my $issuedata=$sth->fetchrow; + $sth->finish; + + +## We find a new datedue either from today or from the due_date of the book- if "strictrenewals" is in effect + +if ($datedue eq "" ) { + + my $borrower = getpatroninformation($env,$bornum,0); + $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'}); + if (C4::Context->preference("strictrenewals")){ + my @nowarr = localtime(time); + my $now = (1900+$nowarr[5])."-".($nowarr[4]+1)."-".$nowarr[3]; + if ($issuedata<=$now){ + + $datedue=$issuedata; + my $calendar = C4::Calendar::Calendar->new(branchcode => $borrower->{'branchcode'}); + my ($yeardue, $monthdue, $daydue) = split /-/, $datedue; + ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue, $monthdue, $yeardue, $loanlength); + $datedue = "$yeardue-".sprintf ("%0.2d", $monthdue)."-". sprintf("%0.2d",$daydue); + } + }## stricrenewals + + if ($datedue eq "" ){## incase $datedue chnaged above + + my @datearr = localtime(); + $datedue = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]); + my $calendar = C4::Calendar::Calendar->new(branchcode => $borrower->{'branchcode'}); + my ($yeardue, $monthdue, $daydue) = split /-/, $datedue; + ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue, $monthdue, $yeardue, $loanlength); + $datedue = "$yeardue-".sprintf ("%0.2d", $monthdue)."-". sprintf("%0.2d",$daydue); + } - # Find the issues record for this book - my $sth=$dbh->prepare("select * from issues where borrowernumber=? and itemnumber=? and returndate is null"); - $sth->execute($bornum,$itemno); - my $issuedata=$sth->fetchrow_hashref; - $sth->finish; + + # Update the issues record to have the new due date, and a new count # of how many times it has been renewed. - my $renews = $issuedata->{'renewals'} +1; - $sth=$dbh->prepare("update issues set date_due = ?, renewals = ? + #my $renews = $issuedata->{'renewals'} +1; + $sth=$dbh->prepare("update issues set date_due = ?, renewals = renewals+1 where borrowernumber=? and itemnumber=? and returndate is null"); - $sth->execute($datedue,$renews,$bornum,$itemno); + $sth->execute($datedue,$bornum,$itemnumber); $sth->finish; + ## Update items and marc record with new date -T.G + my $iteminformation = getiteminformation($env, $itemnumber,0); + &MARCmoditemonefield($dbh,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'},'date_due',$datedue); + # Log the renewal - UpdateStats($env,$env->{'branchcode'},'renew','','',$itemno); + UpdateStats($env,$env->{'branchcode'},'renew','','',$itemnumber); # Charge a new rental fee, if applicable? - my ($charge,$type)=calc_charges($env, $itemno, $bornum); + my ($charge,$type)=calc_charges($env, $itemnumber, $bornum); if ($charge > 0){ my $accountno=getnextacctno($env,$bornum,$dbh); - my $item=getiteminformation($env, $itemno); $sth=$dbh->prepare("Insert into accountlines (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber) values (?,?,now(),?,?,?,?,?)"); - $sth->execute($bornum,$accountno,$charge,"Renewal of Rental Item $item->{'title'} $item->{'barcode'}",'Rent',$charge,$itemno); + $sth->execute($bornum,$accountno,$charge,"Renewal of Rental Item $iteminformation->{'title'} $iteminformation->{'barcode'}",'Rent',$charge,$itemnumber); $sth->finish; # print $account; + }# end of rental charge + + } + + - # return(); } @@ -1903,47 +1949,47 @@ if it's a video). sub calc_charges { # calculate charges due - my ($env, $itemno, $bornum)=@_; + my ($env, $itemnumber, $bornum)=@_; my $charge=0; my $dbh = C4::Context->dbh; my $item_type; - + my $sth= $dbh->prepare("select biblionumber from items where itemnumber=?"); + $sth->execute($itemnumber); + my $data1=$sth->fetchrow; + $sth->finish; + my ($record)=MARCgetbiblio($dbh,$data1); + + my $bibliodata=MARCmarc2koha($dbh,$record,"biblios"); # Get the book's item type and rental charge (via its biblioitem). - my $sth1= $dbh->prepare("select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes - where (items.itemnumber =?) - and (biblioitems.biblioitemnumber = items.biblioitemnumber) - and (biblioitems.itemtype = itemtypes.itemtype)"); - $sth1->execute($itemno); - if (my $data1=$sth1->fetchrow_hashref) { - $item_type = $data1->{'itemtype'}; - $charge = $data1->{'rentalcharge'}; - my $q2 = "select rentaldiscount from issuingrules,borrowers + my $sth1= $dbh->prepare("select rentalcharge from itemtypes where itemtypes.itemtype=?"); + $sth1->execute($bibliodata->{itemtype}); + + $charge = $sth1->fetchrow; + my $q2 = "select rentaldiscount from issuingrules,borrowers where (borrowers.borrowernumber = ?) and (borrowers.categorycode = issuingrules.categorycode) and (issuingrules.itemtype = ?)"; my $sth2=$dbh->prepare($q2); - $sth2->execute($bornum,$item_type); - if (my $data2=$sth2->fetchrow_hashref) { + $sth2->execute($bornum,$bibliodata->{itemtype}); + if (my $data2=$sth2->fetchrow_hashref) { my $discount = $data2->{'rentaldiscount'}; if ($discount eq 'NULL') { $discount=0; } $charge = ($charge *(100 - $discount)) / 100; # warn "discount is $discount"; - } + } $sth2->finish; - } - + $sth1->finish; - return ($charge,$item_type); + return ($charge,$bibliodata->{itemtype}); } -# FIXME - A virtually identical function appears in -# C4::Circulation::Issues. Pick one and stick with it. + sub createcharge { -#Stolen from Issues.pm - my ($env,$dbh,$itemno,$bornum,$charge) = @_; + + my ($env,$dbh,$itemnumber,$bornum,$charge) = @_; my $nextaccntno = getnextacctno($env,$bornum,$dbh); my $sth = $dbh->prepare(<execute($bornum, $itemno, $nextaccntno, $charge, $charge); + $sth->execute($bornum, $itemnumber, $nextaccntno, $charge, $charge); $sth->finish; } + + =item find_reserves ($status, $record) = &find_reserves($itemnumber); @@ -1976,51 +2024,38 @@ the fields from the reserves table of the Koha database. #' # FIXME - This API is bogus: just return the record, or undef if none # was found. -# FIXME - There's also a &C4::Circulation::Returns::find_reserves, but -# that one looks rather different. + sub find_reserves { -# Stolen from Returns.pm - my ($itemno) = @_; - my %env; + my ($itemnumber) = @_; my $dbh = C4::Context->dbh; - my ($itemdata) = getiteminformation(\%env, $itemno,0); - my $bibno = $dbh->quote($itemdata->{'biblionumber'}); - my $bibitm = $dbh->quote($itemdata->{'biblioitemnumber'}); + my ($itemdata) = getiteminformation("", $itemnumber,0); my $sth = $dbh->prepare("select * from reserves where ((found = 'W') or (found is null)) and biblionumber = ? and cancellationdate is NULL order by priority, reservedate"); - $sth->execute($bibno); + $sth->execute($itemdata->{'biblionumber'}); my $resfound = 0; my $resrec; my $lastrec; -# print $query; # FIXME - I'm not really sure what's going on here, but since we # only want one result, wouldn't it be possible (and far more # efficient) to do something clever in SQL that only returns one # set of values? - while (($resrec = $sth->fetchrow_hashref) && (not $resfound)) { - # FIXME - Unlike Pascal, Perl allows you to exit loops - # early. Take out the "&& (not $resfound)" and just - # use "last" at the appropriate point in the loop. - # (Oh, and just in passing: if you'd used "!" instead - # of "not", you wouldn't have needed the parentheses.) +while ($resrec = $sth->fetchrow_hashref) { $lastrec = $resrec; - my $brn = $dbh->quote($resrec->{'borrowernumber'}); - my $rdate = $dbh->quote($resrec->{'reservedate'}); - my $bibno = $dbh->quote($resrec->{'biblionumber'}); - if ($resrec->{'found'} eq "W") { - if ($resrec->{'itemnumber'} eq $itemno) { + if ($resrec->{'found'} eq "W") { + if ($resrec->{'itemnumber'} eq $itemnumber) { $resfound = 1; } } else { # FIXME - Use 'elsif' to avoid unnecessary indentation. if ($resrec->{'constrainttype'} eq "a") { - $resfound = 1; + $resfound = 1; } else { - my $consth = $dbh->prepare("select * from reserveconstraints where borrowernumber = ? and reservedate = ? and biblionumber = ? and biblioitemnumber = ?"); - $consth->execute($brn,$rdate,$bibno,$bibitm); + my $consth = $dbh->prepare("select * from reserveconstraints where borrowernumber = ? and reservedate = ? and biblionumber = ? "); + $consth->execute($resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'}); if (my $conrec = $consth->fetchrow_hashref) { if ($resrec->{'constrainttype'} eq "o") { $resfound = 1; + } } $consth->finish; @@ -2028,9 +2063,9 @@ sub find_reserves { } if ($resfound) { my $updsth = $dbh->prepare("update reserves set found = 'W', itemnumber = ? where borrowernumber = ? and reservedate = ? and biblionumber = ?"); - $updsth->execute($itemno,$brn,$rdate,$bibno); + $updsth->execute($itemnumber,$resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'}); $updsth->finish; - # FIXME - "last;" here to break out of the loop early. + last; } } $sth->finish; @@ -2041,30 +2076,24 @@ sub fixdate { my ($year, $month, $day) = @_; my $invalidduedate; my $date; - if ($year && $month && $day){ - if (($year eq 0 ) && ($month eq 0) && ($year eq 0)) { + if (($year eq 0) && ($month eq 0) && ($year eq 0)) { # $env{'datedue'}=''; + } else { + if (($year eq 0) || ($month eq 0) || ($year eq 0)) { + $invalidduedate=1; } else { - if (($year eq 0) || ($month eq 0) || ($year eq 0)) { + if (($day>30) && (($month==4) || ($month==6) || ($month==9) || ($month==11))) { + $invalidduedate = 1; + } elsif (($day > 29) && ($month == 2)) { + $invalidduedate=1; + } elsif (($month == 2) && ($day > 28) && (($year%4) && ((!($year%100) || ($year%400))))) { $invalidduedate=1; } else { - if (($day>30) && (($month==4) || ($month==6) || ($month==9) || ($month==11))) { - $invalidduedate = 1; - } - elsif (($day > 29) && ($month == 2)) { - $invalidduedate=1; - } - elsif (($month == 2) && ($day > 28) && (($year%4) && ((!($year%100) || ($year%400))))) { - $invalidduedate=1; - } - else { $date="$year-$month-$day"; - } } } } return ($date, $invalidduedate); - } sub get_current_return_date_of { @@ -2182,6 +2211,16 @@ sub checktransferts{ return (@tranferts); } +##Utility date function to prevent dependency on Date::Manip +sub DATE_diff { +my ($date1,$date2)=@_; +my $dbh=C4::Context->dbh; +my $sth = $dbh->prepare("SELECT DATEDIFF(?,?)"); + $sth->execute($date1,$date2); + my $difference = $sth->fetchrow; + $sth->finish; +return $difference; +} 1; __END__ @@ -2193,4 +2232,3 @@ __END__ Koha Developement team =cut - diff --git a/C4/Circulation/Fines.pm b/C4/Circulation/Fines.pm index c2b0f7b242..652e287eb4 100644 --- a/C4/Circulation/Fines.pm +++ b/C4/Circulation/Fines.pm @@ -21,8 +21,9 @@ package C4::Circulation::Fines; use strict; require Exporter; -use DBI; + use C4::Context; +use C4::Biblio; use vars qw($VERSION @ISA @EXPORT); # set the version for version checking @@ -47,9 +48,8 @@ overdue items. It is primarily used by the 'misc/fines2.pl' script. =cut -@ISA = qw(Exporter); -@EXPORT = qw(&Getoverdues &CalcFine &BorType &UpdateFine &ReplacementCost - GetFine, ReplacementCost2); +@ISA = qw(Exporter); +@EXPORT = qw(&Getoverdues &CalcFine &BorType &UpdateFine &ReplacementCost &GetFine &ReplacementCost2); =item Getoverdues @@ -64,28 +64,20 @@ reference-to-hash whose keys are the fields of the issues table in the Koha database. =cut - #' -sub Getoverdues { - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( - "Select * from issues where date_due < now() and returndate is - NULL order by borrowernumber" - ); - $sth->execute; - - # FIXME - Use push @results - my $i = 0; - my @results; - while ( my $data = $sth->fetchrow_hashref ) { - $results[$i] = $data; - $i++; - } - $sth->finish; - - # print @results; - # FIXME - Bogus API. - return ( $i, \@results ); +sub Getoverdues{ + my $dbh = C4::Context->dbh; + my $sth=$dbh->prepare("Select * from issues where date_due < now() and returndate is NULL order by borrowernumber"); + $sth->execute; + # FIXME - Use push @results + my $i=0; + my @results; + while (my $data=$sth->fetchrow_hashref){ + push @results,$data; + $i++; + } + $sth->finish; + return($i,\@results); } =item CalcFine @@ -111,7 +103,7 @@ fine is 0. Note that the way this function is currently implemented, it only returns a nonzero value on the notable days listed above. That is, if -the categoryitems entry says to send a first reminder 7 days after the +the issuingruless entry says to send a first reminder 7 days after the book is due, then if you call C<&CalcFine> 7 days after the book is due, it will give a nonzero fine. If you call C<&CalcFine> the next day, however, it will say that the fine is 0. @@ -129,89 +121,79 @@ C<&CalcFine> returns a list of three values: C<$amount> is the fine owed by the patron (see above). C<$chargename> is the chargename field from the applicable record in -the categoryitem table, whatever that is. +the issuingrules table, whatever that is. C<$message> is a text message, either "First Notice", "Second Notice", or "Final Notice". =cut - #' sub CalcFine { - my ( $itemnumber, $bortype, $difference ) = @_; - my $dbh = C4::Context->dbh; - - # Look up the categoryitem record for this book's item type and the - # given borrwer type. - # The reason this query is so messy is that it's a messy question: - # given the barcode, we can find the book's items record. This gives - # us the biblioitems record, which gives us a set of categoryitem - # records. Then we select the one that corresponds to the desired - # borrower type. - - # FIXME - Is it really necessary to get absolutely everything from - # all four tables? It looks as if this code only wants - # firstremind, chargeperiod, accountsent, and chargename from the - # categoryitem table. - - my $sth = $dbh->prepare( -"SELECT * FROM items,biblioitems,itemtypes,issuingrules - WHERE items.itemnumber=? - AND items.biblioitemnumber=biblioitems.biblioitemnumber - AND biblioitems.itemtype=itemtypes.itemtype - AND issuingrules.itemtype=itemtypes.itemtype - AND issuingrules.categorycode=? AND (items.itemlost <> 1 OR items.itemlost is NULL)" - ); - - # print $query; - $sth->execute( $itemnumber, $bortype ); - my $data = $sth->fetchrow_hashref; - - # FIXME - Error-checking: the item might be lost, or there - # might not be an entry in 'categoryitem' for this item type - # or borrower type. - $sth->finish; - my $amount = 0; - my $printout; - - # Is it time to send out the first reminder? - # FIXME - I'm not sure the "=="s are correct here. Let's say that - # $data->{firstremind} is today, but 'fines2.pl' doesn't run for - # some reason (the cron daemon died, the server crashed, the - # sysadmin had the machine down for maintenance, or whatever). - # - # Then the next day, the book is $data->{firstremind}+1 days - # overdue. But this function returns $amount == 0, $printout == - # undef, on the assumption that 'fines2.pl' ran the previous day. So - # the first thing the patron gets is a second notice, but that's a - # week after the server crash, so people may not connect the two - # events. - if ( $difference == $data->{'firstremind'} ) { - - # Yes. Set the fine as listed. - $amount = $data->{'fine'}; - $printout = "First Notice"; - } - - # Is it time to send out a second reminder? - my $second = $data->{'firstremind'} + $data->{'chargeperiod'}; - if ( $difference == $second ) { - - # Yes. The fine is double. - $amount = $data->{'fine'} * 2; - $printout = "Second Notice"; - } - - # Is it time to send the account to a collection agency? - # FIXME - At least, I *think* that's what this code is doing. - if ( $difference == $data->{'accountsent'} && $data->{'fine'} > 0 ) { - - # Yes. Set the fine at 5 local monetary units. - # FIXME - This '5' shouldn't be hard-wired. - $amount = 5; - $printout = "Final Notice"; - } - return ( $amount, $data->{'chargename'}, $printout ); + my ($itemnumber,$bortype,$difference)=@_; + my $dbh = C4::Context->dbh; + # Look up the issuingrules record for this book's item type and the + # given borrwer type. + # The reason this query is so messy is that it's a messy question: + # given the barcode, we can find the book's items record. This gives + # us the biblio record, which gives us a set of issuingrules + # records. Then we select the one that corresponds to the desired + # borrower type. + + # FIXME - Is it really necessary to get absolutely everything from + # all four tables? It looks as if this code only wants + # firstremind, chargeperiod, accountsent, and chargename from the + # issuingrules table. + + my $sth=$dbh->prepare("Select * from items,biblio,itemtypes,issuingrules where items.itemnumber=? + and items.biblionumber=biblio.biblionumber and + biblio.itemtype=itemtypes.itemtype and + issuingrules.itemtype=itemtypes.itemtype and + issuingrules.categorycode=? "); +# print $query; + $sth->execute($itemnumber,$bortype); + my $data=$sth->fetchrow_hashref; + # FIXME - Error-checking: the item might be lost, or there + # might not be an entry in 'issuingrules' for this item type + # or borrower type. + $sth->finish; + my $amount=0; + my $printout; + + # Is it time to send out the first reminder? + # FIXME - I'm not sure the "=="s are correct here. Let's say that + # $data->{firstremind} is today, but 'fines2.pl' doesn't run for + # some reason (the cron daemon died, the server crashed, the + # sysadmin had the machine down for maintenance, or whatever). + # + # Then the next day, the book is $data->{firstremind}+1 days + # overdue. But this function returns $amount == 0, $printout == + # undef, on the assumption that 'fines2.pl' ran the previous day. So + # the first thing the patron gets is a second notice, but that's a + # week after the server crash, so people may not connect the two + # events. + if ($difference >= $data->{'firstremind'}){ + # Yes. Set the fine as listed. + $amount=$data->{'fine'}* $difference; + $printout="First Notice"; + } + + # Is it time to send out a second reminder? +# my $second=$data->{'firstremind'}+$data->{'chargeperiod'}; +# if ($difference == $second){ +# # Yes. The fine is double. +# $amount=$data->{'fine'}*2; +# $printout="Second Notice"; +# } + + # Is it time to send the account to a collection agency? + # FIXME - At least, I *think* that's what this code is doing. + if ($difference == $data->{'accountsent'} && $data->{'fine'} > 0){ + # Yes. Set the fine at 5 local monetary units. + # FIXME - This '5' shouldn't be hard-wired. + $amount=$data->{'fine'}* $difference; + $printout="Final Notice"; + } + return($amount,$data->{'chargename'},$printout); } =item UpdateFine @@ -239,88 +221,76 @@ and sets it to C<$amount>, creating, if necessary, a new entry in the accountlines table of the Koha database. =cut - #' # FIXME - This API doesn't look right: why should the caller have to # specify both the item number and the borrower number? A book can't # be on loan to two different people, so the item number should be # sufficient. sub UpdateFine { - my ( $itemnum, $bornum, $amount, $type, $due ) = @_; - my $dbh = C4::Context->dbh; - - # FIXME - What exactly is this query supposed to do? It looks up an - # entry in accountlines that matches the given item and borrower - # numbers, where the description contains $due, and where the - # account type has one of several values, but what does this _mean_? - # Does it look up existing fines for this item? - # FIXME - What are these various account types? ("FU", "O", "F", "M") - my $sth = $dbh->prepare( - "Select * from accountlines where itemnumber=? and + my ($itemnum,$bornum,$amount,$type,$due)=@_; + my $dbh = C4::Context->dbh; + # FIXME - What exactly is this query supposed to do? It looks up an + # entry in accountlines that matches the given item and borrower + # numbers, where the description contains $due, and where the + # account type has one of several values, but what does this _mean_? + # Does it look up existing fines for this item? + # FIXME - What are these various account types? ("FU", "O", "F", "M") + + my $sth=$dbh->prepare("Select * from accountlines where itemnumber=? and borrowernumber=? and (accounttype='FU' or accounttype='O' or - accounttype='F' or accounttype='M') and description like ?" - ); - $sth->execute( $itemnum, $bornum, "%$due%" ); - - if ( my $data = $sth->fetchrow_hashref ) { - - # I think this if-clause deals with the case where we're updating - # an existing fine. - # print "in accounts ..."; - if ( $data->{'amount'} != $amount ) { - - # print "updating"; - my $diff = $amount - $data->{'amount'}; - my $out = $data->{'amountoutstanding'} + $diff; - my $sth2 = $dbh->prepare( - "update accountlines set date=now(), amount=?, + accounttype='F' or accounttype='M') "); + $sth->execute($itemnum,$bornum); + + if (my $data=$sth->fetchrow_hashref){ + # I think this if-clause deals with the case where we're updating + # an existing fine. +# print "in accounts ..."; + if ($data->{'amount'} != $amount){ + +# print "updating"; + my $diff=$amount - $data->{'amount'}; + my $out=$data->{'amountoutstanding'}+$diff; + my $sth2=$dbh->prepare("update accountlines set date=now(), amount=?, amountoutstanding=?,accounttype='FU' where - borrowernumber=? and itemnumber=? - and (accounttype='FU' or accounttype='O') and description like ?" - ); - $sth2->execute( $amount, $out, $data->{'borrowernumber'}, - $data->{'itemnumber'}, "%$due%" ); - $sth2->finish; - } - else { - - # print "no update needed $data->{'amount'}" - } + accountno=?"); + $sth2->execute($amount,$out,$data->{'accountno'}); + $sth2->finish; + } else { + print "no update needed $data->{'amount'} \n"; } - else { - - # I think this else-clause deals with the case where we're adding - # a new fine. - my $sth4 = $dbh->prepare( - "select title from biblio,items where items.itemnumber=? - and biblio.biblionumber=items.biblionumber" - ); - $sth4->execute($itemnum); - my $title = $sth4->fetchrow_hashref; - $sth4->finish; - - # print "not in account"; - my $sth3 = $dbh->prepare("Select max(accountno) from accountlines"); - $sth3->execute; - - # FIXME - Make $accountno a scalar. - my @accountno = $sth3->fetchrow_array; - $sth3->finish; - $accountno[0]++; - my $sth2 = $dbh->prepare( - "Insert into accountlines + } else { + # I think this else-clause deals with the case where we're adding + # a new fine. + my $sth4=$dbh->prepare("select biblio.marc from biblio ,items where items.itemnumber=? + and biblio.biblionumber=items.biblionumber"); + $sth4->execute($itemnum); + my $marc=$sth4->fetchrow; + $sth4->finish; +my $record=MARC::File::USMARC::decode($marc,\&func_title); +my $title=$record->title(); + # print "not in account"; + my $sth3=$dbh->prepare("Select max(accountno) from accountlines"); + $sth3->execute; + # FIXME - Make $accountno a scalar. + my $accountno=$sth3->fetchrow; + $sth3->finish; + $accountno++; + my $sth2=$dbh->prepare("Insert into accountlines (borrowernumber,itemnumber,date,amount, description,accounttype,amountoutstanding,accountno) values - (?,?,now(),?,?,'FU',?,?)" - ); - $sth2->execute( $bornum, $itemnum, $amount, - "$type $title->{'title'} $due", - $amount, $accountno[0] ); - $sth2->finish; - } - $sth->finish; + (?,?,now(),?,?,'FU',?,?)"); + $sth2->execute($bornum,$itemnum,$amount,"$type $title $due",$amount,$accountno); + $sth2->finish; + } + $sth->finish; } + sub func_title { + my ($tagno,$tagdata) = @_; + my ($titlef,$subf)=&MARCfind_marc_from_kohafield("title","biblios"); + return ($tagno == $titlef ); + } + =item BorType $borrower = &BorType($borrowernumber); @@ -333,20 +303,17 @@ C<$borrower> contains all information about both the borrower and category he or she belongs to. =cut - #' sub BorType { - my ($borrowernumber) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( - "Select * from borrowers,categories where + my ($borrowernumber)=@_; + my $dbh = C4::Context->dbh; + my $sth=$dbh->prepare("Select * from borrowers,categories where borrowernumber=? and -borrowers.categorycode=categories.categorycode" - ); - $sth->execute($borrowernumber); - my $data = $sth->fetchrow_hashref; - $sth->finish; - return ($data); +borrowers.categorycode=categories.categorycode"); + $sth->execute($borrowernumber); + my $data=$sth->fetchrow_hashref; + $sth->finish; + return($data); } =item ReplacementCost @@ -356,21 +323,14 @@ borrowers.categorycode=categories.categorycode" Returns the replacement cost of the item with the given item number. =cut - #' -sub ReplacementCost { - my ($itemnum) = @_; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare("Select replacementprice from items where itemnumber=?"); - $sth->execute($itemnum); - - # FIXME - Use fetchrow_array or something. - my $data = $sth->fetchrow_hashref; - $sth->finish; - return ( $data->{'replacementprice'} ); +sub ReplacementCost{ + my ($itemnumber)=@_; + my $dbh = C4::Context->dbh; + my ($itemrecord)=MARCgetitem($dbh,$itemnumber); + my $data=MARCmarc2koha($dbh,$itemrecord,"holdings"); + return($data->{'replacementprice'}); } - sub GetFine { my ( $itemnum, $bornum ) = @_; my $dbh = C4::Context->dbh(); @@ -397,7 +357,6 @@ sub ReplacementCost2 { $sth->finish(); $dbh->disconnect(); return ( $data->{'amountoutstanding'} ); -} 1; __END__ diff --git a/C4/Circulation/Returns.pm b/C4/Circulation/Returns.pm deleted file mode 100755 index 8193ef5add..0000000000 --- a/C4/Circulation/Returns.pm +++ /dev/null @@ -1,334 +0,0 @@ -package C4::Circulation::Returns; - -# $Id$ - -#package to deal with Returns -#written 3/11/99 by olwen@katipo.co.nz - - -# Copyright 2000-2002 Katipo Communications -# -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. -# -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA - -# FIXME - None of the functions (certainly none of the exported -# functions) are used anywhere anymore. Presumably this module is -# obsolete. - -use strict; -require Exporter; -use DBI; -use C4::Context; -use C4::Accounts2; -use C4::InterfaceCDK; -use C4::Circulation::Main; - # FIXME - C4::Circulation::Main and C4::Circulation::Returns - # use each other, so functions get redefined. -use C4::Scan; -use C4::Stats; -use C4::Members; -use C4::Print; -use C4::Biblio; - -use vars qw($VERSION @ISA @EXPORT); - -# set the version for version checking -$VERSION = 0.01; - -@ISA = qw(Exporter); -@EXPORT = qw(&returnrecord &calc_odues &Returns); - -# FIXME - This is only used in C4::Circmain and C4::Circulation, both -# of which appear to be obsolete. Presumably this function is obsolete -# as well. -# Otherwise, it needs a POD. -sub Returns { - my ($env)=@_; - my $dbh = C4::Context->dbh; - my @items; - @items[0]=" "x50; - my $reason; - my $item; - my $reason; - my $borrower; - my $itemno; - my $itemrec; - my $bornum; - my $amt_owing; - my $odues; - my $issues; - my $resp; -# until (($reason eq "Circ") || ($reason eq "Quit")) { - until ($reason ne "") { - ($reason,$item) = - returnwindow($env,"Enter Returns", - $item,\@items,$borrower,$amt_owing,$odues,$dbh,$resp); #C4::Circulation - #debug_msg($env,"item = $item"); - #if (($reason ne "Circ") && ($reason ne "Quit")) { - if ($reason eq "") { - $resp = ""; - ($resp,$bornum,$borrower,$itemno,$itemrec,$amt_owing) = - checkissue($env,$dbh,$item); - if ($bornum ne "") { - ($issues,$odues,$amt_owing) = borrdata2($env,$bornum); - } else { - $issues = ""; - $odues = ""; - $amt_owing = ""; - } - if ($resp ne "") { - #if ($resp eq "Returned") { - if ($itemno ne "" ) { - my $item = getbibliofromitemnumber($env,$dbh,$itemno); - # FIXME - This relies on C4::Circulation::Main to have a - # "use C4::Circulation::Issues;" line, which is bogus. - my $fmtitem = C4::Circulation::Issues::formatitem($env,$item,"",$amt_owing); - unshift @items,$fmtitem; - if ($items[20] > "") { - pop @items; - } - } - #} elsif ($resp ne "") { - # error_msg($env,"$resp"); - #} - #if ($resp ne "Returned") { - # error_msg($env,"$resp"); - # $bornum = ""; - #} - } - } - } -# clearscreen; - return($reason); - } - -# FIXME - Only used in &Returns and in telnet/doreturns.pl, both of -# which appear obsolete. Presumably this function is obsolete as well. -# Otherwise, it needs a POD. -sub checkissue { - my ($env,$dbh, $item) = @_; - my $reason='Circ'; - my $bornum; - my $borrower; - my $itemno; - my $itemrec; - my $amt_owing; - $item = uc $item; - my $sth=$dbh->prepare("select * from items,biblio - where barcode = ? - and (biblio.biblionumber=items.biblionumber)"); - $sth->execute($item); - if ($itemrec=$sth->fetchrow_hashref) { - $sth->finish; - $itemno = $itemrec->{'itemnumber'}; - my $sth=$dbh->prepare("select * from issues - where (itemnumber=?) - and (returndate is null)"); - $sth->execute($itemrec->{'itemnumber'}); - if (my $issuerec=$sth->fetchrow_hashref) { - $sth->finish; - my $sth= $dbh->prepare("select * from borrowers where - (borrowernumber = ?)"); - $sth->execute($issuerec->{'borrowernumber'}); - $env->{'bornum'}=$issuerec->{'borrowernumber'}; - $borrower = $sth->fetchrow_hashref; - $bornum = $issuerec->{'borrowernumber'}; - $itemno = $issuerec->{'itemnumber'}; - $amt_owing = returnrecord($env,$dbh,$bornum,$itemno); - $reason = "Returned"; - } else { - $sth->finish; - updatelastseen($env,$dbh,$itemrec->{'itemnumber'}); - $reason = "Item not issued"; - } - my ($resfound,$resrec) = find_reserves($env,$dbh,$itemrec->{'itemnumber'}); - if ($resfound eq "y") { - my $btsh = $dbh->prepare("select * from borrowers - where borrowernumber = ?"); - $btsh->execute($resrec->{'borrowernumber'}); - my $resborrower = $btsh->fetchrow_hashref; - #printreserve($env,$resrec,$resborrower,$itemrec); - my $mess = "Reserved for collection at branch $resrec->{'branchcode'}"; - C4::InterfaceCDK::error_msg($env,$mess); - $btsh->finish; - } - } else { - $sth->finish; - $reason = "Item not found"; - } - return ($reason,$bornum,$borrower,$itemno,$itemrec,$amt_owing); - # end checkissue - } - -# FIXME - Only used in &C4::Circulation::Main::previousissue, -# &checkissue, C4/Circulation.pm, and tkperl/tkcirc, all of which -# appear to be obsolete. Presumably this function is obsolete as well. -# Otherwise, it needs a POD. -sub returnrecord { - # mark items as returned - my ($env,$dbh,$bornum,$itemno)=@_; - #my $amt_owing = calc_odues($env,$dbh,$bornum,$itemno); - my @datearr = localtime(time); - my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3]; - my $sth = $dbh->prepare("update issues set returndate = now(), branchcode = ? where - (borrowernumber = ?) and (itemnumber = ?) - and (returndate is null)"); - $sth->execute($env->{'branchcode'},$bornum,$itemno); - $sth->finish; - updatelastseen($env,$dbh,$itemno); - # check for overdue fine - my $oduecharge; - my $sth = $dbh->prepare("select * from accountlines - where (borrowernumber = ?) - and (itemnumber = ?) - and (accounttype = 'FU' or accounttype='O')"); - $sth->execute($bornum,$itemno); - if (my $data = $sth->fetchrow_hashref) { - # alter fine to show that the book has been returned. - my $usth = $dbh->prepare("update accountlines - set accounttype = 'F' - where (borrowernumber = ?) - and (itemnumber = ?) - and (accountno = ?) "); - $usth->execute($bornum,$itemno,$data->{'accountno'}); - $usth->finish(); - $oduecharge = $data->{'amountoutstanding'}; - } - $sth->finish; - # check for charge made for lost book - my $sth = $dbh->prepare("select * from accountlines - where (borrowernumber = ?) - and (itemnumber = ?) - and (accounttype = 'L')"); - $sth->execute($bornum,$itemno); - if (my $data = $sth->fetchrow_hashref) { - # writeoff this amount - my $offset; - my $amount = $data->{'amount'}; - my $acctno = $data->{'accountno'}; - my $amountleft; - if ($data->{'amountoutstanding'} == $amount) { - $offset = $data->{'amount'}; - $amountleft = 0; - } else { - $offset = $amount - $data->{'amountoutstanding'}; - $amountleft = $data->{'amountoutstanding'} - $amount; - } - my $usth = $dbh->prepare("update accountlines - set accounttype = 'LR',amountoutstanding='0' - where (borrowernumber = ?) - and (itemnumber = ?) - and (accountno = ?) "); - $usth->execute($bornum,$itemno,$acctno); - $usth->finish; - my $nextaccntno = C4::Accounts::getnextacctno($env,$bornum,$dbh); - $usth = $dbh->prepare("insert into accountlines - (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding) - values (?,?,now(),?,'Book Returned','CR',?)"); - $usth->execute($bornum,$nextaccntno,0-$amount,$amountleft); - $usth->finish; - $uquery = "insert into accountoffsets - (borrowernumber, accountno, offsetaccount, offsetamount) - values (?,?,?,?)"; - $usth = $dbh->prepare(""); - $usth->execute($bornum,$data->{'accountno'},$nextaccntno,$offset); - $usth->finish; - } - $sth->finish; - UpdateStats($env,'branch','return','0','',$itemno); - return($oduecharge); -} - -# FIXME - Only used in tkperl/tkcirc. Presumably this function is -# obsolete. -# Otherwise, it needs a POD. -sub calc_odues { - # calculate overdue fees - my ($env,$dbh,$bornum,$itemno)=@_; - my $amt_owing; - return($amt_owing); -} - -# This function is only used in &checkissue and &returnrecord, both of -# which appear to be obsolete. So presumably this function is obsolete -# too. -# Otherwise, it needs a POD. -sub updatelastseen { - my ($env,$dbh,$itemnumber)= @_; - my $br = $env->{'branchcode'}; - my $sth = $dbh->prepare("update items - set datelastseen = now(), holdingbranch = ? - where (itemnumber = ?)"); - $sth->execute($br,$itemnumber); - $sth->finish; - -} - - -# FIXME - There's also a &C4::Circulation::Circ2::find_reserves, but -# that one looks rather different. -# FIXME - This is only used in &checkissue, which appears to be -# obsolete. So presumably this function is obsolete too. -sub find_reserves { - my ($env,$dbh,$itemno) = @_; - my $itemdata = getbibliofromitemnumber($env,$dbh,$itemno); - my $sth = $dbh->prepare("select * from reserves where found is null - and biblionumber = ? and cancellationdate is NULL - order by priority,reservedate "); - $sth->execute($itemdata->{'biblionumber'}; - my $resfound = "n"; - my $resrec; - while (($resrec=$sth->fetchrow_hashref) && ($resfound eq "n")) { - if ($resrec->{'found'} eq "W") { - if ($resrec->{'itemnumber'} eq $itemno) { - $resfound = "y"; - } - } elsif ($resrec->{'constrainttype'} eq "a") { - $resfound = "y"; - } else { - my $consth = $dbh->prepare("select * from reserveconstraints where borrowernumber = ? and reservedate = ? and biblionumber = ? and biblioitemnumber = ?"); - $consth->execute($resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'},$itemdata->{'biblioitemnumber'}); - if (my $conrec=$consth->fetchrow_hashref) { - if ($resrec->{'constrainttype'} eq "o") { - $resfound = "y"; - } - } else { - if ($resrec->{'constrainttype'} eq "e") { - $resfound = "y"; - } - } - $consth->finish; - } - if ($resfound eq "y") { - my $updsth = $dbh->prepare("update reserves - set found = 'W',itemnumber = ? - where borrowernumber = ? - and reservedate = ? - and biblionumber = ?"); - $updsth->execute($itemno,$resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'}); - $updsth->finish; - my $itbr = $resrec->{'branchcode'}; - if ($resrec->{'branchcode'} ne $env->{'branchcode'}) { - my $updsth = $dbh->prepare("update items - set holdingbranch = 'TR' - where itemnumber = ?"); - $updsth->execute($itemno); - $updsth->finish; - } - } - } - $sth->finish; - return ($resfound,$resrec); -} diff --git a/C4/Context.pm b/C4/Context.pm index 7b2a86f00c..c180f7738b 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -18,7 +18,7 @@ # $Id$ package C4::Context; use strict; -use DBI; +use C4::UTF8DBI; use C4::Boolean; use XML::Simple; use vars qw($VERSION $AUTOLOAD), @@ -200,6 +200,7 @@ sub new $self->{"Zconnauth"} = undef; # Zebra Connection for updating $self->{"stopwords"} = undef; # stopwords list $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield + $self->{"attrfromkohafield"} = undef; # the hash with relations between koha table fields and Bib1-attributes $self->{"userenv"} = undef; # User env $self->{"activeuser"} = undef; # current active user @@ -397,27 +398,22 @@ creates one and connects. sub Zconn { my $self = shift; my $server=shift; +my $syntax=shift; my $Zconn; - if (defined($context->{"Zconn"})) { - $Zconn = $context->{"Zconn"}; - return $context->{"Zconn"}; - } else { - $context->{"Zconn"} = &new_Zconn($server); - return $context->{"Zconn"}; - } + $context->{"Zconn"} = &new_Zconn($server,$syntax); + return $context->{"Zconn"}; + } sub Zconnauth { my $self = shift; - my $server="biblioserver"; #shift; +my $server=shift; +my $syntax=shift; my $Zconnauth; - if (defined($context->{"Zconnauth"})) { - $Zconnauth = $context->{"Zconnauth"}; - return $context->{"Zconnauth"}; - } else { - $context->{"Zconnauth"} = &new_Zconnauth($server); +##We destroy each connection made so create a new one + $context->{"Zconnauth"} = &new_Zconnauth($server,$syntax); return $context->{"Zconnauth"}; - } + } @@ -432,30 +428,19 @@ the data given in the current context and returns it. sub new_Zconn { use ZOOM; my $server=shift; -my $tried=0; +my $syntax=shift; +$syntax="xml" unless $syntax; my $Zconn; my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"}; - -retry: - eval { - $Zconn=new ZOOM::Connection($context->config("hostname"),$port,databaseName=>$context->{"config"}->{$server}, - preferredRecordSyntax => "USmarc",elementSetName=> "F"); - $Zconn->option(cqlfile=> $context->{"config"}->{"zebradir"}."/etc/cql.properties"); - $Zconn->option(cclfile=> $context->{"config"}->{"zebradir"}."/etc/ccl.properties"); - }; - if ($@){ -###Uncomment the lines below if you want to automatically restart your zebra if its stop -###The system call is for Windows it should be changed to unix deamon starting for Unix platforms -# if ($@->code==10000 && $tried==0){ ##No connection try restarting Zebra -# $tried==1; -# my $res=system('sc start "Z39.50 Server" >c:/zebraserver/error.log'); -# goto "retry"; -# }else{ - warn "Error ", $@->code(), ": ", $@->message(), "\n"; - $Zconn="error"; - return $Zconn; -# } - } +my $o = new ZOOM::Options(); +$o->option(async => 1); +$o->option(preferredRecordSyntax => $syntax); ## Authorities use marc while biblioserver is xml +$o->option(databaseName=>$context->{"config"}->{$server}); +#$o->option(proxy=>$context->{"config"}->{"proxy"});## if proxyserver provided will route searches to proxy +my $o2= new ZOOM::Options(); + + $Zconn=create ZOOM::Connection($o); + $Zconn->connect($context->{"config"}->{"hostname"},$port); return $Zconn; } @@ -464,37 +449,20 @@ retry: sub new_Zconnauth { use ZOOM; my $server=shift; -my $tried=0; +my $syntax=shift; +$syntax="xml" unless $syntax; my $Zconnauth; my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"}; - my $o = new ZOOM::Options(); - $o->option(async => 1); - $o->option(preferredRecordSyntax => "usmarc"); - $o->option(elementSetName => "F"); - $o->option(user=>$context->{"config"}->{"zebrauser"}); - $o->option(password=>$context->{"config"}->{"zebrapass"}); - $o->option(databaseName=>$context->{"config"}->{$server}); - -retry: -eval{ - $Zconnauth=new ZOOM::Connection($context->config("hostname"),$port,databaseName=>$context->{"config"}->{$server}, - user=>$context->{"config"}->{"zebrauser"}, - password=>$context->{"config"}->{"zebrapass"},preferredRecordSyntax => "USmarc",elementSetName=> "F"); -}; - if ($@){ -###Uncomment the lines below if you want to automatically restart your zebra if its stop -###The system call is for Windows it should be changed to unix deamon starting for Unix platforms -# if ($@->code==10000 && $tried==0){ ##No connection try restarting Zebra -# $tried==1; -# my $res=system('sc start "Z39.50 Server" >c:/zebraserver/error.log'); -# goto "retry"; -# }else{ - warn "Error ", $@->code(), ": ", $@->message(), "\n"; - $Zconnauth="error"; - return $Zconnauth; -# } - } - return $Zconnauth; +my $o = new ZOOM::Options(); +#$o->option(async => 1); +$o->option(preferredRecordSyntax => $syntax); +$o->option(user=>$context->{"config"}->{"zebrauser"}); +$o->option(password=>$context->{"config"}->{"zebrapass"}); +$o->option(databaseName=>$context->{"config"}->{$server}); + $o->option(charset=>"UTF8"); + $Zconnauth=create ZOOM::Connection($o); +$Zconnauth->connect($context->config("hostname"),$port); +return $Zconnauth; } @@ -516,11 +484,14 @@ sub _new_dbh my $db_host = $context->config("hostname"); my $db_user = $context->config("user"); my $db_passwd = $context->config("pass"); - my $dbh= DBI->connect("DBI:$db_driver:$db_name:$db_host", + my $dbh= UTF8DBI->connect("DBI:$db_driver:$db_name:$db_host", $db_user, $db_passwd); # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config. # this is better than modifying my.cnf (and forcing all communications to be in utf8) - $dbh->do("set NAMES 'utf8'"); +# $dbh->do("set NAMES 'utf8'"); +# $dbh->do("SET character_set_client=utf8"); +# $dbh->do("SET character_set_connection=utf8"); +# $dbh->do("SET character_set_results=utf8"); return $dbh; } @@ -660,22 +631,50 @@ sub marcfromkohafield return $context->{"marcfromkohafield"}; } + # _new_marcfromkohafield -# Internal helper function (not a method!). This creates a new -# hash with stopwords +# Internal helper function (not a method!). sub _new_marcfromkohafield { my $dbh = C4::Context->dbh; my $marcfromkohafield; - my $sth = $dbh->prepare("select frameworkcode,kohafield,tagfield,tagsubfield from marc_subfield_structure where kohafield > ''"); + my $sth = $dbh->prepare("select marctokoha,tagfield,tagsubfield,recordtype from koha_attr where tagfield is not null "); $sth->execute; - while (my ($frameworkcode,$kohafield,$tagfield,$tagsubfield) = $sth->fetchrow) { + while (my ($kohafield,$tagfield,$tagsubfield,$recordtype) = $sth->fetchrow) { my $retval = {}; - $marcfromkohafield->{$frameworkcode}->{$kohafield} = [$tagfield,$tagsubfield]; + $marcfromkohafield->{$recordtype}->{$kohafield} = [$tagfield,$tagsubfield]; } + return $marcfromkohafield; } + +#item attrfromkohafield +#To use as a hash of koha to z3950 attributes +sub _new_attrfromkohafield +{ + my $dbh = C4::Context->dbh; + my $attrfromkohafield; + my $sth2 = $dbh->prepare("select marctokoha,attr from koha_attr" ); + $sth2->execute; + while (my ($marctokoha,$attr) = $sth2->fetchrow) { + my $retval = {}; + $attrfromkohafield->{$marctokoha} = $attr; + } + return $attrfromkohafield; +} +sub attrfromkohafield +{ + my $retval = {}; + + # If the hash already exists, return it. + return $context->{"attrfromkohafield"} if defined($context->{"attrfromkohafield"}); + + # No hash. Create one. + $context->{"attrfromkohafield"} = &_new_attrfromkohafield(); + + return $context->{"attrfromkohafield"}; +} =item stopwords $dbh = C4::Context->stopwords; @@ -836,6 +835,17 @@ Andrew Arensburger =cut # $Log$ +# Revision 1.44 2006/08/25 21:07:08 tgarip1957 +# New set of routines for HEAD. +# Uses a complete new ZEBRA Indexing. +# ZEBRA is now XML and comprises of a KOHA meta record. Explanatory notes will be on koha-devel +# Fixes UTF8 problems +# Fixes bug with authorities +# SQL database major changes. +# Separate biblioograaphic and holdings records. Biblioitems table depreceated +# etc. etc. +# Wait for explanatory document on koha-devel +# # Revision 1.43 2006/08/10 12:49:37 toins # sync with dev_week. # diff --git a/C4/Database.pm b/C4/Database.pm deleted file mode 100755 index dfa3c0c916..0000000000 --- a/C4/Database.pm +++ /dev/null @@ -1,33 +0,0 @@ -package C4::Database; - -# $Id$ - -# Copyright 2000-2002 Katipo Communications -# -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. -# -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA - -use strict; -require Exporter; -use DBI; -use vars qw($VERSION @ISA @EXPORT); - -$VERSION = 0.01; - -@ISA = qw(Exporter); -@EXPORT = qw( ); - -1; -__END__ diff --git a/C4/Date.pm b/C4/Date.pm index 732fd3265c..d95a08bc51 100644 --- a/C4/Date.pm +++ b/C4/Date.pm @@ -23,7 +23,7 @@ package C4::Date; use strict; use C4::Context; -use Date::Manip; +#use Date::Manip ; require Exporter; @@ -87,7 +87,7 @@ sub get_date_format_string_for_DHTMLcalendar { sub format_date { my $olddate = shift; - my $newdate; + my $newdate; if ( !$olddate ) { return ""; @@ -96,14 +96,15 @@ sub format_date { my $dateformat = get_date_format(); if ( $dateformat eq "us" ) { - Date_Init("DateFormat=US"); - $olddate = ParseDate($olddate); - $newdate = UnixDate( $olddate, '%m/%d/%Y' ); + Date_Init("DateFormat=US"); + $olddate = ParseDate($olddate); + $newdate = UnixDate( $olddate, '%Y/%m/%d' ); } elsif ( $dateformat eq "metric" ) { Date_Init("DateFormat=metric"); - $olddate = ParseDate($olddate); + $olddate = ParseDate($olddate); $newdate = UnixDate( $olddate, '%d/%m/%Y' ); + } elsif ( $dateformat eq "iso" ) { Date_Init("DateFormat=iso"); @@ -132,7 +133,7 @@ sub format_date_in_iso { } elsif ( $dateformat eq "metric" ) { Date_Init("DateFormat=metric"); - $olddate = ParseDate($olddate); + $olddate = ParseDate($olddate); } elsif ( $dateformat eq "iso" ) { Date_Init("DateFormat=iso"); @@ -146,6 +147,19 @@ sub format_date_in_iso { return $newdate; } - - +sub DATE_diff { +my ($date1,$date2)=@_; +my $dbh=C4::Context->dbh; +my $sth = $dbh->prepare("SELECT DATEDIFF(?,?)"); + $sth->execute($date1,$date2); + my $difference = $sth->fetchrow; + $sth->finish; +return $difference; +} +sub Date_Init{ +} +sub ParseDate{ +} +sub UnixDate{ +} 1; diff --git a/C4/Input.pm b/C4/Input.pm index a571215ca1..07e90cb5e5 100644 --- a/C4/Input.pm +++ b/C4/Input.pm @@ -21,7 +21,6 @@ package C4::Input; #assumes C4/Input use strict; require Exporter; use C4::Context; -use CGI; use vars qw($VERSION @ISA @EXPORT); diff --git a/C4/Interface/CGI/Output.pm b/C4/Interface/CGI/Output.pm index fad75ce48b..9f97e75432 100644 --- a/C4/Interface/CGI/Output.pm +++ b/C4/Interface/CGI/Output.pm @@ -22,10 +22,9 @@ package C4::Interface::CGI::Output; # You should have received a copy of the GNU General Public License along with # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA - use strict; require Exporter; - +use open ':utf8'; use vars qw($VERSION @ISA @EXPORT); # set the version for version checking @@ -37,9 +36,9 @@ C4::CGI::Output - Convenience functions for handling outputting HTML pages =head1 SYNOPSIS - use C4::CGI::Output; + use C4::Interface::CGI::Output; - print $query->header(-type => C4::CGI::Output::gettype($output)), $output; + print $query->header(-type => "text/html"), $output; =head1 DESCRIPTION @@ -53,46 +52,12 @@ related to the (guessed) charset. =cut @ISA = qw(Exporter); -@EXPORT = qw( - &guesscharset - &guesstype - &output_html_with_http_headers +@EXPORT = qw( &output_html_with_http_headers ); -=item guesscharset - - &guesscharset($output) - -"Guesses" the charset from the some HTML that would be output. -C<$output> is the HTML page to be output. If it contains a META tag -with a Content-Type, the tag will be scanned for a language code. -This code is returned if it is found; undef is returned otherwise. -This function only does sloppy guessing; it will be confused by -unexpected things like SGML comments. What it basically does is to -grab something that looks like a META tag and scan it. -=cut - -sub guesscharset ($) { - my($html) = @_; - my $charset = undef; - local($`, $&, $', $1, $2, $3); - # FIXME... These regular expressions will miss a lot of valid tags! - if ($html =~ //is) { - $charset = $3; - } elsif ($html =~ //is) { - $charset = $2; - } - return $charset; -} # guess - -sub guesstype ($) { - my($html) = @_; - my $charset = guesscharset($html); - return defined $charset? "text/html; charset=$charset": "text/html"; -} =item output_html_with_http_headers @@ -105,11 +70,13 @@ corresponds to the HTML page $html. =cut sub output_html_with_http_headers ($$$) { + my($query, $cookie, $html) = @_; print $query->header( - -type => guesstype($html), + -type => "text/html", + -charset=>"UTF-8", -cookie => $cookie, - ), $html; + ), $html; } #--------------------------------- diff --git a/C4/Koha.pm b/C4/Koha.pm index 0792a572de..db2a5d3408 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -22,7 +22,7 @@ package C4::Koha; use strict; require Exporter; use C4::Context; - +use C4::Biblio; use vars qw($VERSION @ISA @EXPORT); $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); }; @@ -51,7 +51,7 @@ Koha.pm provides many functions for Koha scripts. &subfield_is_koha_internal_p &GetBranches &getbranch &getbranchdetail &getprinters &getprinter - &GetItemTypes &getitemtypeinfo + &GetItemTypes &getitemtypeinfo &ItemType get_itemtypeinfos_of &getframeworks &getframeworkinfo &getauthtypes &getauthtype @@ -137,9 +137,9 @@ sub GetBranches { if ($type){ $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ? and categorycode = ?"); $nsth->execute($branch->{'branchcode'},$type); - } else { + } else { $nsth->execute($branch->{'branchcode'}); - } + } while (my ($cat) = $nsth->fetchrow_array) { # FIXME - This seems wrong. It ought to be # $branch->{categorycodes}{$cat} = 1; @@ -152,14 +152,7 @@ sub GetBranches { # that aren't fields in the "branches" table. $branch->{$cat} = 1; } - if ($type) { - $branches{$branch->{'branchcode'}}=$branch; - } - } - if (!$type){ - $branches{$branch->{'branchcode'}}=$branch; - } - +} return (\%branches); } @@ -354,6 +347,15 @@ SELECT itemtype, return get_infos_of($query, 'itemtype'); } +sub ItemType { + my ($type)=@_; + my $dbh = C4::Context->dbh; + my $sth=$dbh->prepare("select description from itemtypes where itemtype=?"); + $sth->execute($type); + my $dat=$sth->fetchrow_hashref; + $sth->finish; + return ($dat->{'description'}); +} =head2 getauthtypes $authtypes = &getauthtypes(); @@ -456,7 +458,7 @@ sub getframeworks { # returns a reference to a hash of references to branches... my %itemtypes; my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("select * from biblio_framework"); + my $sth=$dbh->prepare("select * from biblios_framework"); $sth->execute; while (my $IT=$sth->fetchrow_hashref) { $itemtypes{$IT->{'frameworkcode'}}=$IT; @@ -474,7 +476,7 @@ Returns information about an frameworkcode. sub getframeworkinfo { my ($frameworkcode) = @_; my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("select * from biblio_framework where frameworkcode=?"); + my $sth=$dbh->prepare("select * from biblios_framework where frameworkcode=?"); $sth->execute($frameworkcode); my $res = $sth->fetchrow_hashref; return $res; @@ -869,11 +871,11 @@ labels. =cut sub get_notforloan_label_of { my $dbh = C4::Context->dbh; - +my($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("notforloan","holdings"); my $query = ' SELECT authorised_value - FROM marc_subfield_structure - WHERE kohafield = \'items.notforloan\' + FROM holdings_subfield_structure + WHERE tagfield =$tagfield and tagsubfield=$tagsubfield LIMIT 0, 1 '; my $sth = $dbh->prepare($query); diff --git a/C4/Letters.pm b/C4/Letters.pm index d535158a3a..8bba5d7f94 100644 --- a/C4/Letters.pm +++ b/C4/Letters.pm @@ -21,7 +21,6 @@ package C4::Letters; use strict; use Mail::Sendmail; use C4::Date; -use Date::Manip; use C4::Suggestions; use C4::Members; require Exporter; diff --git a/C4/Maintainance.pm b/C4/Maintainance.pm deleted file mode 100644 index 3353d70439..0000000000 --- a/C4/Maintainance.pm +++ /dev/null @@ -1,230 +0,0 @@ -package C4::Maintainance; #assumes C4/Maintainance - -#package to deal with marking up output - - -# Copyright 2000-2002 Katipo Communications -# -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. -# -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA - -use strict; -use C4::Context; - -require Exporter; - -use vars qw($VERSION @ISA @EXPORT); - -# set the version for version checking -$VERSION = 0.01; - -=head1 NAME - -C4::Maintenance - Koha catalog maintenance functions - -=head1 SYNOPSIS - - use C4::Maintenance; - -=head1 DESCRIPTION - -The functions in this module perform various catalog-maintenance -functions, including deleting and undeleting books, fixing -miscategorized items, etc. - -=head1 FUNCTIONS - -=over 2 - -=cut - -@ISA = qw(Exporter); -@EXPORT = qw(&listsubjects &updatesub &shiftgroup &deletedbib &undeletebib -&updatetype &logaction); - -=item listsubjects - - ($count, $results) = &listsubjects($subject, $n, $offset); - -Finds the subjects that begin with C<$subject> in the bibliosubject -table of the Koha database. - -C<&listsubjects> returns a two-element array. C<$results> is a -reference-to-array, in which each element is a reference-to-hash -giving information about the given subject. C<$count> is the number of -elements in C<@{$results}>. - -Probably the only interesting field in C<$results->[$i]> is -C, the subject in question. - -C<&listsubject> returns up to C<$n> items, starting at C<$offset>. If -C<$n> is 0, it will return all matching subjects. - -=cut -#' -# FIXME - This API is bogus. The way it's currently used, it should -# just return a list of strings. -sub listsubjects { - my ($sub,$num,$offset)=@_; - my $dbh = C4::Context->dbh; - my $query="Select * from bibliosubject where subject like ? group by subject"; - my @bind = ("$sub%"); - # FIXME - Make $num and $offset optional. - # If $num was given, make sure $offset was, too. - if ($num != 0){ - $query.=" limit ?,?"; - push(@bind,$offset,$num); - } - my $sth=$dbh->prepare($query); -# print $query; - $sth->execute(@bind); - my @results; - my $i=0; - while (my $data=$sth->fetchrow_hashref){ - $results[$i]=$data; - $i++; - } - $sth->finish; - return($i,\@results); -} - -=item updatesub - - &updatesub($newsubject, $oldsubject); - -Renames a subject from C<$oldsubject> to C<$newsubject> in the -bibliosubject table of the Koha database. - -=cut -#' -sub updatesub{ - my ($sub,$oldsub)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("update bibliosubject set subject=? where subject=?"); - $sth->execute($sub,$oldsub); - $sth->finish; -} - -=item shiftgroup - - &shiftgroup($biblionumber, $biblioitemnumber); - -Changes the biblionumber associated with a given biblioitem. -C<$biblioitemnumber> is the number of the biblioitem to change. -C<$biblionumber> is the biblionumber to associate it with. - -=cut -#' -sub shiftgroup{ - my ($bib,$bi)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("update biblioitems set biblionumber=? where biblioitemnumber=?"); - $sth->execute($bib,$bi); - $sth->finish; - $sth=$dbh->prepare("update items set biblionumber=? where biblioitemnumber=?"); - $sth->execute($bib,$bi); - $sth->finish; -} - -=item deletedbib - - ($count, $results) = &deletedbib($title); - -Looks up deleted books whose title begins with C<$title>. - -C<&deletedbib> returns a two-element list. C<$results> is a -reference-to-array; each element is a reference-to-hash whose keys are -the fields of the deletedbiblio table in the Koha database. C<$count> -is the number of elements in C<$results>. - -=cut -#' -sub deletedbib{ - my ($title)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Select * from deletedbiblio where title like ? order by title"); - $sth->execute("$title%"); - my @results; - my $i=0; - while (my $data=$sth->fetchrow_hashref){ - $results[$i]=$data; - $i++; - } - $sth->finish; - return($i,\@results); -} - -=item undeletebib - - &undeletebib($biblionumber); - -Undeletes a book. C<&undeletebib> looks up the book with the given -biblionumber in the deletedbiblio table of the Koha database, and -moves its entry to the biblio table. - -=cut -#' -sub undeletebib{ - my ($bib)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("select * from deletedbiblio where biblionumber=?"); - $sth->execute($bib); - if (my @data=$sth->fetchrow_array){ - $sth->finish; - # FIXME - Doesn't this keep the same biblionumber? Isn't this - # forbidden by the definition of 'biblio'? Or doesn't it matter? - my $query="INSERT INTO biblio VALUES ("; - my $count = @data; - $query .= ("?," x $count); - $query=~ s/\,$/\)/; - # print $query; - $sth=$dbh->prepare($query); - $sth->execute(@data); - $sth->finish; - } - $sth=$dbh->prepare("DELETE FROM deletedbiblio WHERE biblionumber=?"); - $sth->execute($bib); - $sth->finish; -} - -=item updatetype - - &updatetype($biblioitemnumber, $itemtype); - -Changes the type of the item with the given biblioitemnumber to be -C<$itemtype>. - -=cut -#' -sub updatetype{ - my ($bi,$type)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Update biblioitems set itemtype=? where biblioitemnumber=?"); - $sth->execute($type,$bi); - $sth->finish; -} - -END { } # module clean-up code here (global destructor) - -1; -__END__ - -=back - -=head1 AUTHOR - -Koha Developement team - -=cut diff --git a/C4/Members.pm b/C4/Members.pm index 37063260dd..4d5d31ddb9 100644 --- a/C4/Members.pm +++ b/C4/Members.pm @@ -56,15 +56,41 @@ This module contains routines for adding, modifying and deleting members/patrons @ISA = qw(Exporter); @EXPORT = qw( - &BornameSearch &getmember &borrdata &borrdata2 &fixup_cardnumber &findguarantees &findguarantor &GuarantornameSearch &NewBorrowerNumber &modmember &newmember &changepassword &borrissues &allissues - &checkuniquemember &getzipnamecity &getidcity &getguarantordata &getcategorytype - &calcexpirydate &checkuserpassword - &getboracctrecord - &borrowercategories &getborrowercategory - &fixEthnicity - ðnicitycategories get_institutions add_member_orgs - &get_age &GetBorrowersFromSurname &GetBranchCodeFromBorrowers - &GetFlagsAndBranchFromBorrower +&allissues +&borrdata +&borrdata2 +&BornameSearch +&borrissues +&borrowercategories + +&changepassword +&checkuniquemember +&calcexpirydate +&checkuserpassword +ðnicitycategories get_institutions add_member_orgs +&fixEthnicity +&fixup_cardnumber +&findguarantees +&findguarantor + + + +&getmember +&getzipnamecity +&getidcity +&getguarantordata +&getcategorytype +&getboracctrecord +&getborrowercategory +&get_age +&GetBorrowersFromSurname +&GetBranchCodeFromBorrowers +&GetFlagsAndBranchFromBorrower +&GuarantornameSearch + +&NewBorrowerNumber +&modmember +&newmember ); diff --git a/C4/NewsChannels.pm b/C4/NewsChannels.pm index ab78c18f5d..3651a77586 100644 --- a/C4/NewsChannels.pm +++ b/C4/NewsChannels.pm @@ -1,387 +1,387 @@ -package C4::NewsChannels; - -# Copyright 2000-2002 Katipo Communications -# -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. -# -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA - -use strict; - -use C4::Context; -use C4::Date; - -use vars qw($VERSION @ISA @EXPORT); - -# set the version for version checking -$VERSION = 0.01; - -=head1 NAME - -C4::NewsChannels - Functions to manage the news channels and its categories - -=head1 DESCRIPTION - -This module provides the functions needed to admin the news channels and its categories - -=head1 FUNCTIONS - -=over 2 - -=cut - - -@ISA = qw(Exporter); -@EXPORT = qw( - &news_channels &get_new_channel &del_channels &add_channel &update_channel - &news_channels_categories &get_new_channel_category &del_channels_categories - &add_channel_category &update_channel_category &news_channels_by_category -&add_opac_new &upd_opac_new &del_opac_new &get_opac_new &get_opac_news - &add_opac_electronic &upd_opac_electronic &del_opac_electronic &get_opac_electronic &get_opac_electronics -); - - -=item news_channels - - ($count, @channels) = &news_channels($channel_name, $id_category, $unclassified); - -Looks up news channels by name or category. - -C<$channel_name> is the channel name to search. - -C<$id_category> is the channel category code to search. - -C<$$unclassified> if it is set and $channel_name and $id_category search for the news channels without a category - -if none of the params are set C<&news_channels> returns all the news channels. - -C<&news_channels> returns two values: an integer giving the number of -news channels found and a reference to an array -of references to hash, which has the news_channels and news_channels_categories fields. - -=cut - -sub news_channels { - my ($channel_name, $id_category, $unclassified) = @_; - my $dbh = C4::Context->dbh; - my @channels; - my $query = "SELECT * FROM news_channels LEFT JOIN news_channels_categories ON news_channels.id_category = news_channels_categories.id_category"; - if ( ($channel_name ne '') && ($id_category ne '') ) { - $query.= " WHERE channel_name like '" . $channel_name . "%' AND news_channels.id_category = " . $id_category; - } elsif ($channel_name ne '') { - $query.= " WHERE channel_name like '" . $channel_name . "%'"; - } elsif ($id_category ne '') { - $query.= " WHERE news_channels.id_category = " . $id_category; - } elsif ($unclassified) { - $query.= " WHERE news_channels.id_category IS NULL "; - } - my $sth = $dbh->prepare($query); - $sth->execute(); - while (my $row = $sth->fetchrow_hashref) { - push @channels, $row; - } - $sth->finish; - return (scalar(@channels), @channels); -} - -=item news_channels_by_category - - ($count, @results) = &news_channels_by_category(); - -Looks up news channels grouped by category. - -C<&news_channels_by_category> returns two values: an integer giving the number of -categories found and a reference to an array -of references to hash, which the following keys: - -=over 4 - -=item C - -The number of news channels in that category - -=item C - -A reference to an array of references to hash which keys are the new_channels fields. - -Additionally the last index of results has a reference to all the news channels which don't have a category - -=cut - -sub news_channels_by_category { - - my ($categories_count, @results) = &news_channels_categories(); - foreach my $row (@results) { - - my ($channels_count, @channels) = &news_channels('', $row->{'id_category'}); - $row->{'channels_count'} = $channels_count; - $row->{'channels'} = \@channels; - } - - my ($channels_count, @channels) = &news_channels('', '', 1); - my %row; - $row{'id_category'} = -1; - $row{'unclassified'} = 1; - $row{'channels_count'} = $channels_count; - $row{'channels'} = \@channels; - push @results, \%row; - - return (scalar(@results), @results); -} - -sub get_new_channel { - my ($id) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("SELECT * FROM news_channels WHERE id = ?"); - $sth->execute($id); - my $channel = $sth->fetchrow_hashref; - $sth->finish; - return $channel; -} - -sub del_channels { - my ($ids) = @_; - if ($ids ne '') { - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("DELETE FROM news_channels WHERE id IN ($ids) "); - $sth->execute(); - $sth->finish; - return $ids; - } - return 0; -} - -sub add_channel { - my ($name, $url, $id_category, $notes) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("INSERT INTO news_channels (channel_name, url, id_category, notes) VALUES (?,?,?,?)"); - $sth->execute($name, $url, $id_category, $notes); - $sth->finish; - return 1; -} - -sub update_channel { - my ($id, $name, $url, $id_category, $notes) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("UPDATE news_channels SET channel_name = ?, url = ?, id_category = ?, notes = ? WHERE id = ?"); - $sth->execute($name, $url, $id_category, $notes, $id); - $sth->finish; - return 1; -} - -sub news_channels_categories { - my $dbh = C4::Context->dbh; - my @categories; - my $query = "SELECT * FROM news_channels_categories"; - my $sth = $dbh->prepare($query); - $sth->execute(); - while (my $row = $sth->fetchrow_hashref) { - push @categories, $row; - } - $sth->finish; - return (scalar(@categories), @categories); - -} - -sub get_new_channel_category { - my ($id) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("SELECT * FROM news_channels_categories WHERE id_category = ?"); - $sth->execute($id); - my $category = $sth->fetchrow_hashref; - $sth->finish; - return $category; -} - -sub del_channels_categories { - my ($ids) = @_; - if ($ids ne '') { - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("UPDATE news_channels SET id_category = NULL WHERE id_category IN ($ids) "); - $sth->execute(); - $sth = $dbh->prepare("DELETE FROM news_channels_categories WHERE id_category IN ($ids) "); - $sth->execute(); - $sth->finish; - return $ids; - } - return 0; -} - -sub add_channel_category { - my ($name) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("INSERT INTO news_channels_categories (category_name) VALUES (?)"); - $sth->execute($name); - $sth->finish; - return 1; -} - -sub update_channel_category { - my ($id, $name) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("UPDATE news_channels_categories SET category_name = ? WHERE id_category = ?"); - $sth->execute($name, $id); - $sth->finish; - return 1; -} - - -sub add_opac_new { - my ($title, $new, $lang) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("INSERT INTO opac_news (title, new, lang) VALUES (?,?,?)"); - $sth->execute($title, $new, $lang); - $sth->finish; - return 1; -} - -sub upd_opac_new { - my ($idnew, $title, $new, $lang) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("UPDATE opac_news SET title = ?, new = ?, lang = ? WHERE idnew = ?"); - $sth->execute($title, $new, $lang, $idnew); - $sth->finish; - return 1; -} - -sub del_opac_new { - my ($ids) = @_; - if ($ids) { - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("DELETE FROM opac_news WHERE idnew IN ($ids)"); - $sth->execute(); - $sth->finish; - return 1; - } else { - return 0; - } -} - -sub get_opac_new { - my ($idnew) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("SELECT * FROM opac_news WHERE idnew = ?"); - $sth->execute($idnew); - my $data = $sth->fetchrow_hashref; - $data->{$data->{'lang'}} = 1; - $sth->finish; - return $data; -} - -sub get_opac_news { - my ($limit, $lang) = @_; - my $dbh = C4::Context->dbh; - my $query = "SELECT *, DATE_FORMAT(timestamp, '%d/%m/%Y') AS newdate FROM opac_news"; - if ($lang) { - $query.= " WHERE lang = '" .$lang ."' "; - } - $query.= " ORDER BY timestamp DESC "; - #if ($limit) { - # $query.= "LIMIT 0, " . $limit; - #} - my $sth = $dbh->prepare($query); - $sth->execute(); - my @opac_news; - my $count = 0; - while (my $row = $sth->fetchrow_hashref) { - if ((($limit) && ($count < $limit)) || (!$limit)) { - $row->{'newdate'} = format_date($row->{'newdate'}); - push @opac_news, $row; - } - $count++; - } - return ($count, \@opac_news); -} - -### get electronic databases - -sub add_opac_electronic { - my ($title, $edata, $lang,$image,$href,$section) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("INSERT INTO opac_electronic (title, edata, lang,image,href,section) VALUES (?,?,?,?,?,?)"); - $sth->execute($title, $edata, $lang,$image,$href,$section); - $sth->finish; - return 1; -} - -sub upd_opac_electronic { - my ($idelectronic, $title, $edata, $lang, $image, $href,$section) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("UPDATE opac_electronic SET title = ?, edata = ?, lang = ? , image=?, href=? ,section=? WHERE idelectronic = ?"); - $sth->execute($title, $edata, $lang, $image,$href ,$section, $idelectronic); - $sth->finish; - return 1; -} - -sub del_opac_electronic { - my ($ids) = @_; - if ($ids) { - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("DELETE FROM opac_electronic WHERE idelectronic IN ($ids)"); - $sth->execute(); - $sth->finish; - return 1; - } else { - return 0; - } -} - -sub get_opac_electronic { - my ($idelectronic) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("SELECT * FROM opac_electronic WHERE idelectronic = ?"); - $sth->execute($idelectronic); - my $data = $sth->fetchrow_hashref; - $data->{$data->{'lang'}} = 1; - $data->{$data->{'section'}} = 1; - $sth->finish; - return $data; -} - -sub get_opac_electronics { - my ($section, $lang) = @_; - my $dbh = C4::Context->dbh; - my $query = "SELECT *, DATE_FORMAT(timestamp, '%d/%m/%Y') AS newdate FROM opac_electronic"; - if ($lang) { - $query.= " WHERE lang = '" .$lang ."' "; - } - if ($section) { - $query.= " and section= '" . $section."' "; - } - $query.= " ORDER BY title "; - - my $sth = $dbh->prepare($query); - $sth->execute(); - my @opac_electronic; - my $count = 0; - while (my $row = $sth->fetchrow_hashref) { - push @opac_electronic, $row; - - - $count++; - } - - return ($count,\@opac_electronic); -} -END { } # module clean-up code here (global destructor) - -=back - -=head1 AUTHOR - -TG - -=cut - - +package C4::NewsChannels; + +# Copyright 2000-2002 Katipo Communications +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; + +use C4::Context; +use C4::Date; + +use vars qw($VERSION @ISA @EXPORT); + +# set the version for version checking +$VERSION = 0.01; + +=head1 NAME + +C4::NewsChannels - Functions to manage the news channels and its categories + +=head1 DESCRIPTION + +This module provides the functions needed to admin the news channels and its categories + +=head1 FUNCTIONS + +=over 2 + +=cut + + +@ISA = qw(Exporter); +@EXPORT = qw( + &news_channels &get_new_channel &del_channels &add_channel &update_channel + &news_channels_categories &get_new_channel_category &del_channels_categories + &add_channel_category &update_channel_category &news_channels_by_category +&add_opac_new &upd_opac_new &del_opac_new &get_opac_new &get_opac_news + &add_opac_electronic &upd_opac_electronic &del_opac_electronic &get_opac_electronic &get_opac_electronics +); + + +=item news_channels + + ($count, @channels) = &news_channels($channel_name, $id_category, $unclassified); + +Looks up news channels by name or category. + +C<$channel_name> is the channel name to search. + +C<$id_category> is the channel category code to search. + +C<$$unclassified> if it is set and $channel_name and $id_category search for the news channels without a category + +if none of the params are set C<&news_channels> returns all the news channels. + +C<&news_channels> returns two values: an integer giving the number of +news channels found and a reference to an array +of references to hash, which has the news_channels and news_channels_categories fields. + +=cut + +sub news_channels { + my ($channel_name, $id_category, $unclassified) = @_; + my $dbh = C4::Context->dbh; + my @channels; + my $query = "SELECT * FROM news_channels LEFT JOIN news_channels_categories ON news_channels.id_category = news_channels_categories.id_category"; + if ( ($channel_name ne '') && ($id_category ne '') ) { + $query.= " WHERE channel_name like '" . $channel_name . "%' AND news_channels.id_category = " . $id_category; + } elsif ($channel_name ne '') { + $query.= " WHERE channel_name like '" . $channel_name . "%'"; + } elsif ($id_category ne '') { + $query.= " WHERE news_channels.id_category = " . $id_category; + } elsif ($unclassified) { + $query.= " WHERE news_channels.id_category IS NULL "; + } + my $sth = $dbh->prepare($query); + $sth->execute(); + while (my $row = $sth->fetchrow_hashref) { + push @channels, $row; + } + $sth->finish; + return (scalar(@channels), @channels); +} + +=item news_channels_by_category + + ($count, @results) = &news_channels_by_category(); + +Looks up news channels grouped by category. + +C<&news_channels_by_category> returns two values: an integer giving the number of +categories found and a reference to an array +of references to hash, which the following keys: + +=over 4 + +=item C + +The number of news channels in that category + +=item C + +A reference to an array of references to hash which keys are the new_channels fields. + +Additionally the last index of results has a reference to all the news channels which don't have a category + +=cut + +sub news_channels_by_category { + + my ($categories_count, @results) = &news_channels_categories(); + foreach my $row (@results) { + + my ($channels_count, @channels) = &news_channels('', $row->{'id_category'}); + $row->{'channels_count'} = $channels_count; + $row->{'channels'} = \@channels; + } + + my ($channels_count, @channels) = &news_channels('', '', 1); + my %row; + $row{'id_category'} = -1; + $row{'unclassified'} = 1; + $row{'channels_count'} = $channels_count; + $row{'channels'} = \@channels; + push @results, \%row; + + return (scalar(@results), @results); +} + +sub get_new_channel { + my ($id) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("SELECT * FROM news_channels WHERE id = ?"); + $sth->execute($id); + my $channel = $sth->fetchrow_hashref; + $sth->finish; + return $channel; +} + +sub del_channels { + my ($ids) = @_; + if ($ids ne '') { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("DELETE FROM news_channels WHERE id IN ($ids) "); + $sth->execute(); + $sth->finish; + return $ids; + } + return 0; +} + +sub add_channel { + my ($name, $url, $id_category, $notes) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("INSERT INTO news_channels (channel_name, url, id_category, notes) VALUES (?,?,?,?)"); + $sth->execute($name, $url, $id_category, $notes); + $sth->finish; + return 1; +} + +sub update_channel { + my ($id, $name, $url, $id_category, $notes) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("UPDATE news_channels SET channel_name = ?, url = ?, id_category = ?, notes = ? WHERE id = ?"); + $sth->execute($name, $url, $id_category, $notes, $id); + $sth->finish; + return 1; +} + +sub news_channels_categories { + my $dbh = C4::Context->dbh; + my @categories; + my $query = "SELECT * FROM news_channels_categories"; + my $sth = $dbh->prepare($query); + $sth->execute(); + while (my $row = $sth->fetchrow_hashref) { + push @categories, $row; + } + $sth->finish; + return (scalar(@categories), @categories); + +} + +sub get_new_channel_category { + my ($id) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("SELECT * FROM news_channels_categories WHERE id_category = ?"); + $sth->execute($id); + my $category = $sth->fetchrow_hashref; + $sth->finish; + return $category; +} + +sub del_channels_categories { + my ($ids) = @_; + if ($ids ne '') { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("UPDATE news_channels SET id_category = NULL WHERE id_category IN ($ids) "); + $sth->execute(); + $sth = $dbh->prepare("DELETE FROM news_channels_categories WHERE id_category IN ($ids) "); + $sth->execute(); + $sth->finish; + return $ids; + } + return 0; +} + +sub add_channel_category { + my ($name) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("INSERT INTO news_channels_categories (category_name) VALUES (?)"); + $sth->execute($name); + $sth->finish; + return 1; +} + +sub update_channel_category { + my ($id, $name) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("UPDATE news_channels_categories SET category_name = ? WHERE id_category = ?"); + $sth->execute($name, $id); + $sth->finish; + return 1; +} + + +sub add_opac_new { + my ($title, $new, $lang) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("INSERT INTO opac_news (title, new, lang) VALUES (?,?,?)"); + $sth->execute($title, $new, $lang); + $sth->finish; + return 1; +} + +sub upd_opac_new { + my ($idnew, $title, $new, $lang) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("UPDATE opac_news SET title = ?, new = ?, lang = ? WHERE idnew = ?"); + $sth->execute($title, $new, $lang, $idnew); + $sth->finish; + return 1; +} + +sub del_opac_new { + my ($ids) = @_; + if ($ids) { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("DELETE FROM opac_news WHERE idnew IN ($ids)"); + $sth->execute(); + $sth->finish; + return 1; + } else { + return 0; + } +} + +sub get_opac_new { + my ($idnew) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("SELECT * FROM opac_news WHERE idnew = ?"); + $sth->execute($idnew); + my $data = $sth->fetchrow_hashref; + $data->{$data->{'lang'}} = 1; + $sth->finish; + return $data; +} + +sub get_opac_news { + my ($limit, $lang) = @_; + my $dbh = C4::Context->dbh; + my $query = "SELECT *, DATE_FORMAT(timestamp, '%d/%m/%Y') AS newdate FROM opac_news"; + if ($lang) { + $query.= " WHERE lang = '" .$lang ."' "; + } + $query.= " ORDER BY timestamp DESC "; + #if ($limit) { + # $query.= "LIMIT 0, " . $limit; + #} + my $sth = $dbh->prepare($query); + $sth->execute(); + my @opac_news; + my $count = 0; + while (my $row = $sth->fetchrow_hashref) { + if ((($limit) && ($count < $limit)) || (!$limit)) { + $row->{'newdate'} = format_date($row->{'newdate'}); + push @opac_news, $row; + } + $count++; + } + return ($count, \@opac_news); +} + +### get electronic databases + +sub add_opac_electronic { + my ($title, $edata, $lang,$image,$href,$section) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("INSERT INTO opac_electronic (title, edata, lang,image,href,section) VALUES (?,?,?,?,?,?)"); + $sth->execute($title, $edata, $lang,$image,$href,$section); + $sth->finish; + return 1; +} + +sub upd_opac_electronic { + my ($idelectronic, $title, $edata, $lang, $image, $href,$section) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("UPDATE opac_electronic SET title = ?, edata = ?, lang = ? , image=?, href=? ,section=? WHERE idelectronic = ?"); + $sth->execute($title, $edata, $lang, $image,$href ,$section, $idelectronic); + $sth->finish; + return 1; +} + +sub del_opac_electronic { + my ($ids) = @_; + if ($ids) { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("DELETE FROM opac_electronic WHERE idelectronic IN ($ids)"); + $sth->execute(); + $sth->finish; + return 1; + } else { + return 0; + } +} + +sub get_opac_electronic { + my ($idelectronic) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("SELECT * FROM opac_electronic WHERE idelectronic = ?"); + $sth->execute($idelectronic); + my $data = $sth->fetchrow_hashref; + $data->{$data->{'lang'}} = 1; + $data->{$data->{'section'}} = 1; + $sth->finish; + return $data; +} + +sub get_opac_electronics { + my ($section, $lang) = @_; + my $dbh = C4::Context->dbh; + my $query = "SELECT *, DATE_FORMAT(timestamp, '%d/%m/%Y') AS newdate FROM opac_electronic"; + if ($lang) { + $query.= " WHERE lang = '" .$lang ."' "; + } + if ($section) { + $query.= " and section= '" . $section."' "; + } + $query.= " ORDER BY title "; + + my $sth = $dbh->prepare($query); + $sth->execute(); + my @opac_electronic; + my $count = 0; + while (my $row = $sth->fetchrow_hashref) { + push @opac_electronic, $row; + + + $count++; + } + + return ($count,\@opac_electronic); +} +END { } # module clean-up code here (global destructor) + +=back + +=head1 AUTHOR + +TG + +=cut + + diff --git a/C4/Output.pm b/C4/Output.pm index b1830c293b..4759c7ff95 100644 --- a/C4/Output.pm +++ b/C4/Output.pm @@ -1,5 +1,4 @@ package C4::Output; - # $Id$ #package to deal with marking up output @@ -24,15 +23,12 @@ package C4::Output; # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA -# NOTE: I'm pretty sure this module is deprecated in favor of -# templates. use strict; require Exporter; use C4::Context; -use C4::Database; -use HTML::Template; +use HTML::Template::Pro; use vars qw($VERSION @ISA @EXPORT); @@ -72,10 +68,15 @@ if (!$query){ $htdocs = C4::Context->config('intrahtdocs'); } my $path = C4::Context->preference('intranet_includes') || 'includes'; - warn "PATH : $path"; +# warn "PATH : $path"; +my $filter=sub { +#my $win=shift; +$_=~s /\xef\xbb\xbf//g; +}; my ($theme, $lang) = themelanguage($htdocs, $tmplbase, $opac, $query); my $opacstylesheet = C4::Context->preference('opacstylesheet'); - my $template = HTML::Template->new(filename => "$htdocs/$theme/$lang/$tmplbase", + +my $template = HTML::Template::Pro->new(filename => "$htdocs/$theme/$lang/$tmplbase", case_sensitive=>1, die_on_bad_params => 0, global_vars => 1, path => ["$htdocs/$theme/$lang/$path"]); @@ -102,17 +103,22 @@ sub themelanguage { my $dbh = C4::Context->dbh; my @languages; my @themes; - if ( $section eq "intranet") - { +my ($theme, $lang); + if ($section eq "intranet"){ + $lang=$query->cookie('KohaOpacLanguage'); + + if ($lang){ + + push @languages,$lang; + @themes = split " ", C4::Context->preference("template"); + } + else { @languages = split " ", C4::Context->preference("opaclanguages"); @themes = split " ", C4::Context->preference("template"); - } - else - { - # we are in the opac here, what im trying to do is let the individual user - # set the theme they want to use. - # and perhaps the them as well. - my $lang=$query->cookie('KohaOpacLanguage'); + } + }else{ + $lang=$query->cookie('KohaOpacLanguage'); + if ($lang){ push @languages,$lang; @@ -122,9 +128,9 @@ sub themelanguage { @languages = split " ", C4::Context->preference("opaclanguages"); @themes = split " ", C4::Context->preference("opacthemes"); } - } +} - my ($theme, $lang); + # searches through the themes and languages. First template it find it returns. # Priority is for getting the theme right. THEME: diff --git a/C4/Reserves2.pm b/C4/Reserves2.pm index fc6f4d80f3..7056b46c50 100755 --- a/C4/Reserves2.pm +++ b/C4/Reserves2.pm @@ -7,7 +7,7 @@ package C4::Reserves2; # Copyright 2000-2002 Katipo Communications # -# This file is part of Koha. +# This file is hard coded with koha-reserves table to be used only by the OPAC -TG. # # Koha is free software; you can redistribute it and/or modify it under the # terms of the GNU General Public License as published by the Free Software @@ -24,11 +24,15 @@ package C4::Reserves2; use strict; require Exporter; -use DBI; +#use DBI; use C4::Context; +use C4::Search; use C4::Biblio; + # FIXME - C4::Reserves2 uses C4::Search, which uses C4::Reserves2. + # So Perl complains that all of the functions here get redefined. +#use C4::Accounts; + use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); -my $library_name = C4::Context->preference("LibraryName"); # set the version for version checking $VERSION = 0.01; @@ -53,171 +57,118 @@ FIXME @ISA = qw(Exporter); # FIXME Take out CalcReserveFee after it can be removed from opac-reserves.pl -@EXPORT = qw( - &FindReserves - &CheckReserves - &CheckWaiting - &CancelReserve - &CalcReserveFee - &FillReserve - &ReserveWaiting - &CreateReserve - &updatereserves - &UpdateReserve - &getreservetitle - &Findgroupreserve - &FastFindReserves - &SetWaitingStatus - &GlobalCancel - &MinusPriority - &OtherReserves - GetFirstReserveDateFromItem - GetNumberReservesFromBorrower - &fixpriority -); +@EXPORT = qw(&FindReserves + &FindAllReserves + &CheckReserves + &CheckWaiting + &CancelReserve + &CalcReserveFee + &FillReserve + &ReserveWaiting + &CreateReserve + &UpdateReserves + &UpdateReserve + &getreservetitle + &Findgroupreserve + &findActiveReserve + + ); # make all your functions, whether exported or not; -=item GlobalCancel - New op dev for the circulation based on item, global is a function to cancel reserv,check other reserves, and transfer document if it's necessary -=cut -#' -sub GlobalCancel { - my $messages; - my $nextreservinfo; - my ($itemnumber,$borrowernumber)=@_; - -# step 1 : cancel the reservation - my $CancelReserve = CancelReserve(0,$itemnumber,$borrowernumber); - -# step 2 launch the subroutine of the others reserves - my ($messages,$nextreservinfo) = OtherReserves($itemnumber); -return ($messages,$nextreservinfo); -} - -=item OtherReserves - New op dev: check queued list of this document and check if this document must be transfered -=cut -#' -sub OtherReserves { - my ($itemnumber)=@_; - my $messages; - my $nextreservinfo; - my ($restype,$checkreserves) = CheckReserves($itemnumber); - if ($checkreserves){ - my %env; - my $iteminfo = C4::Circulation::Circ2::getiteminformation(\%env,$itemnumber); - if ($iteminfo->{'holdingbranch'} ne $checkreserves->{'branchcode'}){ - $messages->{'transfert'} = $checkreserves->{'branchcode'}; - -# minus priorities of others reservs - MinusPriority($itemnumber,$checkreserves->{'borrowernumber'},$iteminfo->{'biblionumber'}); -# launch the subroutine dotransfer - C4::Circulation::Circ2::dotransfer($itemnumber,$iteminfo->{'holdingbranch'},$checkreserves->{'branchcode'}), - } +=item FindReserves -# step 2b : case of a reservation on the same branch, set the waiting status - else{ - $messages->{'waiting'} = 1; - MinusPriority($itemnumber,$checkreserves->{'borrowernumber'},$iteminfo->{'biblionumber'}); - SetWaitingStatus($itemnumber); - } + ($count, $results) = &FindReserves($biblionumber, $borrowernumber); - $nextreservinfo = $checkreserves->{'borrowernumber'}; - } +Looks books up in the reserves. C<$biblionumber> is the biblionumber +of the book to look up. C<$borrowernumber> is the borrower number of a +patron whose books to look up. - return ($messages,$nextreservinfo); -} +Either C<$biblionumber> or C<$borrowernumber> may be the empty string, +but not both. If both are specified, C<&FindReserves> looks up the +given book for the given patron. If only C<$biblionumber> is +specified, C<&FindReserves> looks up that book for all patrons. If +only C<$borrowernumber> is specified, C<&FindReserves> looks up all of +that patron's reserves. If neither is specified, C<&FindReserves> +barfs. -=item MinusPriority - Reduce the values of queuded list -=cut -#' -sub MinusPriority{ - my ($itemnumber,$borrowernumber,$biblionumber)=@_; -# first step update the value of the first person on reserv - my $dbh = C4::Context->dbh; - my $sth_upd=$dbh->prepare("UPDATE reserves SET priority = 0 , itemnumber = ? - WHERE cancellationdate is NULL - AND borrowernumber=? - AND biblionumber=?"); - $sth_upd->execute($itemnumber,$borrowernumber,$biblionumber); - $sth_upd->finish; - -# second step update all others reservs - my $sth_oth=$dbh->prepare("SELECT priority,borrowernumber,biblionumber,reservedate FROM reserves WHERE priority !='0' AND cancellationdate is NULL"); - $sth_oth->execute(); - while (my ($priority,$borrowernumber,$biblionumber,$reservedate)=$sth_oth->fetchrow_array){ - $priority--; - my $sth_upd_oth = $dbh->prepare("UPDATE reserves SET priority = ? - WHERE biblionumber = ? - AND borrowernumber = ? - AND reservedate = ?"); - $sth_upd_oth->execute($priority,$biblionumber,$borrowernumber,$reservedate); - $sth_upd_oth->finish; - } - $sth_oth->finish; +C<&FindReserves> returns a two-element array: -} +C<$count> is the number of elements in C<$results>. +C<$results> is a reference-to-array; each element is a +reference-to-hash, whose keys are (I think) all of the fields of the +reserves, borrowers, and biblio tables of the Koha database. -=item GlobalCancel - New op dev for the circulation based on item, global is a function to cancel reserv,check other reserves, and transfer document if it's necessary =cut #' -# New op dev : -# we check if we have a reserves with itemnumber (New op system of reserves), if we found one, we update the status of the reservation when we have : 'priority' = 0, and we have an itemnumber -sub SetWaitingStatus{ -# first : check if we have a reservation for this item . - my ($itemnumber)=@_; - my $dbh = C4::Context->dbh; - my $sth_find=$dbh->prepare("SELECT priority,borrowernumber from reserves WHERE itemnumber=? and cancellationdate is NULL and found is NULL and priority='0'"); - $sth_find->execute($itemnumber); - my ($priority,$borrowernumber) = $sth_find->fetchrow_array; - $sth_find->finish; - if (not $borrowernumber){ - return(); - } - else{ -# step 2 : if we have a borrowernumber, we update the value found to 'W' for notify the borrower - my $sth_set=$dbh->prepare("UPDATE reserves SET found='W',waitingdate = now() where borrowernumber=? AND itemnumber=? AND found is null"); - $sth_set->execute($borrowernumber,$itemnumber); - $sth_set->finish; - } - -} +sub FindReserves { + my ($bib, $bor) = @_; + my @params; -sub FastFindReserves { - my ($itemnumber,$borrowernumber)=@_; - if ($itemnumber){ - my $dbh = C4::Context->dbh; - my $sth_res=$dbh->prepare("SELECT reservedate,borrowernumber from reserves WHERE itemnumber=? and cancellationdate is NULL AND (found != 'F' or found is null)"); - $sth_res->execute($itemnumber); - my ($reservedate,$borrowernumber)=$sth_res->fetchrow_array; - $sth_res->finish; - return($reservedate,$borrowernumber); + my $dbh = C4::Context->dbh; + # Find the desired items in the reserves + my $query="SELECT *, reserves.branchcode, reserves.timestamp as rtimestamp, DATE_FORMAT(reserves.timestamp, '%T') AS time + FROM reserves,borrowers,items "; + if ($bib ne ''){ + #$bib = $dbh->quote($bib); + if ($bor ne ''){ + # Both $bib and $bor specified + # Find a particular book for a particular patron + #$bor = $dbh->quote($bor); + $query .= "WHERE (reserves.biblionumber = ?) and + (borrowers.borrowernumber = ?) and + (reserves.borrowernumber = borrowers.borrowernumber) and + (reserves.itemnumber=items.itemnumber) and + (cancellationdate IS NULL) and + (found <> 1) "; + + push @params, $bib, $bor; + } else { + # $bib specified, but not $bor + # Find a particular book for all patrons + $query .= "WHERE (reserves.borrowernumber = borrowers.borrowernumber) and + (reserves.biblionumber = ?) and + (reserves.itemnumber=items.itemnumber) and + (cancellationdate IS NULL) and + (found <> 1) "; + + push @params, $bib; + } + } else { + $query .= "WHERE (reserves.biblionumber = items.biblionumber) and + (borrowers.borrowernumber = ?) and + (reserves.borrowernumber = borrowers.borrowernumber) and + (reserves.itemnumber=items.itemnumber) and + (cancellationdate IS NULL) and + (found <> 1)"; + + push @params, $bor; } - if ($borrowernumber){ - my $dbh = C4::Context->dbh; - my $sth_find=$dbh->prepare("SELECT * from reserves WHERE borrowernumber=? and cancellationdate is NULL and (found != 'F' or found is null) order by reservedate"); - $sth_find->execute($borrowernumber); - my @borrowerreserv; - my $i=0; - while (my $data=$sth_find->fetchrow_hashref){ - $borrowerreserv[$i]=$data; - $i++; - } - $sth_find->finish; - return (@borrowerreserv); + $query.=" order by reserves.timestamp"; + my $sth = $dbh->prepare($query); + $sth->execute(@params); + + my $i = 0; + my @results; + while (my $data = $sth->fetchrow_hashref){ + my ($bibdatarecord) =MARCgetbiblio($dbh,$data->{'biblionumber'}); + my $bibdata=MARCmarc2koha($dbh,$bibdatarecord,"biblios"); + $data->{'author'} = $bibdata->{'author'}; + $data->{'publishercode'} = $bibdata->{'publishercode'}; + $data->{'publicationyear'} = $bibdata->{'publicationyear'}; + $data->{'title'} = $bibdata->{'title'}; + push @results, $data; + $i++; } + $sth->finish; + return($i,\@results); } +=item FindAllReserves - -=item FindReserves - - ($count, $results) = &FindReserves($biblionumber, $borrowernumber); + ($count, $results) = &FindAllReserves($biblionumber, $borrowernumber); Looks books up in the reserves. C<$biblionumber> is the biblionumber of the book to look up. C<$borrowernumber> is the borrower number of a @@ -231,146 +182,86 @@ only C<$borrowernumber> is specified, C<&FindReserves> looks up all of that patron's reserves. If neither is specified, C<&FindReserves> barfs. -For each book thus found, C<&FindReserves> checks the reserve -constraints and does something I don't understand. - -C<&FindReserves> returns a two-element array: +C<&FindAllReserves> returns a two-element array: C<$count> is the number of elements in C<$results>. -C<$results> is a reference to an array of references of hashes. Each hash -has for keys a list of column from reserves table (see details in function). +C<$results> is a reference-to-array; each element is a +reference-to-hash, whose keys are (I think) all of the fields of the +reserves, borrowers, and biblio tables of the Koha database. =cut #' -sub FindReserves { - my ($bib, $bor) = @_; - my $dbh = C4::Context->dbh; - my @bind; - - # Find the desired items in the reserves - my $query = ' -SELECT branchcode, - timestamp AS rtimestamp, - priority, - biblionumber, - borrowernumber, - reservedate, - constrainttype, - found - FROM reserves - WHERE cancellationdate IS NULL - AND (found <> \'F\' OR found IS NULL) -'; - - if ($bib ne '') { - $query.= ' - AND biblionumber = ? -'; - push @bind, $bib; - } - - if ($bor ne '') { - $query.= ' - AND borrowernumber = ? -'; - push @bind, $bor; - } - - $query.= ' - ORDER BY priority -'; - my $sth=$dbh->prepare($query); - $sth->execute(@bind); - my @results; - my $i = 0; - while (my $data = $sth->fetchrow_hashref){ - # FIXME - What is this if-statement doing? How do constraints work? - if ($data->{constrainttype} eq 'o') { - $query = ' -SELECT biblioitemnumber - FROM reserveconstraints - WHERE biblionumber = ? - AND borrowernumber = ? - AND reservedate = ? -'; - my $csth=$dbh->prepare($query); - $csth->execute( - $data->{biblionumber}, - $data->{borrowernumber}, - $data->{reservedate}, - ); - - my @bibitemno; - while (my $bibitemnos = $csth->fetchrow_array){ - push (@bibitemno,$bibitemnos); - } - my $count = @bibitemno; - - # if we have two or more different specific itemtypes - # reserved by same person on same day - my $bdata; - if($count > 1){ - warn "bibitemno $bibitemno[$i]"; - $bdata = C4::Search::bibitemdata($bibitemno[$i]); - $i++; - } else { - # Look up the book we just found. - $bdata = C4::Search::bibitemdata($bibitemno[0]); - } - $csth->finish; - # Add the results of this latest search to the current - # results. - # FIXME - An 'each' would probably be more efficient. - foreach my $key (keys %$bdata) { - $data->{$key} = $bdata->{$key}; - } - } - push @results, $data; - } - $sth->finish; - - return($#results+1,\@results); -} - -sub GetNumberReservesFromBorrower { - my ($borrowernumber) = @_; - - my $dbh = C4::Context->dbh; - - my $query = ' -SELECT COUNT(*) AS counter - FROM reserves - WHERE borrowernumber = ? - AND cancellationdate IS NULL - AND (found != \'F\' OR found IS NULL) -'; - my $sth = $dbh->prepare($query); - $sth->execute($borrowernumber); - my $row = $sth->fetchrow_hashref; - $sth->finish; - - return $row->{counter}; -} - -sub GetFirstReserveDateFromItem { - my ($itemnumber) = @_; - - my $dbh = C4::Context->dbh; - - my $query = ' -SELECT reservedate - FROM reserves - WHERE itemnumber = ? - AND cancellationdate IS NULL - AND (found != \'F\' OR found IS NULL) -'; - my $sth = $dbh->prepare($query); - $sth->execute($itemnumber); - my $row = $sth->fetchrow_hashref; - $sth->finish; +sub FindAllReserves { + my ($bib, $bor) = @_; + my @params; + +my $dbh; + + $dbh = C4::Context->dbh; + + # Find the desired items in the reserves + my $query="SELECT *, + reserves.branchcode, + biblio.title AS btitle, + reserves.timestamp as rtimestamp, + DATE_FORMAT(reserves.timestamp, '%T') AS time + FROM reserves, + borrowers, + biblio "; + if ($bib ne ''){ + #$bib = $dbh->quote($bib); + if ($bor ne ''){ + # Both $bib and $bor specified + # Find a particular book for a particular patron + #$bor = $dbh->quote($bor); + $query .= "WHERE (reserves.biblionumber = ?) and + (borrowers.borrowernumber = ?) and + (reserves.borrowernumber = borrowers.borrowernumber) and + (biblio.biblionumber = ?) and + (cancellationdate IS NULL) and + (found <> 1) and + (reservefrom > NOW())"; + push @params, $bib, $bor, $bib; + } else { + # $bib specified, but not $bor + # Find a particular book for all patrons + $query .= "WHERE (reserves.borrowernumber = borrowers.borrowernumber) and + (biblio.biblionumber = ?) and + (reserves.biblionumber = ?) and + (cancellationdate IS NULL) and + (found <> 1) and + (reservefrom > NOW())"; + push @params, $bib, $bib; + } + } else { + $query .= "WHERE (reserves.biblionumber = biblio.biblionumber) and + (borrowers.borrowernumber = ?) and + (reserves.borrowernumber = borrowers.borrowernumber) and + (reserves.biblionumber = biblio.biblionumber) and + (cancellationdate IS NULL) and + (found <> 1) and + (reservefrom > NOW())"; + push @params, $bor; + } + $query.=" order by reserves.timestamp"; + my $sth = $dbh->prepare($query); + $sth->execute(@params); + + my $i = 0; + my @results; + while (my $data = $sth->fetchrow_hashref){ + my $bibdata = C4::Search::bibdata($data->{'biblionumber'}); + $data->{'author'} = $bibdata->{'author'}; + $data->{'publishercode'} = $bibdata->{'publishercode'}; + $data->{'publicationyear'} = $bibdata->{'publicationyear'}; + $data->{'title'} = $bibdata->{'title'}; + push @results, $data; + $i++; + } + $sth->finish; - return $row->{reservedate}; + return($i,\@results); } =item CheckReserves @@ -410,31 +301,24 @@ sub CheckReserves { my $dbh = C4::Context->dbh; my $sth; if ($item) { - my $qitem=$dbh->quote($item); - # Look up the item by itemnumber - $sth=$dbh->prepare("SELECT items.biblionumber, items.biblioitemnumber, itemtypes.notforloan - FROM items, biblioitems, itemtypes - WHERE items.biblioitemnumber = biblioitems.biblioitemnumber - AND biblioitems.itemtype = itemtypes.itemtype - AND itemnumber=$qitem"); + } else { my $qbc=$dbh->quote($barcode); # Look up the item by barcode - $sth=$dbh->prepare("SELECT items.biblionumber, items.biblioitemnumber, itemtypes.notforloan - FROM items, biblioitems, itemtypes - WHERE items.biblioitemnumber = biblioitems.biblioitemnumber - AND biblioitems.itemtype = itemtypes.itemtype - AND barcode=$qbc"); - # FIXME - This function uses $item later on. Ought to set it here. - } - $sth->execute; - my ($biblio, $bibitem, $notforloan) = $sth->fetchrow_array; + $sth=$dbh->prepare("SELECT items.itemnumber + FROM items + WHERE barcode=$qbc"); + $sth->execute; + ($item) = $sth->fetchrow; $sth->finish; + } + + # if item is not for loan it cannot be reserved either..... - return (0, 0) if ($notforloan); +# return (0, 0) if ($notforloan); # get the reserves... # Find this item in the reserves - my ($count, @reserves) = Findgroupreserve($bibitem, $biblio); + my ($count, @reserves) = Findgroupreserve($item); # $priority and $highest are used to find the most important item # in the list returned by &Findgroupreserve. (The lower $priority, # the more important the item.) @@ -443,19 +327,16 @@ sub CheckReserves { my $highest; if ($count) { foreach my $res (@reserves) { - # FIXME - $item might be undefined or empty: the caller - # might be searching by barcode. - if ($res->{'itemnumber'} == $item) { - # Found it - return ("Waiting", $res); - } else { + if ($res->{found} eq "W"){ + return ("Waiting", $res); + }else{ # See if this item is more important than what we've got # so far. if ($res->{'priority'} != 0 && $res->{'priority'} < $priority) { $priority = $res->{'priority'}; $highest = $res; } - } + } } } @@ -472,25 +353,23 @@ sub CheckReserves { =item CancelReserve - &CancelReserve($biblionumber, $itemnumber, $borrowernumber); + &CancelReserve($reserveid); Cancels a reserve. -Use either C<$biblionumber> or C<$itemnumber> to specify the item to -cancel, but not both: if both are given, C<&CancelReserve> does -nothing. - -C<$borrowernumber> is the borrower number of the patron on whose -behalf the book was reserved. +Use reserveid to cancel the reservation. -If C<$biblionumber> was given, C<&CancelReserve> also adjusts the -priorities of the other people who are waiting on the book. +C<$reserveid> is the reserve ID to cancel. =cut #' sub CancelReserve { my ($biblio, $item, $borr) = @_; - my $dbh = C4::Context->dbh; + +my $dbh; + + $dbh = C4::Context->dbh; + #warn "In CancelReserve"; if (($item and $borr) and (not $biblio)) { # removing a waiting reserve record.... @@ -511,42 +390,42 @@ sub CancelReserve { WHERE biblionumber = ? AND borrowernumber = ? AND cancellationdate is NULL - AND (found <> 'F' or found is NULL)"); + AND (found <> 1 )"); $sth->execute($biblio,$borr); ($priority) = $sth->fetchrow_array; $sth->finish; # update the database, removing the record... - $sth = $dbh->prepare("update reserves set cancellationdate = now(), - found = Null, + $sth = $dbh->prepare("update reserves set cancellationdate = now(), + found = 0, priority = 0 where biblionumber = ? and borrowernumber = ? and cancellationdate is NULL - and (found <> 'F' or found is NULL)"); + and (found <> 1 )"); $sth->execute($biblio,$borr); $sth->finish; # now fix the priority on the others.... fixpriority($priority, $biblio); } } - =item FillReserve - &FillReserve($reserve); + &FillReserve($reserveid, $itemnumber); Fill a reserve. If I understand this correctly, this means that the reserved book has been found and given to the patron who reserved it. -C<$reserve> specifies the reserve to fill. It is a reference-to-hash -whose keys are fields from the reserves table in the Koha database. +C<$reserve> specifies the reserve id to fill. + +C<$itemnumber> specifies the borrowed itemnumber for the reserve. =cut #' sub FillReserve { my ($res) = @_; - my $dbh = C4::Context->dbh; - +my $dbh; + $dbh = C4::Context->dbh; # fill in a reserve record.... # FIXME - Remove some of the redundancy here my $biblio = $res->{'biblionumber'}; my $qbiblio =$biblio; @@ -568,7 +447,7 @@ sub FillReserve { # update the database... { - my $query = "UPDATE reserves SET found = 'F', + my $query = "UPDATE reserves SET found = 1, priority = 0 WHERE biblionumber = ? AND reservedate = ? @@ -585,97 +464,56 @@ sub FillReserve { } } -# Only used internally + reorder_reserve.pl -# Changed how this functions works # -# Now just gets an array of reserves in the rank order and updates them with -# the array index (+1 as array starts from 0) -# and if $rank is supplied will splice item from the array and splice it back in again -# in new priority rank +# Only used internally +# Decrements (makes more important) the reserves for all of the +# entries waiting on the given book, if their priority is > $priority. sub fixpriority { - my ($biblio,$borrowernumber,$rank) = @_; - my $dbh = C4::Context->dbh; - - warn "BIB: $biblio, BORR: $borrowernumber, RANK: $rank"; - if($rank eq "del"){ - warn "Cancel"; - CancelReserve($biblio,undef,$borrowernumber); - } - if($rank eq "W" || $rank eq "0"){ - # make sure priority for waiting items is 0 - my $sth=$dbh->prepare("UPDATE reserves SET priority = 0 - WHERE biblionumber = ? - AND borrowernumber = ? - AND cancellationdate is NULL - AND found ='W'"); - $sth->execute($biblio,$borrowernumber); - } - my @priority; - my @reservedates; - # get whats left - my $sth=$dbh->prepare("SELECT borrowernumber, reservedate, constrainttype FROM reserves - WHERE biblionumber = ? - AND cancellationdate is NULL - AND ((found <> 'F' and found <> 'W') or found is NULL) ORDER BY priority ASC"); - $sth->execute($biblio); - while(my $line = $sth->fetchrow_hashref){ - push(@reservedates,$line); - push(@priority,$line); - } - # To find the matching index - my $i; - my $key = -1; # to allow for 0 to be a valid result - for ($i = 0; $i < @priority; $i++) { - if ($borrowernumber == $priority[$i]->{'borrowernumber'}) { - $key = $i; # save the index - last; - } - } - warn "key: $key"; - # if index exists in array then move it to new position - if($key>-1 && $rank ne 'del' && $rank > 0){ - my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array - my $moving_item = splice(@priority, $key, 1); - splice(@priority, $new_rank, 0, $moving_item); - } - # now fix the priority on those that are left.... - for(my $j=0;$j<@priority;$j++){ - # warn "update reserves set priority = ".($j+1)." where biblionumber = $biblio and borrowernumber = $priority[$j]->{'borrowernumber'} "; - # warn "and reservedate =$priority[$j]->{'reservedate'}"; - my $sth = $dbh->prepare("UPDATE reserves SET priority = " . ($j+1 ) . " - WHERE biblionumber = ? - AND borrowernumber = ? - AND reservedate = ? and found is null"); - $sth->execute($biblio,$priority[$j]->{'borrowernumber'},$priority[$j]->{'reservedate'}); - $sth->finish; + my ($priority, $biblio) = @_; +my $dbh; + $dbh = C4::Context->dbh; + + my ($count, $reserves) = FindReserves($biblio); + foreach my $rec (@$reserves) { + if ($rec->{'priority'} > $priority) { + my $sth = $dbh->prepare("UPDATE reserves SET priority = ? + WHERE biblionumber = ? + AND borrowernumber = ? + AND reservedate = ?"); + $sth->execute($rec->{'priority'},$rec->{'biblionumber'},$rec->{'borrowernumber'},$rec->{'reservedate'}); + $sth->finish; + } } } # XXX - POD sub ReserveWaiting { my ($item, $borr) = @_; - my $dbh = C4::Context->dbh; + +my $dbh; + + $dbh = C4::Context->dbh; + # get priority and biblionumber.... my $sth = $dbh->prepare("SELECT reserves.priority as priority, reserves.biblionumber as biblionumber, reserves.branchcode as branchcode, reserves.timestamp as timestamp - FROM reserves,items - WHERE reserves.biblionumber = items.biblionumber - AND items.itemnumber = ? + FROM reserves + WHERE reserves.itemnumber = ? AND reserves.borrowernumber = ? AND reserves.cancellationdate is NULL - AND (reserves.found <> 'F' or reserves.found is NULL)"); + AND (reserves.found <> '1' or reserves.found is NULL)"); $sth->execute($item,$borr); my $data = $sth->fetchrow_hashref; $sth->finish; my $biblio = $data->{'biblionumber'}; my $timestamp = $data->{'timestamp'}; # update reserves record.... - $sth = $dbh->prepare("UPDATE reserves SET priority = 0, found = 'W', itemnumber = ? + $sth = $dbh->prepare("UPDATE reserves SET priority = 0, found = 'W' WHERE borrowernumber = ? - AND biblionumber = ? + AND itemnumber = ? AND timestamp = ?"); - $sth->execute($item,$borr,$biblio,$timestamp); + $sth->execute($borr,$item,$timestamp); $sth->finish; # now fix up the remaining priorities.... fixpriority($data->{'priority'}, $biblio); @@ -686,7 +524,9 @@ sub ReserveWaiting { # XXX - POD sub CheckWaiting { my ($borr)=@_; - my $dbh = C4::Context->dbh; + +my $dbh; + $dbh = C4::Context->dbh; my @itemswaiting; my $sth = $dbh->prepare("SELECT * FROM reserves WHERE borrowernumber = ? @@ -721,32 +561,20 @@ C. =cut #' sub Findgroupreserve { - my ($bibitem,$biblio)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("SELECT reserves.biblionumber AS biblionumber, - reserves.borrowernumber AS borrowernumber, - reserves.reservedate AS reservedate, - reserves.branchcode AS branchcode, - reserves.cancellationdate AS cancellationdate, - reserves.found AS found, - reserves.reservenotes AS reservenotes, - reserves.priority AS priority, - reserves.timestamp AS timestamp, - reserveconstraints.biblioitemnumber AS biblioitemnumber, - reserves.itemnumber AS itemnumber - FROM reserves LEFT JOIN reserveconstraints - ON reserves.biblionumber = reserveconstraints.biblionumber - WHERE reserves.biblionumber = ? - AND ( ( reserveconstraints.biblioitemnumber = ? - AND reserves.borrowernumber = reserveconstraints.borrowernumber - AND reserves.reservedate =reserveconstraints.reservedate ) - OR reserves.constrainttype='a' ) - AND reserves.cancellationdate is NULL - AND (reserves.found <> 'F' or reserves.found is NULL)"); - $sth->execute($biblio, $bibitem); + my ($itemnumber)=@_; + +my $dbh = C4::Context->dbh; + + my $sth = $dbh->prepare("SELECT * + FROM reserves + WHERE (itemnumber = ?) AND + (cancellationdate IS NULL) AND + (found <> 1) + ORDER BY timestamp"); + $sth->execute($itemnumber); my @results; - while (my $data=$sth->fetchrow_hashref){ - push(@results,$data); + while (my $data = $sth->fetchrow_hashref) { + push(@results,$data); } $sth->finish; return(scalar(@results),@results); @@ -756,67 +584,40 @@ sub Findgroupreserve { # C4::Reserves. Pick one and stick with it. # XXX - POD sub CreateReserve { - my ($env,$branch,$borrnum,$biblionumber,$constraint,$bibitems,$priority,$notes,$title,$checkitem,$found)= @_; - my $fee; - if($library_name =~ /Horowhenua/){ - $fee = CalcHLTReserveFee($env,$borrnum,$biblionumber,$constraint,$bibitems); - } else { - $fee = CalcReserveFee($env,$borrnum,$biblionumber,$constraint,$bibitems); - } - my $dbh = C4::Context->dbh; - my $const = lc substr($constraint,0,1); - my @datearr = localtime(time); - my $resdate =(1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3]; - my $waitingdate; -# If the reserv had the waiting status, we had the value of the resdate - if ($found eq 'W'){ - $waitingdate = $resdate; - } - #eval { - # updates take place here - if ($fee > 0) { -# print $fee; + my ($env, $borrnum,$registeredby ,$biblionumber,$reservefrom, $reserveto, $branch, + $constraint, $priority, $notes, $title,$bibitems,$itemnumber) = @_; + +my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("INSERT INTO reserves + (borrowernumber, registeredby, reservedate, biblionumber, reservefrom, + reserveto, branchcode, constrainttype, priority, found, reservenotes,itemnumber) + VALUES (?, ?, NOW(),?,?,?,?,?,?,0,?,?)"); + $sth->execute($borrnum, $registeredby, $biblionumber, $reservefrom, $reserveto, $branch, $constraint, $priority, $notes,$itemnumber); +my $fee=CalcReserveFee($env,$borrnum,$biblionumber,$constraint,$bibitems); + if ($fee > 0) { + my $nextacctno = &getnextacctno($env,$borrnum,$dbh); my $usth = $dbh->prepare("insert into accountlines (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding) values (?,?,now(),?,?,'Res',?)"); - $usth->execute($borrnum,$nextacctno,$fee,"Reserve Charge - $title",$fee); + $usth->execute($borrnum,$nextacctno,$fee,'Reserve Charge -'. $title,$fee); $usth->finish; } - #if ($const eq 'a'){ - my $sth = $dbh->prepare("insert into reserves - (borrowernumber,biblionumber,reservedate,branchcode,constrainttype,priority,reservenotes,itemnumber,found,waitingdate) - values (?,?,?,?,?,?,?,?,?,?)"); - $sth->execute($borrnum,$biblionumber,$resdate,$branch,$const,$priority,$notes,$checkitem,$found,$waitingdate); - $sth->finish; - #} - if (($const eq "o") || ($const eq "e")) { - my $numitems = @$bibitems; - my $i = 0; - while ($i < $numitems) { - my $biblioitem = @$bibitems[$i]; - my $sth = $dbh->prepare("insert into - reserveconstraints - (borrowernumber,biblionumber,reservedate,biblioitemnumber) - values (?,?,?,?)"); - $sth->execute($borrnum,$biblionumber,$resdate,$biblioitem); - $sth->finish; - $i++; - } - } -# print $query; - return(); + return 1; } # FIXME - A functionally identical version of this function appears in # C4::Reserves. Pick one and stick with it. # XXX - Internal use only # FIXME - opac-reserves.pl need to use it, temporarily put into @EXPORT + sub CalcReserveFee { my ($env,$borrnum,$biblionumber,$constraint,$bibitems) = @_; #check for issues; - my $dbh = C4::Context->dbh; +my $dbh = C4::Context->dbh; + + my $const = lc substr($constraint,0,1); my $sth = $dbh->prepare("SELECT * FROM borrowers,categories WHERE (borrowernumber = ?) @@ -825,48 +626,18 @@ sub CalcReserveFee { my $data = $sth->fetchrow_hashref; $sth->finish(); my $fee = $data->{'reservefee'}; - my $cntitems = @->$bibitems; + if ($fee > 0) { # check for items on issue - # first find biblioitem records - my @biblioitems; - my $sth1 = $dbh->prepare("SELECT * FROM biblio,biblioitems - WHERE (biblio.biblionumber = ?) - AND (biblio.biblionumber = biblioitems.biblionumber)"); - $sth1->execute($biblionumber); - while (my $data1=$sth1->fetchrow_hashref) { - if ($const eq "a") { - push @biblioitems,$data1; - } else { - my $found = 0; - my $x = 0; - while ($x < $cntitems) { - if (@$bibitems->{'biblioitemnumber'} == $data->{'biblioitemnumber'}) { - $found = 1; - } - $x++; - } - if ($const eq 'o') { - if ( $found == 1) { - push @biblioitems,$data1; - } - } else { - if ($found == 0) { - push @biblioitems,$data1; - } - } - } - } - $sth1->finish; - my $cntitemsfound = @biblioitems; + + my $issues = 0; my $x = 0; my $allissued = 1; - while ($x < $cntitemsfound) { - my $bitdata = $biblioitems[$x]; + my $sth2 = $dbh->prepare("SELECT * FROM items - WHERE biblioitemnumber = ?"); - $sth2->execute($bitdata->{'biblioitemnumber'}); + WHERE biblionumber = ?"); + $sth2->execute($biblionumber); while (my $itdata=$sth2->fetchrow_hashref) { my $sth3 = $dbh->prepare("SELECT * FROM issues WHERE itemnumber = ? @@ -877,8 +648,8 @@ sub CalcReserveFee { $allissued = 0; } } - $x++; - } + + if ($allissued == 0) { my $rsth = $dbh->prepare("SELECT * FROM reserves WHERE biblionumber = ?"); $rsth->execute($biblionumber); @@ -889,53 +660,10 @@ sub CalcReserveFee { } } # print "fee $fee"; + return $fee; } -# The following are junior and young adult item types that should not incur a -# reserve charge. -# -# Juniors: BJC, BJCN, BJF, BJK, BJM, BJN, BJP, BJSF, BJSN, DJ, DJP, FJ, JVID, -# VJ, VJP, PJ, TJ, TJP, VJ, VJP. -# -# Young adults: BYF, BYN, BYP, DY, DYP, PY, PYP, TY, TYP, VY, VYP. -# -# All other item types should incur a reserve charge. -sub CalcHLTReserveFee { - my ($env,$borrnum,$biblionumber,$constraint,$bibitems) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("SELECT * FROM borrowers,categories - WHERE (borrowernumber = ?) - AND (borrowers.categorycode = categories.categorycode)"); - $sth->execute($borrnum); - my $data = $sth->fetchrow_hashref; - $sth->finish(); - my $fee = $data->{'reservefee'}; - - my $matchno; - my @nocharge = qw/BJC BJCN BJF BJK BJM BJN BJP BJSF BJSN DJ DJP FJ NJ CJ VJ VJP PJ TJ TJP BYF BYN BYP DY DYP PY PYP TY TYP VY VYP/; - my $sth = $dbh->prepare("SELECT * FROM biblio,biblioitems - WHERE (biblio.biblionumber = ?) - AND (biblio.biblionumber = biblioitems.biblionumber)"); - $sth->execute($biblionumber); - my $data=$sth->fetchrow_hashref; - my $itemtype = $data->{'itemtype'}; - for (my $i = 0; $i < @nocharge; $i++) { - if ($itemtype eq $nocharge[$i]) { - $matchno++; - last; - } - } - - if($matchno>0){ - $fee = 0; - } - warn "BOB DEBUG: Fee is $fee"; - return $fee; -} - - - # XXX - Internal use sub getnextacctno { my ($env,$bornumber,$dbh)=@_; @@ -952,73 +680,58 @@ sub getnextacctno { } # XXX - POD -sub updatereserves{ - #subroutine to update a reserve - my ($rank,$biblio,$borrower,$del,$branch)=@_; - my $dbh = C4::Context->dbh; - if ($del == 0){ - my $sth = $dbh->prepare("Update reserves set priority=?,branchcode=? where - biblionumber=? and borrowernumber=?"); - $sth->execute($rank,$branch,$biblio,$borrower); - $sth->finish(); - } else { - my $sth=$dbh->prepare("Select * from reserves where biblionumber=? and - borrowernumber=?"); - $sth->execute($biblio,$borrower); - my $data=$sth->fetchrow_hashref; - $sth->finish(); - $sth=$dbh->prepare("Select * from reserves where biblionumber=? and - priority > ? and cancellationdate is NULL - order by priority") || die $dbh->errstr; - $sth->execute($biblio,$data->{'priority'}) || die $sth->errstr; - while (my $data=$sth->fetchrow_hashref){ - $data->{'priority'}--; - my $sth3=$dbh->prepare("Update reserves set priority=? - where biblionumber=? and borrowernumber=?"); - $sth3->execute($data->{'priority'},$data->{'biblionumber'},$data->{'borrowernumber'}) || die $sth3->errstr; - $sth3->finish(); - } - $sth->finish(); - $sth=$dbh->prepare("update reserves set cancellationdate=now() where biblionumber=? - and borrowernumber=?"); - $sth->execute($biblio,$borrower); - $sth->finish; - } -} - -# XXX - POD -sub UpdateReserve { +sub UpdateReserves { #subroutine to update a reserve - my ($rank,$biblio,$borrower,$branch)=@_; + my ($rank,$biblio,$borrower,$branch,$cataloger)=@_; return if $rank eq "W"; return if $rank eq "n"; - my $dbh = C4::Context->dbh; +my $dbh; + $dbh = C4::Context->dbh; + if ($rank eq "del") { - my $sth=$dbh->prepare("UPDATE reserves SET cancellationdate=now() + my $sth=$dbh->prepare("UPDATE reserves SET cancellationdate=now(),registeredby=? WHERE biblionumber = ? AND borrowernumber = ? AND cancellationdate is NULL - AND (found <> 'F' or found is NULL)"); - $sth->execute($biblio, $borrower); + AND (found <> 1 )"); + $sth->execute($cataloger,$biblio, $borrower); $sth->finish; } else { - my $sth=$dbh->prepare("UPDATE reserves SET priority = ? ,branchcode = ?, itemnumber = NULL, found = NULL + my $sth=$dbh->prepare("UPDATE reserves SET priority = ? ,branchcode = ?, found = 0 WHERE biblionumber = ? AND borrowernumber = ? AND cancellationdate is NULL - AND (found <> 'F' or found is NULL)"); + AND (found <> 1)"); $sth->execute($rank, $branch, $biblio, $borrower); $sth->finish; } } +# XXX - POD +sub UpdateReserve { + #subroutine to update a reserve + my ($reserveid, $timestamp) = @_; + +my $dbh; + $dbh = C4::Context->dbh; + + + my $sth=$dbh->prepare("UPDATE reserves + SET timestamp = $timestamp, + reservedate = DATE_FORMAT($timestamp, '%Y-%m-%d') + WHERE (reserveid = $reserveid)"); + $sth->execute(); + $sth->finish; +} + # XXX - POD sub getreservetitle { my ($biblio,$bor,$date,$timestamp)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Select * from reserveconstraints,biblioitems where - reserveconstraints.biblioitemnumber=biblioitems.biblioitemnumber - and reserveconstraints.biblionumber=? and reserveconstraints.borrowernumber +my $dbh = C4::Context->dbh; + + + my $sth=$dbh->prepare("Select * from reserveconstraints where + reserveconstraints.biblionumber=? and reserveconstraints.borrowernumber = ? and reserveconstraints.reservedate=? and reserveconstraints.timestamp=?"); $sth->execute($biblio,$bor,$date,$timestamp); @@ -1026,3 +739,23 @@ sub getreservetitle { $sth->finish; return($data); } + +sub findActiveReserve { + my ($borrowernumber, $biblionumber, $from, $days) = @_; +my $dbh = C4::Context->dbh; + + my $sth = $dbh->prepare("SELECT * + FROM reserves + WHERE + borrowernumber = ? + AND biblionumber = ? + AND (cancellationdate IS NULL) + AND (found <> 1) + AND ((? BETWEEN reservefrom AND reserveto) + OR (ADDDATE(?, INTERVAL ? DAY) BETWEEN reservefrom AND reserveto)) + "); + $sth->execute($borrowernumber, $biblionumber, $from, $from, $days); + return ($sth->rows); +} + +1; \ No newline at end of file diff --git a/C4/Search.pm b/C4/Search.pm index 729811b982..7b59ba8f9a 100755 --- a/C4/Search.pm +++ b/C4/Search.pm @@ -1,7 +1,6 @@ package C4::Search; # Copyright 2000-2002 Katipo Communications -# New functions added 22-09-2005 Tumer Garip tgarip@neu.edu.tr # This file is part of Koha. # # Koha is free software; you can redistribute it and/or modify it under the @@ -19,15 +18,13 @@ package C4::Search; use strict; require Exporter; -use DBI; use C4::Context; use C4::Reserves2; use C4::Biblio; -use C4::Koha; use Date::Calc; -use MARC::File::XML; use MARC::File::USMARC; use MARC::Record; +use MARC::File::XML; # FIXME - C4::Search uses C4::Reserves2, which uses C4::Search. # So Perl complains that all of the functions here get redefined. @@ -47,15 +44,14 @@ C4::Search - Functions for searching the Koha catalog and other databases use C4::Search; - my ($count, @results) = catalogsearch($env, $type, $search, $num, $offset); + my ($count, @results) = catalogsearch4($env, $type, $search, $num, $offset); =head1 DESCRIPTION This module provides the searching facilities for the Koha catalog and -other databases. +ZEBRA databases. + -C<&catalogsearch> is a front end to all the other searches. Depending -on what is passed to it, it calls the appropriate search function. =head1 FUNCTIONS @@ -65,3727 +61,413 @@ on what is passed to it, it calls the appropriate search function. @ISA = qw(Exporter); @EXPORT = qw( - -&CatSearch &BornameSearch &ItemInfo &KeywordSearch &subsearch -&itemdata &bibdata &GetItems &borrdata &itemnodata &itemcount -&borrdata2 &borrdata3 &NewBorrowerNumber &bibitemdata &borrissues -&getboracctrecord &ItemType &itemissues &subject &subtitle -&addauthor &bibitems &barcodes &findguarantees &allissues -&findseealso &findguarantor &getwebsites &getwebbiblioitems &itemcount2 &FindDuplicate -&isbnsearch &getbranchname &getborrowercategory &getborrowercategoryinfo - -&searchZOOM &catalogsearch &catalogsearch3 &CatSearch3 &catalogsearch4 &searchResults - -&getRecords &buildQuery - -&getMARCnotes &getMARCsubjects &getMARCurls); + &barcodes &ItemInfo &itemcount + &getcoverPhoto &add_query_line + &FindDuplicate &ZEBRAsearch_kohafields &sqlsearch &cataloguing_search +&getMARCnotes &getMARCsubjects &getMARCurls &parsefields); # make all your functions, whether exported or not; -=head1 findseealso($dbh,$fields); - -=head2 $dbh is a link to the DB handler. - -use C4::Context; -my $dbh =C4::Context->dbh; - -=head2 $fields is a reference to the fields array - -This function modify the @$fields array and add related fields to search on. - +=item +ZEBRAsearchkohafields is the underlying API for searching zebra for KOHA internal use +its kept similar to earlier version Koha Marc searches. instead of passing marc tags to the routine +you pass named kohafields +So you give an array of @kohafieldnames,@values, what relation they have @relations (equal, truncation etc) @and_or and +you receive an array of XML records. +The routine also has a flag $fordisplay and if it is set to 1 it will return the @results as an array of Perl hashes so that your previous +search results templates do actually work. +However more advanced search frontends will be available and this routine can serve as the connecting API for circulation and serials management +See sub FindDuplicates for an example; =cut -sub findseealso { - my ($dbh, $fields) = @_; - my $tagslib = MARCgettagslib ($dbh,1); - for (my $i=0;$i<=$#{$fields};$i++) { - my ($tag) =substr(@$fields[$i],1,3); - my ($subfield) =substr(@$fields[$i],4,1); - @$fields[$i].=','.$tagslib->{$tag}->{$subfield}->{seealso} if ($tagslib->{$tag}->{$subfield}->{seealso}); - } -} -=item findguarantees - ($num_children, $children_arrayref) = &findguarantees($parent_borrno); - $child0_cardno = $children_arrayref->[0]{"cardnumber"}; - $child0_borrno = $children_arrayref->[0]{"borrowernumber"}; -C<&findguarantees> takes a borrower number (e.g., that of a patron -with children) and looks up the borrowers who are guaranteed by that -borrower (i.e., the patron's children). +sub ZEBRAsearch_kohafields{ +my ($kohafield,$value, $relation,$sort, $and_or, $fordisplay,$reorder,$startfrom,$number_of_results,$searchfrom)=@_; +return (0,0) unless (@$value[0]); +my $server="biblioserver"; +my @results; +my $attr; +my $query; -C<&findguarantees> returns two values: an integer giving the number of -borrowers guaranteed by C<$parent_borrno>, and a reference to an array -of references to hash, which gives the actual results. -=cut -#' -sub findguarantees{ - my ($bornum)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("select cardnumber,borrowernumber, firstname, surname from borrowers where guarantor=?"); - $sth->execute($bornum); +my $i; + for ( $i=0; $i<=$#{$value}; $i++){ + last if (@$value[$i] eq ""); - my @dat; - while (my $data = $sth->fetchrow_hashref) - { - push @dat, $data; - } - $sth->finish; - return (scalar(@dat), \@dat); -} + my $keyattr=MARCfind_attr_from_kohafield(@$kohafield[$i]) if (@$kohafield[$i]); + if (!$keyattr){$keyattr=" \@attr 1=any";} + @$value[$i]=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)/ /g; + $query.=@$relation[$i]." ".$keyattr." \"".@$value[$i]."\" " if @$value[$i]; + } + for (my $z= 0;$z<=$#{$and_or};$z++){ + $query=@$and_or[$z]." ".$query if (@$value[$z+1] ne ""); + } -=item findguarantor - $guarantor = &findguarantor($borrower_no); - $guarantor_cardno = $guarantor->{"cardnumber"}; - $guarantor_surname = $guarantor->{"surname"}; - ... +#warn $query; +my @oConnection; +($oConnection[0])=C4::Context->Zconn($server); -C<&findguarantor> takes a borrower number (presumably that of a child -patron), finds the guarantor for C<$borrower_no> (the child's parent), -and returns the record for the guarantor. -C<&findguarantor> returns a reference-to-hash. Its keys are the fields -from the C database table; -=cut -#' -sub findguarantor{ - my ($bornum)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("select guarantor from borrowers where borrowernumber=?"); - $sth->execute($bornum); - my $data=$sth->fetchrow_hashref; - $sth->finish; - $sth=$dbh->prepare("Select * from borrowers where borrowernumber=?"); - $sth->execute($data->{'guarantor'}); - $data=$sth->fetchrow_hashref; - $sth->finish; - return($data); +if ($reorder){ +my (@sortpart)=split /,/,$reorder; + if (@sortpart<2){ + push @sortpart,1; ## + } +my ($sortattr)=MARCfind_attr_from_kohafield($sortpart[0]); +my @sortfield=split /@/,$sortattr; ## incase our $sortattr contains type modifiers + $query.=" \@attr 7=".$sortpart[1]." \@".$sortfield[1]." 0";## + $query= "\@or ".$query; +}elsif ($sort){ +my (@sortpart)=split /,/,$sort; + if (@sortpart<2){ + push @sortpart,1; ## Ascending by default + } +my ($sortattr)=MARCfind_attr_from_kohafield($sortpart[0]); + my @sortfield=split /@/,$sortattr; ## incase our $sortattr contains type modifiers + $query.=" \@attr 7=".$sortpart[1]." \@".$sortfield[1]." 0";## fix to accept secondary sort as well + $query= "\@or ".$query; +}else{ + unless($query=~/4=109/){ ###ranked sort not valid for numeric fields +##Use Ranked sort +$query="\@attr 2=102 ".$query; } - -=item NewBorrowerNumber - - $num = &NewBorrowerNumber(); - -Allocates a new, unused borrower number, and returns it. - -=cut -#' -# FIXME - This is identical to C4::Circulation::Borrower::NewBorrowerNumber. -# Pick one and stick with it. Preferably use the other one. This function -# doesn't belong in C4::Search. -sub NewBorrowerNumber { - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Select max(borrowernumber) from borrowers"); - $sth->execute; - my $data=$sth->fetchrow_hashref; - $sth->finish; - $data->{'max(borrowernumber)'}++; - return($data->{'max(borrowernumber)'}); } +#warn $query; +my $oResult; -=item catalogsearch - - ($count, @results) = &catalogsearch($env, $type, $search, $num, $offset); - -This is primarily a front-end to other, more specialized catalog -search functions: if C<$search-E{itemnumber}> or -C<$search-E{isbn}> is given, C<&catalogsearch> uses a precise -C<&CatSearch>. If $search->{subject} is given, it runs a subject -C<&CatSearch>. If C<$search-E{keyword}> is given, it runs a -C<&KeywordSearch>. Otherwise, it runs a loose C<&CatSearch>. - -If C<$env-E{itemcount}> is 1, then C<&catalogsearch> also counts -the items for each result, and adds several keys: - -=over 4 - -=item C - -The total number of copies of this book. - -=item C - -This is a reference-to-hash; the keys are the names of branches where -this book may be found, and the values are the number of copies at -that branch. - -=item C - -A descriptive string saying where the book is located, and how many -copies there are, if greater than 1. - -=item C +my $tried=0; -The book's subject, with spaces replaced with C<%20>, presumably for -HTML. +my $numresults; -=back +retry: +$oResult= $oConnection[0]->search_pqf($query); +my $i; +my $event; + while (($i = ZOOM::event(\@oConnection)) != 0) { + $event = $oConnection[$i-1]->last_event(); + last if $event == ZOOM::Event::ZEND; + }# while + + my($error, $errmsg, $addinfo, $diagset) = $oConnection[0]->error_x(); + if ($error==10007 && $tried<3) {## timeout --another 30 looonng seconds for this update + $tried=$tried+1; + goto "retry"; + }elsif ($error==2 && $tried<2) {## timeout --temporary zebra error !whatever that means + $tried=$tried+1; + goto "retry"; + }elsif ($error){ + warn "Error-$server /errcode:, $error, /MSG:,$errmsg,$addinfo \n"; + $oResult->destroy(); + $oConnection[0]->destroy(); + return (undef,undef); + } +my $dbh=C4::Context->dbh; + $numresults=$oResult->size() ; -=cut -#' -sub catalogsearch { - my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$desc_or_asc) = @_; - - # used for the new API - my ($search_or_scan,$type,$query,$num,$startfrom,$then_sort_by); - - $search_or_scan = 'search'; - $then_sort_by = ''; - my $number_of_results = $length; # num of results to return - $startfrom = $offset; # offset - my $ccl_query; - for (my $i = 0 ; $i <= $#{$value} ; $i++) { - $ccl_query.= @$value[$i]; - } - my ($error,$count,$facets,@results) = searchZOOM('search','ccl',$ccl_query,$number_of_results,$startfrom,$then_sort_by); + if ($numresults>0){ + my $ri=0; + my $z=0; - my @result = (); - my $subtitle; # Added by JF for Subtitles + $ri=$startfrom if $startfrom; + for ( $ri; $ri<$numresults ; $ri++){ + my $xmlrecord=$oResult->record($ri)->raw(); + if (!$fordisplay){ + ### Turn into hash of xml + $xmlrecord=XML_xml2hash($xmlrecord); + } + $z++; + push @results,$xmlrecord; + last if ($number_of_results && $z>=$number_of_results); + + + }## for #numresults + if ($fordisplay){ + my (@parsed)=parsefields($dbh,$searchfrom,@results); + return ($numresults,@parsed) ; + } + }# if numresults - # find bibids from results - #put them in @result - foreach my $rec (@results) { - my $record = MARC::Record->new_from_usmarc($rec); - my $oldbiblio = MARCmarc2koha($dbh,$record,''); - push @result, $oldbiblio->{'biblionumber'}; #FIXME bibid? - } - # we have bibid list. Now, loads title and author from [offset] to [offset]+[length] - my $counter = $offset; - # HINT : biblionumber as bn is important. The hash is fills biblionumber with items.biblionumber. - # so if you dont' has an item, you get a not nice empty value. - my $sth = $dbh->prepare("SELECT biblio.biblionumber as bn,biblioitems.*,biblio.*, itemtypes.notforloan,itemtypes.description - FROM biblio - LEFT JOIN biblioitems on biblio.biblionumber = biblioitems.biblionumber - LEFT JOIN itemtypes on itemtypes.itemtype=biblioitems.itemtype - WHERE biblio.biblionumber = ?"); #marc_biblio.biblionumber AND bibid = ?"); - my $sth_subtitle = $dbh->prepare("SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?"); # Added BY JF for Subtitles - my @finalresult = (); - my @CNresults=(); - my $totalitems=0; - my $oldline; - my ($oldbibid, $oldauthor, $oldtitle); - my $sth_itemCN; - if (C4::Context->preference('hidelostitems')) { - $sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=? and (itemlost = 0 or itemlost is NULL) order by homebranch"); - } else { - $sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=? order by homebranch"); - } - my $sth_issue = $dbh->prepare("select date_due,returndate from issues where itemnumber=?"); - # parse all biblios between start & end. - #while (($counter <= $#result) && ($counter <= ($offset + $length))) { #FIXME, do all of them - while ($counter <= $#result) { - # search & parse all items & note itemcallnumber - #warn $result[$counter]; - $sth->execute($result[$counter]); - my $continue=1; - my $line = $sth->fetchrow_hashref; - my $biblionumber=$line->{bn}; - # Return subtitles first ADDED BY JF - $sth_subtitle->execute($biblionumber); - my $subtitle_here.= $sth_subtitle->fetchrow." "; - chop $subtitle_here; - $subtitle = $subtitle_here; -# warn "Here's the Biblionumber ".$biblionumber; -# warn "and here's the subtitle: ".$subtitle_here; - - # /ADDED BY JF - -# $continue=0 unless $line->{bn}; -# my $lastitemnumber; - $sth_itemCN->execute($biblionumber); - my @CNresults = (); - my $notforloan=1; # to see if there is at least 1 item that can be issued - while (my $item = $sth_itemCN->fetchrow_hashref) { - # parse the result, putting holdingbranch & itemcallnumber in separate array - # then all other fields in the main array - - # search if item is on loan - my $date_due; - $sth_issue->execute($item->{itemnumber}); - while (my $loan = $sth_issue->fetchrow_hashref) { - if ($loan->{date_due} and !$loan->{returndate}) { - $date_due = $loan->{date_due}; - } - } - # store this item - my %lineCN; - $lineCN{holdingbranch} = $item->{holdingbranch}; - $lineCN{itemcallnumber} = $item->{itemcallnumber}; - $lineCN{location} = $item->{location}; - $lineCN{date_due} = format_date($date_due); - #$lineCN{notforloan} = $notforloanstatus{$line->{notforloan}} if ($line->{notforloan}); # setting not forloan if itemtype is not for loan - #$lineCN{notforloan} = $notforloanstatus{$item->{notforloan}} if ($item->{notforloan}); # setting not forloan it this item is not for loan - $notforloan=0 unless ($item->{notforloan} or $item->{wthdrawn} or $item->{itemlost}); - push @CNresults,\%lineCN; - $totalitems++; - } - # save the biblio in the final array, with item and item issue status - my %newline; - %newline = %$line; - $newline{totitem} = $totalitems; - # if $totalitems == 0, check if it's being ordered. - if ($totalitems == 0) { - my $sth = $dbh->prepare("select count(*) from aqorders where biblionumber=? and datecancellationprinted is NULL"); - $sth->execute($biblionumber); - my ($ordered) = $sth->fetchrow; - $newline{onorder} = 1 if $ordered; - } - $newline{biblionumber} = $biblionumber; - $newline{norequests} = 0; - $newline{norequests} = 1 if ($line->{notforloan}); # itemtype not issuable - $newline{norequests} = 1 if (!$line->{notforloan} && $notforloan); # itemtype issuable but all items not issuable for instance - $newline{subtitle} = $subtitle; # put the subtitle in ADDED BY JF - - my @CNresults2= @CNresults; - $newline{CN} = \@CNresults2; - $newline{'even'} = 1 if $#finalresult % 2 == 0; - $newline{'odd'} = 1 if $#finalresult % 2 == 1; - $newline{'timestamp'} = format_date($newline{timestamp}); - @CNresults = (); - push @finalresult, \%newline; - $totalitems=0; - $counter++; - } - my $nbresults = $#result+1; - return (\@finalresult, $nbresults); +$oResult->destroy(); +$oConnection[0]->destroy(); +return ($numresults,@results) ; +#return (0,undef); } - +=item add_bold_fields +After a search the searched keyword is boldened in the displayed search results if it exists in the title or author +It is now depreceated +=cut sub add_html_bold_fields { my ($type, $data, $search) = @_; - - my %reference = ('additionalauthors' => 'author', - 'publishercode' => 'publisher', - 'subtitle' => 'title' - ); - - foreach my $key ('title', 'author', 'additionalauthors', 'publishercode', 'publicationyear', 'subject', 'subtitle') { + foreach my $key ('title', 'author') { my $new_key; - if ($key eq 'additionalauthors') { - $new_key = 'additionalauthors'; - } else { + $new_key = 'bold_' . $key; $data->{$new_key} = $data->{$key}; - } + my $key1; - if ($reference{$key}) { - $key1 = $reference{$key}; - } else { + $key1 = $key; - } + my @keys; my $i = 1; if ($type eq 'keyword') { my $newkey=$search->{'keyword'}; $newkey=~s /\++//g; - @keys = split " ", $newkey; - } else { - while ($search->{"field_value$i"}) { - my $newkey=$search->{"field_value$i"}; - $newkey=~s /\++//g; - push @keys, $newkey; - $i++; - } - } + @keys = split " ", $newkey; + } my $count = @keys; for ($i = 0; $i < $count ; $i++) { - if ($key eq 'additionalauthors') { - my $j = 0; - foreach (@{$data->{$new_key}}) { - if (!$data->{$new_key}->[$j]->{'bold_value'}) { - $data->{$new_key}->[$j]->{'bold_value'} = $data->{$new_key}->[$j]->{'value'}; - } - if ( ($data->{$new_key}->[$j]->{'value'} =~ /($keys[$i])/i) && (lc($keys[$i]) ne 'b') ) { - my $word = $1; - $data->{$new_key}->[$j]->{'bold_value'} =~ s/$word/$word<\/b>/; - } - $j++; - } - } else { + if (($data->{$new_key} =~ /($keys[$i])/i) && (lc($keys[$i]) ne 'b') ) { my $word = $1; $data->{$new_key} =~ s/$word/$word<\/b>/; } - } + } } } + sub sqlsearch{ +## This searches the SQL database only for biblionumber,itemnumber,barcode +### Not very useful on production but as a debug tool useful during system maturing for ZEBRA operations -sub catalogsearch3 { - my ($search,$num,$offset) = @_; - my $dbh = C4::Context->dbh; - my ($count,@results); +my ($dbh,$search)=@_; +my $sth; +if ($search->{'barcode'} ne '') { + $sth=$dbh->prepare("SELECT biblionumber from items where barcode=?"); + $sth->execute($search->{'barcode'}); +}elsif ($search->{'itemnumber'} ne '') { + $sth=$dbh->prepare("SELECT biblionumber from items where itemnumber=?"); + $sth->execute($search->{'itemnumber'}); +}elsif ($search->{'biblionumber'} ne '') { + $sth=$dbh->prepare("SELECT biblionumber from biblio where biblionumber=?"); + $sth->execute($search->{'biblionumber'}); +}else{ +return (undef,undef); +} - if ($search->{'itemnumber'} ne '' || $search->{'isbn'} ne ''|| $search->{'biblionumber'} ne ''){ - ($count,@results) = CatSearch3('precise',$search,$num,$offset); - } elsif ($search->{'keyword'} ne ''){ - ($count,@results) = CatSearch3('keyword',$search,$num,$offset); - } elsif ($search->{'recently_items'} ne '') { - ($count,@results) = CatSearch3('recently_items',$search,$num,$offset); - } else { - ($count,@results) = CatSearch3('loose',$search,$num,$offset); + my $result=$sth->fetchrow_hashref; +return (1,$result) if $result; +} + +sub cataloguing_search{ +## This is an SQL based search designed to be used when adding a new biblio incase library sets +## preference zebraorsql to sql when adding a new biblio +my ($search,$num,$offset) = @_; + my ($count,@results); +my $dbh=C4::Context->dbh; +#Prepare search +my $query; +my $condition="select SQL_CALC_FOUND_ROWS marc from biblio where "; +if ($search->{'isbn'} ne''){ +$search->{'isbn'}=$search->{'isbn'}."%"; +$query=$search->{'isbn'}; +$condition.= " isbn like ? "; +}else{ +return (0,undef) unless $search->{title}; +$query=$search->{'title'}; +$condition.= " MATCH (title) AGAINST(? in BOOLEAN MODE ) "; +} +my $sth=$dbh->prepare($condition); +$sth->execute($query); + my $nbresult=$dbh->prepare("SELECT FOUND_ROWS()"); + $nbresult->execute; + my $count=$nbresult->fetchrow; +my $limit = $num + $offset; +my $startfrom = $offset; +my $i=0; +my @results; +while (my $marc=$sth->fetchrow){ + if (($i >= $startfrom) && ($i < $limit)) { + my $record=MARC::File::USMARC::decode($marc); + my $data=MARCmarc2koha($dbh,$record,"biblios"); + push @results,$data; } +$i++; +last if $i==$limit; +} +return ($count,@results); +} + + +sub FindDuplicate { + my ($record)=@_; +my $dbh=C4::Context->dbh; + my $result = MARCmarc2koha($dbh,$record,"biblios"); + my @kohafield; + my @value; + my @relation; + my @and_or; + + # search duplicate on ISBN, easy and fast.. + + if ($result->{isbn}) { + push @kohafield,"isbn"; +###Temporary fix for ISBN +my $isbn=$result->{isbn}; +$isbn=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\!|\'|,|\-|\"|\*|\(|\)|\[|\]|\{|\}|\/)//g; + push @value,$isbn; + }else{ +$result->{title}=~s /\\//g; +$result->{title}=~s /\"//g; +$result->{title}=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\*|\!|\,|\-|\(|\)|\[|\]|\{|\}|\/)/ /g; - return ($count,@results); + push @kohafield,"title"; + push @value,$result->{title}; + push @relation,"\@attr 6=3 \@attr 4=1 \@attr 5=1"; ## right truncated,phrase,whole field + + } + my ($total,@result)=ZEBRAsearch_kohafields(\@kohafield,\@value,\@relation,"",\@and_or,0,"",0,1); +if ($total){ +my $title=XML_readline($result[0],"title","biblios") ; +my $biblionumber=XML_readline($result[0],"biblionumber","biblios") ; + return $biblionumber,$title ; } -sub CatSearch3 { +} + + +sub add_query_line { - my ($type,$search,$num,$offset)=@_; + my ($type,$search,$results)=@_; my $dbh = C4::Context->dbh; - my $query = ''; #to make the query statement - my $count_query = ''; #to count total results - my @params = (); #to collect the params - my @results; #to retrieve the results + my $searchdesc = ''; + my $from; + my $borrowernumber = $search->{'borrowernumber'}; + my $remote_IP = $search->{'remote_IP'}; + my $remote_URL= $search->{'remote_URL'}; + my $searchdesc = $search->{'searchdesc'}; - # 1) do a search by barcode or isbn - if ($type eq 'precise') { +my $sth = $dbh->prepare("INSERT INTO phrase_log(phr_phrase,phr_resultcount,phr_ip,user,actual) VALUES(?,?,?,?,?)"); - if ($search->{'itemnumber'} ne ''){ - $query = "SELECT biblionumber FROM items WHERE (barcode = ?)"; - push @params, $search->{'itemnumber'}; - - } elsif ($search->{'isbn'} ne '') { - $query = "SELECT biblionumber FROM biblioitems WHERE (isbn like ?)"; - push @params, $search->{'isbn'}; - }else { - $query = "SELECT biblionumber FROM biblioitems WHERE (biblionumber = ?)"; - push @params, $search->{'biblionumber'}; - } - - #add branch condition - if ($search->{'branch'} ne '') { - $query.= " AND ( holdingbranch like ? ) "; - my $keys = $search->{'branch'}; - push @params, $keys; - } - # 2) do a search by keyword - } elsif ($type eq 'keyword') { - my $keys = $search->{'keyword'}; - my @words = split / /, $keys; - - #parse the keywords - my $keyword; - if ($search->{'ttype'} eq 'exact') { - for (my $i = 0; $i < @words ;$i++) { - if ($i + 1 == @words) { - $words[$i] = '+' . $words[$i] . '*'; - } else { - $words[$i] = '+' . $words[$i]; - } - } - } else { - for (my $i = 0; $i < @words ;$i++) { - $words[$i] = $words[$i] . '*'; - } - } - $keyword = join " ", @words; - - #Builds the SQL - $query = "(SELECT DISTINCT B.biblionumber AS biblionumber ,( MATCH (title,seriestitle,unititle,B.author,subject,publishercode,itemcallnumber) AGAINST(? in BOOLEAN MODE) ) as Relevance - FROM biblio AS B - LEFT JOIN biblioitems AS BI ON (B.biblionumber = BI.biblionumber) - LEFT JOIN items AS I ON (BI.biblionumber = I.biblionumber) - LEFT JOIN additionalauthors AA1 ON (B.biblionumber = AA1.biblionumber) - LEFT JOIN bibliosubject AS BS1 ON (B.biblionumber = BS1.biblionumber) - LEFT JOIN bibliosubtitle AS BSU1 ON (B.biblionumber = BSU1.biblionumber) - where MATCH (title,seriestitle,unititle,B.author,subject,publishercode,itemcallnumber) AGAINST (? IN BOOLEAN MODE) "; - - push @params,$keyword; - push @params,$keyword; - #search by class - if ($search->{'class'} ne '') { - $query .= " AND ( itemtype = ? ) "; - push @params, $search->{'class'}; - } - #search by branch - if ($search->{'branch'} ne '') { - $query .= " AND ( items.holdingbranch like ? ) "; - push @params, $search->{'branch'}; - } - if ($search->{'stack'} ne '') { - $query .= " AND ( items.stack = ? ) "; - push @params, $search->{'stack'}; - } - #search by publication year - if ($search->{'date_from'} ne '') { - $query .= " AND ( biblioitems.publicationyear >= ?) "; - push @params, $search->{'date_from'}; - if ($search->{'date_to'} ne '') { - $query .= " AND ( biblioitems.publicationyear <= ?) "; - push @params, $search->{'date_to'}; - - } - } - $query .= ")"; +$sth->execute($searchdesc,$results,$remote_IP,$borrowernumber,$remote_URL); +$sth->finish; - - +} - # 3) search the items acquired recently (in the last $search->{'range'} days) - } elsif ($type eq 'recently_items') { - my $keys; - if ($search->{'range'}) { - $keys = $search->{'range'}; - } else { - $keys = 30; - } - $query = "SELECT B.biblionumber FROM biblio AS B - LEFT JOIN biblioitems AS BI ON (B.biblionumber = BI.biblionumber) - - WHERE - (TO_DAYS( NOW( ) ) - TO_DAYS( B.timestamp )){'class'} ne '') { - $query .= " AND ( BI.itemtype = ? ) "; - push @params, $search->{'class'}; - } - $query.= " ORDER BY title "; - # 4) do a loose search - } else { - - my ($condition1, $condition2, $condition3) = ('','',''); - my $count_params = 0; - - - #search_field 1 - if ($search->{'field_name1'} eq 'all') { - $condition1.= " ( MATCH (title,seriestitle,unititle,B.author,subject,publishercode,itemcallnumber) AGAINST(? in BOOLEAN MODE) ) "; - - $count_params = 1; - } elsif ($search->{'field_name1'} eq 'author') { - $condition1.= " ( MATCH (B.author) AGAINST(? in BOOLEAN MODE) ) "; - $count_params = 1; - } elsif ($search->{'field_name1'} eq 'title') { - $condition1.= " ( MATCH (title,seriestitle,unititle) AGAINST(? in BOOLEAN MODE ) ) "; - $count_params = 1; - } elsif ($search->{'field_name1'} eq 'subject') { - $condition1.= " ( ( MATCH (subject) AGAINST(? in BOOLEAN MODE) ) ) "; - $count_params = 1; - } elsif ($search->{'field_name1'} eq 'publisher') { - $condition1.= " ( MATCH (publishercode) AGAINST(? in BOOLEAN MODE )) "; - $count_params = 1; - } elsif ($search->{'field_name1'} eq 'publicationyear') { - $condition1.= " ( MATCH (publicationyear) AGAINST(? in BOOLEAN MODE )) "; - $count_params = 1; - } elsif ($search->{'field_name1'} eq 'callno') { - $condition1.= " ( MATCH (itemcallnumber) AGAINST(? in BOOLEAN MODE )) "; - $count_params = 1; - } - - if ($search->{'ttype1'} eq 'exact') { - push @params,"\"".$search->{'field_value1'}."\""; - push @params, "\"".$search->{'field_value1'}."\""; - } else { - my $keys = $search->{'field_value1'}; - my @words = split / /, $keys; - #parse the keywords - my $keyword; - for (my $i = 0; $i < @words ;$i++) { - $words[$i] = '+'. $words[$i] . '*'; - } - $keyword = join " ", @words; - push @params, $keyword; - push @params, $keyword; - - } - - $query = " SELECT DISTINCT B.biblionumber AS biblionumber ,$condition1 as Relevance - FROM biblio AS B - LEFT JOIN biblioitems AS BI ON (B.biblionumber = BI.biblionumber) - LEFT JOIN items AS I ON (BI.biblionumber = I.biblionumber) - LEFT JOIN additionalauthors AA1 ON (B.biblionumber = AA1.biblionumber) - LEFT JOIN bibliosubject AS BS1 ON (B.biblionumber = BS1.biblionumber) - LEFT JOIN bibliosubtitle AS BSU1 ON (B.biblionumber = BSU1.biblionumber) "; - +=item ItemInfo - #search_field 2 - if ( ($search->{'field_value1'}) && ($search->{'field_value2'}) ) { - if ($search->{'field_name2'} eq 'all') { - $condition2.= " MATCH (title,seriestitle,unititle,B.author,subject,publishercode,itemcallnumber) AGAINST( ? in BOOLEAN MODE) ) "; - - $count_params = 1; - } elsif ($search->{'field_name2'} eq 'author') { - $condition2.= " MATCH (B.author,AA1.author) AGAINST( ? in BOOLEAN MODE) ) "; - $count_params = 1; - } elsif ($search->{'field_name2'} eq 'title') { - $condition2.= " MATCH (title,seriestitle,unititle) AGAINST( ? in BOOLEAN MODE ) ) "; - $count_params = 1; - } elsif ($search->{'field_name2'} eq 'subject') { - $condition2.= " MATCH (subject) AGAINST(? in BOOLEAN MODE) ) "; - $count_params = 1; - } elsif ($search->{'field_name2'} eq 'publisher') { - $condition2.= " MATCH (publishercode) AGAINST(? in BOOLEAN MODE )) "; - $count_params = 1; - } elsif ($search->{'field_name2'} eq 'publicationyear') { - $condition2.= " MATCH (publicationyear) AGAINST(? in BOOLEAN MODE )) "; - $count_params = 1; - } elsif ($search->{'field_name2'} eq 'callno') { - $condition2.= " MATCH (itemcallnumber) AGAINST(? in BOOLEAN MODE )) "; - $count_params = 1; - } - if ($search->{'op1'} eq "not"){ - $search->{'op1'}="and (not "; - }else{ - $search->{'op1'}.=" ("; - } - - if ($search->{'ttype2'} eq 'exact') { - push @params, "\"".$search->{'field_value2'}."\""; - } else { - my $keys = $search->{'field_value2'}; - my @words = split / /, $keys; - #parse the keywords - my $keyword; - for (my $i = 0; $i < @words ;$i++) { - $words[$i] = "+". $words[$i] . '*'; - } - $keyword = join " ", @words; - push @params, $keyword; - } + @results = &ItemInfo($env, $biblionumber, $type); - } +Returns information about books with the given biblionumber. - #search_field 3 - if ( ($search->{'field_value2'}) && ($search->{'field_value3'}) ) { - - if ($search->{'field_name3'} eq 'all') { - $condition3.= " MATCH (title,seriestitle,unititle,B.author,subject,publishercode,itemcallnumber) AGAINST(? in BOOLEAN MODE ) ) "; - - $count_params = 1; - } elsif ($search->{'field_name3'} eq 'author') { - $condition3.= " MATCH (B.author,AA1.author) AGAINST(? in BOOLEAN MODE) ) "; - $count_params = 1; - } elsif ($search->{'field_name3'} eq 'title') { - $condition3.= " MATCH (title,seriestitle,unititle) AGAINST(? in BOOLEAN MODE) ) "; - $count_params = 1; - } elsif ($search->{'field_name3'} eq 'subject') { - $condition3.= " MATCH (subject) AGAINST(? in BOOLEAN MODE ) ) "; - $count_params = 1; - } elsif ($search->{'field_name3'} eq 'publisher') { - $condition3.= " MATCH (publishercode) AGAINST(? in BOOLEAN MODE )) "; - $count_params = 1; - } elsif ($search->{'field_name3'} eq 'publicationyear') { - $condition3.= " MATCH (publicationyear) AGAINST(? in BOOLEAN MODE )) "; - $count_params = 1; - } elsif ($search->{'field_name3'} eq 'callno') { - $condition3.= " MATCH (itemcallnumber) AGAINST(? in BOOLEAN MODE )) "; - $count_params = 1; - } - if ($search->{'op2'} eq "not"){ - $search->{'op2'}="and (not "; - }else{ - $search->{'op2'}.=" ("; - } - if ($search->{'ttype3'} eq 'exact') { - push @params, "\"".$search->{'field_value3'}."\""; - } else { - my $keys = $search->{'field_value3'}; - my @words = split / /, $keys; - #parse the keywords - my $keyword; - - for (my $i = 0; $i < @words ;$i++) { - $words[$i] = "+". $words[$i] . '*'; - } - $keyword = join " ", @words; - push @params, $keyword; - } - } +C<$type> may be either C or anything else. If it is not set to +C, then the search will exclude lost, very overdue, and +withdrawn items. - $query.= " WHERE "; - if (($condition1 ne '') && ($condition2 ne '') && ($condition3 ne '')) { - if ($search->{'op1'} eq $search->{'op2'}) { - $query.= " ( $condition1 $search->{'op1'} $condition2 $search->{'op2'} $condition3 ) "; - } elsif ( $search->{'op1'} eq "and (" ) { - $query.= " ( $condition1 $search->{'op1'} ( $condition2 $search->{'op2'} $condition3 ) ) "; - } else { - $query.= " ( ( $condition1 $search->{'op1'} $condition2 ) $search->{'op2'} $condition3 ) "; - } - } elsif ( ($condition1 ne '') && ($condition2 ne '') ) { - $query.= " ( $condition1 $search->{'op1'} $condition2 ) "; - } else { - $query.= " ( $condition1 ) "; - } - - #search by class - if ($search->{'class'} ne ''){ - $query.= " AND ( itemtype = ? ) "; - my $keys = $search->{'class'}; - push @params, $search->{'class'}; - } - #search by branch - if ($search->{'branch'} ne '') { - $query.= " AND I.holdingbranch like ? "; - my $keys = $search->{'branch'}; - push @params, $keys, $keys; - } - #search by publication year - if ($search->{'date_from'} ne '') { - $query .= " AND ( BI.publicationyear >= ?) "; - push @params, $search->{'date_from'}; - if ($search->{'date_to'} ne '') { - $query .= " AND ( BI.publicationyear <= ?) "; - push @params, $search->{'date_to'}; - - } - } - if ($search->{'order'} eq "1=1003 i<"){ - $query.= " ORDER BY b.author "; - }elsif ($search->{'order'} ge "1=9 i<"){ - $query.= " ORDER BY lcsort "; - }elsif ($search->{'order'} eq "1=4 i<"){ - $query.= " ORDER BY title "; - }else{ - $query.=" ORDER BY Relevance DESC"; - } - } - -#warn "$query,@params,"; - $count_query = $query; - warn "QUERY:".$count_query; - #execute the query and returns just the results between $num and $num + $offset - my $limit = $num + $offset; - my $startfrom = $offset; - my $sth = $dbh->prepare($query); - - $sth->execute(@params); +C<$env> is ignored. - my $i = 0; -#Build brancnames hash -#find branchname -#get branch information..... -my %branches; - my $bsth=$dbh->prepare("SELECT branchcode,branchname FROM branches"); - $bsth->execute(); - while (my $bdata=$bsth->fetchrow_hashref){ - $branches{$bdata->{'branchcode'}}= $bdata->{'branchname'}; +C<&ItemInfo> returns a list of references-to-hash. Each element +contains a number of keys. Most of them are table items from the +C, C, C, and C tables in the +Koha database. Other keys include: - } +=over 4 -#Building shelving hash -my %shelves; -#find shelvingname -my $stackstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.stack"'); - $stackstatus->execute; - - my ($authorised_valuecode) = $stackstatus->fetchrow; - if ($authorised_valuecode) { - $stackstatus = $dbh->prepare("select lib,authorised_value from authorised_values where category=? "); - $stackstatus->execute($authorised_valuecode); - - while (my $lib = $stackstatus->fetchrow_hashref){ - $shelves{$lib->{'authorised_value'}} = $lib->{'lib'}; - } - } +=item C<$data-E{branchname}> -#search item field code - my $sth3 = - $dbh->prepare( - "select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'" - ); - $sth3->execute; - my ($itemtag) = $sth3->fetchrow; -## find column names of items related to MARC - my $sth2=$dbh->prepare("SHOW COLUMNS from items"); - $sth2->execute; - my %subfieldstosearch; - while ((my $column)=$sth2->fetchrow){ - my ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,"items.".$column,""); - $subfieldstosearch{$column}=$tagsubfield; - } -my $toggle; -my $even; -#proccess just the results to show - while (my( $data,$rel) = $sth->fetchrow) { - if (($i >= $startfrom) && ($i < $limit)) { - - my $marcrecord=MARCgetbiblio($dbh,$data); - my $oldbiblio=MARCmarc2koha($dbh,$marcrecord,''); - +The name (not the code) of the branch to which the book belongs. - &add_html_bold_fields($type, $oldbiblio, $search); -if ($i % 2) { - $toggle="#ffffcc"; - } else { - $toggle="white"; - } - $oldbiblio->{'toggle'}=$toggle; +=item C<$data-E{datelastseen}> - - - my @fields = $marcrecord->field($itemtag); -my @items; - my $item; -my %counts; -$counts{'total'}=0; +This is simply C, except that while the date is +stored in YYYY-MM-DD format in the database, here it is converted to +DD/MM/YYYY format. A NULL date is returned as C. -# -##Loop for each item field - foreach my $field (@fields) { - foreach my $code ( keys %subfieldstosearch ) { +=item C<$data-E{datedue}> -$item->{$code}=$field->subfield($subfieldstosearch{$code}); -} +=item C<$data-E{class}> -my $status; +This is the concatenation of C, the book's +Dewey code, and C. -$item->{'branchname'}=$branches{$item->{'holdingbranch'}}; -$item->{'shelves'}=$shelves{$item->{stack}}; -$status="Lost" if ($item->{'itemlost'}>0); -$status="Withdrawn" if ($item->{'wthdrawn'}>0) ; -if ($search->{'from'} eq "intranet"){ -$search->{'avoidquerylog'}=1; -$status="Due:".format_date($item->{'onloan'}) if ($item->{'onloan'}>0); - $status = $item->{'holdingbranch'}."-".$item->{'stack'}."[".$item->{'itemcallnumber'}."]" unless defined $status; -}else{ -$status="On Loan" if ($item->{'onloan'}>0); - $status = $item->{'branchname'}."[".$item->{'shelves'}."]" unless defined $status; -} - $counts{$status}++; -$counts{'total'}++; -push @items,$item; +=item C<$data-E{ocount}> - } - - my $norequests = 1; - my $noitems = 1; - if (@items) { - $noitems = 0; - foreach my $itm (@items) { - $norequests = 0 unless $itm->{'itemnotforloan'}; +I think this is the number of copies of the book available. + +=item C<$data-E{order}> + +If this is set, it is set to C. + +=back + +=cut +#' +sub ItemInfo { + my ($dbh,$data) = @_; + my $i=0; + my @results; +my ($date_due, $count_reserves); + my $datedue = ''; + my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber"); + $isth->execute($data->{'itemnumber'}); + if (my $idata=$isth->fetchrow_hashref){ + $data->{borrowernumber} = $idata->{borrowernumber}; + $data->{cardnumber} = $idata->{cardnumber}; + $datedue = format_date($idata->{'date_due'}); + } + if ($datedue eq '' || $datedue eq "0000-00-00"){ + $datedue=""; + my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'}); + if ($restype) { + $count_reserves = $restype; } } - $oldbiblio->{'noitems'} = $noitems; - $oldbiblio->{'norequests'} = $norequests; - $oldbiblio->{'even'} = $even = not $even; - $oldbiblio->{'itemcount'} = $counts{'total'}; - my $totalitemcounts = 0; - foreach my $key (keys %counts){ - if ($key ne 'total'){ - $totalitemcounts+= $counts{$key}; - $oldbiblio->{'locationhash'}->{$key}=$counts{$key}; - } - } - - my ($locationtext, $locationtextonly, $notavailabletext) = ('','',''); - foreach (sort keys %{$oldbiblio->{'locationhash'}}) { - if ($_ eq 'notavailable') { - $notavailabletext="Not available"; - my $c=$oldbiblio->{'locationhash'}->{$_}; - $oldbiblio->{'not-available-p'}=$c; - } else { - $locationtext.="$_"; - my $c=$oldbiblio->{'locationhash'}->{$_}; - if ($_ eq 'Item Lost') { - $oldbiblio->{'lost-p'} = $c; - } elsif ($_ eq 'Withdrawn') { - $oldbiblio->{'withdrawn-p'} = $c; - } elsif ($_ eq 'On Loan') { - $oldbiblio->{'on-loan-p'} = $c; - } else { - $locationtextonly.= $_; - $locationtextonly.= " ($c)
" if $totalitemcounts > 1; - } - if ($totalitemcounts>1) { - $locationtext.=" ($c)
"; - } - } - } - if ($notavailabletext) { - $locationtext.= $notavailabletext; - } else { - $locationtext=~s/, $//; - } - $oldbiblio->{'location'} = $locationtext; - $oldbiblio->{'location-only'} = $locationtextonly; - $oldbiblio->{'use-location-flags-p'} = 1; - push @results, $oldbiblio; - - } - $i++; - } - - my $count = $i; - unless ($search->{'avoidquerylog'}) { - add_query_line($type, $search, $count);} - return($count,@results); -} - -sub catalogsearch4 { - my ($search,$num,$offset) = @_; - my ($count,@results); - - if ($search->{'itemnumber'} ne '' || $search->{'isbn'} ne ''|| $search->{'biblionumber'} ne ''|| $search->{'authnumber'} ne ''){ - ($count,@results) = CatSearch4('precise',$search,$num,$offset); - } elsif ($search->{'cql'} ne ''){ - if ($search->{'rpn'} ne '') { - warn "RPN ON"; - ($count,@results) = CatSearch4('rpn',$search,$num,$offset); - } else { - warn "RPN".$search->{'rpn'}; - ($count,@results) = CatSearch4('cql',$search,$num,$offset); - } - } elsif ($search->{'keyword'} ne ''){ - ($count,@results) = CatSearch4('keyword',$search,$num,$offset); - } elsif ($search->{'recently_items'} ne '') { - ($count,@results) = CatSearch4('recently_items',$search,$num,$offset); - } else { - ($count,@results) = CatSearch4('loose',$search,$num,$offset); - } - return ($count,@results); -} - -sub CatSearch4 { - - my ($type,$search,$num,$offset)=@_; - my $dbh = C4::Context->dbh; - my $query = ''; #to make the query statement - my $count_query = ''; #to count total results - my @params = (); #to collect the params - my @results; #to retrieve the results - my $attr; - my $attr2; - my $attr3; - my $numresults; - my $marcdata; - my $toggle; - my $even=1; - my $cql; - my $rpn; - my $cql_query; - # 1) do a search by barcode or isbn - if ($type eq 'cql') { - $cql=1; - $cql_query = $search->{'cql'}; - while( my ($k, $v) = each %$search ) { - warn "key: $k, value: $v.\n"; - } - warn "QUERY:".$query; - } - if ($type eq 'rpn') { - $rpn=1; - $cql=1; - $cql_query = $search->{'cql'}; #but it's really a rpn query FIXME - } - if ($type eq 'precise') { - - if ($search->{'itemnumber'} ne '') { - - $query = " \@attr 1=1028 ". $search->{'itemnumber'}; - - - }elsif ($search->{'isbn'} ne ''){ - $query = " \@attr 1=7 \@attr 4=1 \@attr 5=1 "."\"".$search->{'isbn'}."\""; - - }elsif ($search->{'biblionumber'} ne ''){ - $query = " \@attr 1=1007 ".$search->{'biblionumber'}; - - }elsif ($search->{'authnumber'} ne ''){ - my $n=0; - my @ids=split / /,$search->{'authnumber'} ; - foreach my $id (@ids){ - $query .= " \@attr GILS 1=2057 ".$id; - $n++; - } - if ($n>1){ - $query= "\@or ".$query; - } - - } - #add branch condition - if ($search->{'branch'} ne '') { - $query= "\@and ".$query; - $query .= " \@attr 1=1033 \"".$search->{'branch'}."\""; - - } - # 2) do a search by keyword - }elsif ($type eq 'keyword') { - $search->{'keyword'}=~ s/(\\|\|)//g;; - - #parse the keywords - my $keyword; - - if ($search->{'ttype'} eq 'exact') { - $attr="\@attr 4=1 \@attr 5=1 \@attr 2=102 "; - } else { - $attr=" \@attr 4=6 \@attr 5=103 \@attr 2=102 "; - } - - - #Builds the query - $query = " \@attr 1=1016 ".$attr."\"".$search->{'keyword'}."\""; - - - #search by itemtypes - if ($search->{'class'} ne '') { - $query= "\@and ".$query; - $query .= " \@attr 1=1031 \"".$search->{'class'}."\""; - push @params, $search->{'class'}; - } - #search by callnumber - if ($search->{'callno'} ne '') { - $query= "\@and ".$query; - $query .= " \@attr 1=20 \@attr 4=1 \@attr 5=1 \"".$search->{'callno'}."\""; - - } - #search by branch - if ($search->{'branch'} ne '') { - $query= "\@and ".$query; - $query .= " \@attr 1=1033 \"".$search->{'branch'}."\""; - - } - if ($search->{'stack'} ne '') { - $query= "\@and ".$query; - $query .= " \@attr 1=1019 \"".$search->{'stack'}."\""; - push @params, $search->{'stack'}; - } - if ($search->{'date_from'} ne '') { - $query= "\@and ".$query; - $query .= " \@attr 1=30 \@attr 2=4 \@attr 4=4 ".$search->{'date_from'}; - push @params, $search->{'date_from'}; - } - if ($search->{'date_to'} ne '') { - $query= "\@and ".$query; - $query .= " \@attr 1=30 \@attr 2=2 \@attr 4=4 ".$search->{'date_to'}; - push @params, $search->{'date_to'}; - - } - -# 3) search the items acquired recently (in the last $search->{'range'} days) - } elsif ($type eq 'recently_items') { - my $keys; - if ($search->{'range'}) { - $keys = $search->{'range'}*(-1); - } else { - $keys = -30; - } - my @datearr = localtime(); - my $dateduef = (1900+$datearr[5])."-".sprintf ("%0.2d", ($datearr[4]+1))."-".$datearr[3]; - - - my ($year, $month, $day) = split /-/, $dateduef; - ($year, $month, $day) = &Date::Calc::Add_Delta_Days($year, $month, $day, ($keys - 1)); - $dateduef = "$year-$month-$day"; - $query .= " \@attr 1=32 \@attr 2=4 \@attr 4=5 ".$dateduef; - #search by class - push @params, $keys; - if ($search->{'class'} ne '') { - $query= "\@and ".$query; - $query .= " \@attr 1=1031 \"".$search->{'class'}."\""; - - } - - - - - # 4) do a loose search - } else { - - my ($condition1, $condition2, $condition3) = ('','',''); - my $count_params = 0; - - if ($search->{'ttype1'} eq 'exact') { - $attr="\@attr 4=1 "; - if ($search->{'atype1'} eq 'start'){ - $attr.=" \@attr 3=1 \@attr 6=3 \@attr 5=1 \@attr 2=102 "; - }else{ - $attr.=" \@attr 5=1 \@attr 3=3 \@attr 6=1 \@attr 2=102 "; - } - } else { - $attr=" \@attr 4=6 \@attr 5=103 "; - } - - #search_field 1 - $search->{'field_value1'}=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\!|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)//g; - if ($search->{'field_name1'} eq 'all') { - $condition1.= " \@attr 1=1016 ".$attr." \"".$search->{'field_value1'}."\" "; - - } elsif ($search->{'field_name1'} eq 'author') { - $condition1.=" \@attr 1=1003 ".$attr." \"".$search->{'field_value1'}."\" "; - - } elsif ($search->{'field_name1'} eq 'title') { - $condition1.= " \@attr 1=4 ".$attr." \"".$search->{'field_value1'}."\" "; - - } elsif ($search->{'field_name1'} eq 'subject') { - $condition1.=" \@attr 1=21 ".$attr." \"".$search->{'field_value1'}."\" "; - } elsif ($search->{'field_name1'} eq 'series') { - $condition1.=" \@attr 1=5 ".$attr." \"".$search->{'field_value1'}."\" "; - - } elsif ($search->{'field_name1'} eq 'publisher') { - $condition1.= " \@attr 1=1018 ".$attr." \"".$search->{'field_value1'}."\" "; - } elsif ($search->{'field_name1'} eq 'callno') { - $condition1.= " \@attr 1=20 \@attr 3=2 ".$attr." \"".$search->{'field_value1'}."\" "; - } - $query = $condition1; - #search_field 2 - if ($search->{'field_value2'}) { - $search->{'field_value2'}=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\!|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)//g; - if ($search->{'ttype2'} eq 'exact') { - - $attr2="\@attr 4=1 "; - if ($search->{'atype1'} eq 'start'){ - $attr.=" \@attr 3=1 \@attr 6=3 \@attr 5=1 \@attr 2=102 "; - }else{ - $attr.=" \@attr 5=1 \@attr 3=3 \@attr 6=1 \@attr 2=102 "; - } - } else { - $attr2=" \@attr 4=6 \@attr 5=103 "; - } - - if ($search->{'field_name2'} eq 'all') { - if ($search->{'op1'} eq 'and') { - $query = " \@and ".$query; - $condition2.= " \@attr 1=1016 ".$attr2." \"".$search->{'field_value2'}."\" "; - - } elsif ($search->{'op1'} eq 'or') { - $query = " \@or ".$query; - $condition2.= " \@attr 1=1016 ".$attr2." \"".$search->{'field_value2'}."\" "; - } else { - $query = " \@not ".$query; - $condition2.= " \@attr 1=1016 ".$attr2." \"".$search->{'field_value2'}."\" "; - - } - } elsif ($search->{'field_name2'} eq 'author') { - if ($search->{'op1'} eq 'and') { - $query = " \@and ".$query; - $condition2.= " \@attr 1=1003 ".$attr2." \"".$search->{'field_value2'}."\" "; - - } elsif ($search->{'op1'} eq 'or'){ - $query = " \@or ".$query; - $condition2.= " \@attr 1=1003 ".$attr2." \"".$search->{'field_value2'}."\" "; - } else { - $query = " \@not ".$query; - $condition2.= " \@attr 1=1003 ".$attr2." \"".$search->{'field_value2'}."\" "; - - } - - } elsif ($search->{'field_name2'} eq 'title') { - if ($search->{'op1'} eq 'and') { - $query = " \@and ".$query; - $condition2.= " \@attr 1=4 ".$attr2." \"".$search->{'field_value2'}."\" "; - - } elsif ($search->{'op1'} eq 'or'){ - $query = " \@or ".$query; - $condition2.= " \@attr 1=4 ".$attr2." \"".$search->{'field_value2'}."\" "; - } else { - $query = " \@not ".$query; - $condition2.= " \@attr 1=4 ".$attr2." \"".$search->{'field_value2'}."\" "; - } - - } elsif ($search->{'field_name2'} eq 'subject') { - if ($search->{'op1'} eq 'and') { - $query = " \@and ".$query; - $condition2.= " \@attr 1=21 ".$attr2." \"".$search->{'field_value2'}."\" "; - - } elsif ($search->{'op1'} eq 'or') { - $query = " \@or ".$query; - $condition2.= " \@attr 1=21 ".$attr2." \"".$search->{'field_value2'}."\" "; - } else { - $query = " \@not ".$query; - $condition2.= " \@attr 1=21 ".$attr2." \"".$search->{'field_value2'}."\" "; - } - } elsif ($search->{'field_name2'} eq 'series') { - if ($search->{'op1'} eq 'and') { - $query = " \@and ".$query; - $condition2.= " \@attr 1=5 ".$attr2." \"".$search->{'field_value2'}."\" "; - - } elsif ($search->{'op1'} eq 'or') { - $query = " \@or ".$query; - $condition2.= " \@attr 1=5 ".$attr2." \"".$search->{'field_value2'}."\" "; - } else { - $query = " \@not ".$query; - $condition2.= " \@attr 1=5 ".$attr2." \"".$search->{'field_value2'}."\" "; - } - } elsif ($search->{'field_name2'} eq 'callno') { - if ($search->{'op1'} eq 'and') { - $query = " \@and ".$query; - $condition2.= " \@attr 1=20 \@attr 3=2 ".$attr2." \"".$search->{'field_value2'}."\" "; - - } elsif ($search->{'op1'} eq 'or'){ - $query = " \@or ".$query; - $condition2.= " \@attr 1=20 \@attr 3=2 ".$attr2." \"".$search->{'field_value2'}."\" "; - } else { - $query = " \@not ".$query; - $condition2.= " \@attr 1=20 \@attr 3=2 ".$attr2." \"".$search->{'field_value2'}."\" "; - } - } elsif ($search->{'field_name2'} eq 'publisher') { - $query = " \@and ".$query; - $condition2.= " \@attr 1=1018 ".$attr2." \"".$search->{'field_value2'}."\" "; - } elsif ($search->{'field_name2'} eq 'publicationyear') { - $query = " \@and ".$query; - $condition2.= " \@attr 1=30 ".$search->{'field_value2'}; - } - $query .=$condition2; - - - } - - #search_field 3 - if ($search->{'field_value3'}) { - $search->{'field_value3'}=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\!|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)//g; - if ($search->{'ttype3'} eq 'exact') { - $attr3="\@attr 4=1 "; - if ($search->{'atype1'} eq 'start'){ - $attr.=" \@attr 3=1 \@attr 6=3 \@attr 5=1 \@attr 2=102 "; - }else{ - $attr.=" \@attr 5=1 \@attr 3=3 \@attr 6=1 \@attr 2=102 "; - } - } else { - $attr3=" \@attr 4=6 \@attr 5=103 "; - } - - if ($search->{'field_name3'} eq 'all') { - if ($search->{'op2'} eq 'and') { - $query = " \@and ".$query; - $condition3.= " \@attr 1=1016 ".$attr3." \"".$search->{'field_value3'}."\" "; - - } elsif ($search->{'op2'} eq 'or') { - $query = " \@or ".$query; - $condition3.= " \@attr 1=1016 ".$attr3." \"".$search->{'field_value3'}."\" "; - } else { - $query = " \@not ".$query; - $condition3.= " \@attr 1=1016 ".$attr3." \"".$search->{'field_value3'}."\" "; - } - } elsif ($search->{'field_name3'} eq 'author') { - if ($search->{'op2'} eq 'and') { - $query = " \@and ".$query; - $condition3.= " \@attr 1=1003 ".$attr3." \"".$search->{'field_value3'}."\" "; - - } elsif ($search->{'op2'} eq 'or') { - $query = " \@or ".$query; - $condition3.= " \@attr 1=1003 ".$attr3." \"".$search->{'field_value3'}."\" "; - } else { - $query = " \@not ".$query; - $condition3.= " \@attr 1=1003 ".$attr3." \"".$search->{'field_value3'}."\" "; - } - - } elsif ($search->{'field_name3'} eq 'title') { - if ($search->{'op2'} eq 'and') { - $query = " \@and ".$query; - $condition3.= " \@attr 1=4 ".$attr3." \"".$search->{'field_value3'}."\" "; - - } elsif ($search->{'op2'} eq 'or') { - $query = " \@or ".$query; - $condition3.= " \@attr 1=4 ".$attr3." \"".$search->{'field_value3'}."\" "; - } else { - $query = " \@not ".$query; - $condition3.= " \@attr 1=4 ".$attr3." \"".$search->{'field_value3'}."\" "; - } - - } elsif ($search->{'field_name3'} eq 'subject') { - if ($search->{'op2'} eq 'and') { - $query = " \@and ".$query; - $condition3.= " \@attr 1=21 ".$attr3." \"".$search->{'field_value3'}."\" "; - - } elsif ($search->{'op2'} eq 'or') { - $query = " \@or ".$query; - $condition3.= " \@attr 1=21 ".$attr3." \"".$search->{'field_value3'}."\" "; - } else { - $query = " \@not ".$query; - $condition3.= " \@attr 1=21 ".$attr3." \"".$search->{'field_value3'}."\" "; - } - } elsif ($search->{'field_name3'} eq 'series') { - if ($search->{'op2'} eq 'and') { - $query = " \@and ".$query; - $condition3.= " \@attr 1=5 ".$attr3." \"".$search->{'field_value3'}."\" "; - - } elsif ($search->{'op2'} eq 'or') { - $query = " \@or ".$query; - $condition3.= " \@attr 1=5 ".$attr3." \"".$search->{'field_value3'}."\" "; - } else { - $query = " \@not ".$query; - $condition3.= " \@attr 1=5 ".$attr3." \"".$search->{'field_value3'}."\" "; - } - } elsif ($search->{'field_name3'} eq 'callno') { - if ($search->{'op2'} eq 'and') { - $query = " \@and ".$query; - $condition3.= " \@attr 1=20 \@attr 3=2 ".$attr3." \"".$search->{'field_value3'}."\" "; - - } elsif ($search->{'op2'} eq 'or') { - $query = " \@or ".$query; - $condition3.= " \@attr 1=20 \@attr 3=2 ".$attr3." \"".$search->{'field_value3'}."\" "; - - } else { - $query = " \@not ".$query; - $condition3.= " \@attr 1=20 \@attr 3=2 ".$attr3." \"".$search->{'field_value3'}."\" "; - } - - - } elsif ($search->{'field_name3'} eq 'publisher') { - $query = " \@and ".$query; - $condition3.= " \@attr 1=1018 ".$attr3." \"".$search->{'field_value3'}."\" "; - } elsif ($search->{'field_name2'} eq 'publicationyear') { - $query = " \@and ".$query; - $condition3.= " \@attr 1=30 ".$search->{'field_value3'}; - } - $query .=$condition3; - - - } - - - - #search by class - if ($search->{'class'} ne '') { - $query= "\@and ".$query; - $query .= " \@attr 1=1031 \"".$search->{'class'}."\""; - push @params, $search->{'class'}; - } - #search by branch - if ($search->{'branch'} ne '') { - $query= "\@and ".$query; - $query .= " \@attr 1=1033 \"".$search->{'branch'}."\""; -# - } - if ($search->{'stack'} ne '') { - $query= "\@and ".$query; - $query .= " \@attr 1=1019 \"".$search->{'stack'}."\""; - - } - if ($search->{'date_from'} ne '') { - $query= "\@and ".$query; - $query .= " \@attr 1=30 \@attr 2=4 \@attr 4=4 ".$search->{'date_from'}; - } - if ($search->{'date_to'} ne '') { - $query= "\@and ".$query; - $query .= " \@attr 1=30 \@attr 2=2 \@attr 4=4 ".$search->{'date_to'}; - - } - - } - - if ($cql) { - warn "STILL CQL"; - $count_query = $cql_query; - $query=1; - } else { - $count_query = $query; - } - warn "QUERY_AFTER".$count_query; - if ($search->{'order'}) { - $query.=" ".$search->{'order'}; - $query=" \@or \@or ".$query; - } -#warn $query; - #execute the query and returns just the results between $num and $num + $offset - my $limit = $num + $offset; - my $startfrom = $offset; -return unless $query; ##Somebody hit the search button with no query. Prevent a system crash -my $oConnection=C4::Context->Zconn("biblioserver"); -if ($oConnection eq "error"){ - return("error",undef); - } -#$oConnection->option(preferredRecordSyntax => "XML"); -my $oResult; -my $newq; -if ($cql) { - warn "CQLISH:".$cql_query; - if ($rpn) { - $newq= new ZOOM::Query::PQF($cql_query); - } else { - $newq = new ZOOM::Query::CQL($cql_query,$oConnection); - } -} else { - $newq= new ZOOM::Query::PQF($query); -} -#my $order=$search->{'order'}; -#if ($order){ -#$newq->sortby("$order"); -#} -eval { -$oResult= $oConnection->search($newq); -}; -if($@){ - return("error",undef); - } - - - - $numresults=$oResult->size() if ($oResult); - - my $i = 0; - - #proccess just the results to show - if ($numresults>0) { -#Build brancnames hash -#find branchname -#get branch information..... -my %branches; - my $bsth=$dbh->prepare("SELECT branchcode,branchname FROM branches"); - $bsth->execute(); - while (my $bdata=$bsth->fetchrow_hashref){ - $branches{$bdata->{'branchcode'}}= $bdata->{'branchname'}; - - } - -#Building shelving hash -my %shelves; -#find shelvingname -my $stackstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.stack"'); - $stackstatus->execute; - - my ($authorised_valuecode) = $stackstatus->fetchrow; - if ($authorised_valuecode) { - $stackstatus = $dbh->prepare("select lib,authorised_value from authorised_values where category=? "); - $stackstatus->execute($authorised_valuecode); - - while (my $lib = $stackstatus->fetchrow_hashref){ - $shelves{$lib->{'authorised_value'}} = $lib->{'lib'}; - } - } - -#search item field code - my $sth = - $dbh->prepare( -"select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'" - ); - $sth->execute; - my ($itemtag) = $sth->fetchrow; -## find column names of items related to MARC -my $sth2=$dbh->prepare("SHOW COLUMNS from items"); - $sth2->execute; -my %subfieldstosearch; -while ((my $column)=$sth2->fetchrow){ -my ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,"items.".$column,""); -$subfieldstosearch{$column}=$tagsubfield; -} - - for ($i=$startfrom; $i<(($startfrom+$num<=$numresults) ? ($startfrom+$num):$numresults) ; $i++){ - - my $rec=$oResult->record($i); - - $marcdata = $rec->raw(); - my $marcrecord; - $marcrecord = MARC::File::USMARC::decode($marcdata); -# $marcrecord=MARC::Record->new_from_xml( $marcdata,'UTF-8' ); -# $marcrecord->encoding( 'UTF-8' ); - my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,''); - - &add_html_bold_fields($type,$oldbiblio,$search); - if ($i % 2) { - $toggle="#ffffcc"; - } else { - $toggle="white"; - } - $oldbiblio->{'toggle'}=$toggle; - - - - my @fields = $marcrecord->field($itemtag); -my @items; - my $item; -my %counts; -$counts{'total'}=0; - -# -##Loop for each item field - foreach my $field (@fields) { - foreach my $code ( keys %subfieldstosearch ) { - -$item->{$code}=$field->subfield($subfieldstosearch{$code}); -} - -my $status; - -$item->{'branchname'}=$branches{$item->{'holdingbranch'}}; -$item->{'shelves'}=$shelves{$item->{stack}}; -$status="Lost" if ($item->{'itemlost'}>0); -$status="Withdrawn" if ($item->{'wthdrawn'}>0); -if ($search->{'from'} eq "intranet"){ -$search->{'avoidquerylog'}=1; -$status="Due:".format_date($item->{'onloan'}) if ($item->{'onloan'}>0); - $status = $item->{'holdingbranch'}."-".$item->{'stack'}."[".$item->{'itemcallnumber'}."]" unless defined $status; -}else{ -$status="On Loan" if ($item->{'onloan'}>0); - $status = $item->{'branchname'}."[".$item->{'shelves'}."]" unless defined $status; -} - $counts{$status}++; -$counts{'total'}++; -push @items,$item; -#$oldbiblio->{'itemcount'}++; - } - - my $norequests = 1; - my $noitems = 1; - if (@items) { - $noitems = 0; - foreach my $itm (@items) { - $norequests = 0 unless $itm->{'itemnotforloan'}; - } - } - $oldbiblio->{'noitems'} = $noitems; - $oldbiblio->{'norequests'} = $norequests; - $oldbiblio->{'even'} = $even = not $even; - $oldbiblio->{'itemcount'} = $counts{'total'}; - - my $totalitemcounts = 0; - foreach my $key (keys %counts){ - if ($key ne 'total'){ - $totalitemcounts+= $counts{$key}; - $oldbiblio->{'locationhash'}->{$key}=$counts{$key}; - } - } - - my ($locationtext, $locationtextonly, $notavailabletext) = ('','',''); - foreach (sort keys %{$oldbiblio->{'locationhash'}}) { - if ($_ eq 'notavailable') { - $notavailabletext="Not available"; - my $c=$oldbiblio->{'locationhash'}->{$_}; - $oldbiblio->{'not-available-p'}=$c; - } else { - $locationtext.="$_"; - my $c=$oldbiblio->{'locationhash'}->{$_}; - if ($_ eq 'Item Lost') { - $oldbiblio->{'lost-p'} = $c; - } elsif ($_ eq 'Withdrawn') { - $oldbiblio->{'withdrawn-p'} = $c; - } elsif ($_ eq 'On Loan') { - $oldbiblio->{'on-loan-p'} = $c; - } else { - $locationtextonly.= $_; - $locationtextonly.= " ($c)
" if $totalitemcounts > 1; - } - if ($totalitemcounts>1) { - $locationtext.=" ($c)
"; - } - } - } - if ($notavailabletext) { - $locationtext.= $notavailabletext; - } else { - $locationtext=~s/, $//; - } - $oldbiblio->{'location'} = $locationtext; - $oldbiblio->{'location-only'} = $locationtextonly; - $oldbiblio->{'use-location-flags-p'} = 1; - - push (@results, $oldbiblio); - - } -# $i++; - } -#$oConnection->destroy(); - my $count = $numresults; - - unless ($search->{'avoidquerylog'}) { - add_query_line($type, $search, $count);} - return($count,@results); -} - - -sub FindDuplicate { - my ($record)=@_; -my $dbh=C4::Context->dbh; - my $result = MARCmarc2koha($dbh,$record,''); - my $sth; - my $query; - my $search; - my $type; - my ($biblionumber,$bibid,$title); - # search duplicate on ISBN, easy and fast.. -$search->{'avoidquerylog'}=1; - if ($result->{isbn}) { - $type="precise"; -###Temporary fix for ISBN -my $isbn=$result->{isbn}; -$isbn=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)//g; - $search->{'isbn'}=$isbn; - }else{ -$result->{title}=~s /\\//g; -$result->{title}=~s /\"//g; - $type="loose"; - $search->{'field_name1'}="title"; - $search->{'field_value1'}=$result->{title}; - $search->{'ttype1'}="exact"; - $search->{'atype1'}="start"; - } - my ($total,@result)=CatSearch4($type,$search,1,0); - return $result[0]->{'biblionumber'}, $result[0]->{'biblionumber'},$result[0]->{'title'} if ($total); - -} -=item KeywordSearch - - $search = { "keyword" => "One or more keywords", - "class" => "VID|CD", # Limit search to fiction and CDs - "dewey" => "813", - }; - ($count, @results) = &KeywordSearch($env, $type, $search, $num, $offset); - -C<&KeywordSearch> searches the catalog by keyword: given a string -(C<$search-E{"keyword"}> consisting of a space-separated list of -keywords, it looks for books that contain any of those keywords in any -of a number of places. - -C<&KeywordSearch> looks for keywords in the book title (and subtitle), -series name, notes (both C and C), -and subjects. - -C<$search-E{"class"}> can be set to a C<|> (pipe)-separated list of -item class codes (e.g., "F" for fiction, "JNF" for junior nonfiction, -etc.). In this case, the search will be restricted to just those -classes. - -If C<$search-E{"class"}> is not specified, you may specify -C<$search-E{"dewey"}>. This will restrict the search to that -particular Dewey Decimal Classification category. Setting -C<$search-E{"dewey"}> to "513" will return books about arithmetic, -whereas setting it to "5" will return all books with Dewey code 5I -(Science and Mathematics). - -C<$env> and C<$type> are ignored. - -C<$offset> and C<$num> specify the subset of results to return. -C<$num> specifies the number of results to return, and C<$offset> is -the number of the first result. Thus, setting C<$offset> to 100 and -C<$num> to 5 will return results 100 through 104 inclusive. - -=cut -#' -sub KeywordSearch { - my ($env,$type,$search,$num,$offset)=@_; - my $dbh = C4::Context->dbh; - $search->{'keyword'}=~ s/ +$//; - my @key=split(' ',$search->{'keyword'}); - # FIXME - Naive users might enter comma-separated - # words, e.g., "training, animal". Ought to cope with - # this. - my $count=@key; - my $i=1; - my %biblionumbers; # Set of biblionumbers returned by the - # various searches. - - # FIXME - Ought to filter the stopwords out of the list of keywords. - # @key = map { !defined($stopwords{$_}) } @key; - - # FIXME - The way this code is currently set up, it looks for all of - # the keywords first in (title, notes, seriestitle), then in the - # subtitle, then in the subject. Thus, if you look for keywords - # "science fiction", this search won't find a book with - # title = "How to write fiction" - # subtitle = "A science-based approach" - # Is this the desired effect? If not, then the first SQL query - # should look in the biblio, subtitle, and subject tables all at - # once. The way the first query is built can accomodate this easily. - - # Look for keywords in table 'biblio'. - - # Build an SQL query that finds each of the keywords in any of the - # title, biblio.notes, or seriestitle. To do this, we'll build up an - # array of clauses, one for each keyword. - my $query; # The SQL query - my @clauses = (); # The search clauses - my @bind = (); # The term bindings - - $query = <bind_columns() ? Documented as the most - # efficient way to fetch data. - my $sth=$dbh->prepare($query); - $sth->execute(@bind); - while (my @res = $sth->fetchrow_array) { - for (@res) - { - $biblionumbers{$_} = 1; # Add these results to the set - } - } - $sth->finish; - - # Now look for keywords in the 'bibliosubtitle' table. - - # Again, we build a list of clauses from the keywords. - @clauses = (); - @bind = (); - $query = "SELECT biblionumber FROM bibliosubtitle WHERE "; - foreach my $keyword (@key) - { - push @clauses, - "subtitle LIKE ? OR subtitle like ?"; - push(@bind,"\Q$keyword\E%","% \Q$keyword\E%"); - } - $query .= "(" . join(") AND (", @clauses) . ")"; - - $sth=$dbh->prepare($query); - $sth->execute(@bind); - while (my @res = $sth->fetchrow_array) { - for (@res) - { - $biblionumbers{$_} = 1; # Add these results to the set - } - } - $sth->finish; - - # Look for the keywords in the notes for individual items - # ('biblioitems.notes') - - # Again, we build a list of clauses from the keywords. - @clauses = (); - @bind = (); - $query = "SELECT biblionumber FROM biblioitems WHERE "; - foreach my $keyword (@key) - { - push @clauses, - "notes LIKE ? OR notes like ?"; - push(@bind,"\Q$keyword\E%","% \Q$keyword\E%"); - } - $query .= "(" . join(") AND (", @clauses) . ")"; - - $sth=$dbh->prepare($query); - $sth->execute(@bind); - while (my @res = $sth->fetchrow_array) { - for (@res) - { - $biblionumbers{$_} = 1; # Add these results to the set - } - } - $sth->finish; - - # Look for keywords in the 'bibliosubject' table. - - # FIXME - The other queries look for words in the desired field that - # begin with the individual keywords the user entered. This one - # searches for the literal string the user entered. Is this the - # desired effect? - # Note in particular that spaces are retained: if the user typed - # science fiction - # (with two spaces), this won't find the subject "science fiction" - # (one space). Likewise, a search for "%" will return absolutely - # everything. - # If this isn't the desired effect, see the previous searches for - # how to do it. - - $sth=$dbh->prepare("Select biblionumber from bibliosubject where subject - like ? group by biblionumber"); - $sth->execute("%$search->{'keyword'}%"); - - while (my @res = $sth->fetchrow_array) { - for (@res) - { - $biblionumbers{$_} = 1; # Add these results to the set - } - } - $sth->finish; - - my $i2=0; - my $i3=0; - my $i4=0; - - my @res2; - my @res = keys %biblionumbers; - $count=@res; - - $i=0; -# print "count $count"; - if ($search->{'class'} ne ''){ - while ($i2 <$count){ - my $query="select * from biblio,biblioitems where - biblio.biblionumber=? and - biblio.biblionumber=biblioitems.biblionumber "; - my @bind = ($res[$i2]); - if ($search->{'class'} ne ''){ # FIXME - Redundant - my @temp=split(/\|/,$search->{'class'}); - my $count=@temp; - $query.= "and ( itemtype=?"; - push(@bind,$temp[0]); - for (my $i=1;$i<$count;$i++){ - $query.=" or itemtype=?"; - push(@bind,$temp[$i]); - } - $query.=")"; - } - my $sth=$dbh->prepare($query); - # print $query; - $sth->execute(@bind); - if (my $data2=$sth->fetchrow_hashref){ - my $dewey= $data2->{'dewey'}; - my $subclass=$data2->{'subclass'}; - # FIXME - This next bit is bogus, because it assumes that the - # Dewey code is a floating-point number. It isn't. It's - # actually a string that mainly consists of numbers. In - # particular, "4" is not a valid Dewey code, although "004" - # is ("Data processing; Computer science"). Likewise, zeros - # after the decimal are significant ("575" is not the same as - # "575.0"; the latter is more specific). And "000" is a - # perfectly good Dewey code ("General works; computer - # science") and should not be interpreted to mean "this - # database entry does not have a Dewey code". That's what - # NULL is for. - $dewey=~s/\.*0*$//; - ($dewey == 0) && ($dewey=''); - ($dewey) && ($dewey.=" $subclass") ; - $sth->finish; - my $end=$offset +$num; - if ($i4 <= $offset){ - $i4++; - } -# print $i4; - if ($i4 <=$end && $i4 > $offset){ - $data2->{'dewey'}=$dewey; - $res2[$i3]=$data2; - -# $res2[$i3]="$data2->{'author'}\t$data2->{'title'}\t$data2->{'biblionumber'}\t$data2->{'copyrightdate'}\t$dewey"; - $i3++; - $i4++; -# print "in here $i3
"; - } else { -# print $end; - } - $i++; - } - $i2++; - } - $count=$i; - - } else { - # $search->{'class'} was not specified - - # FIXME - This is bogus: it makes a separate query for each - # biblioitem, and returns results in apparently random order. It'd - # be much better to combine all of the previous queries into one big - # one (building it up a little at a time, of course), and have that - # big query select all of the desired fields, instead of just - # 'biblionumber'. - - while ($i2 < $num && $i2 < $count){ - my $query="select * from biblio,biblioitems where - biblio.biblionumber=? and - biblio.biblionumber=biblioitems.biblionumber "; - my @bind=($res[$i2+$offset]); - - if ($search->{'dewey'} ne ''){ - $query.= "and (dewey like ?)"; - push(@bind,"$search->{'dewey'}%"); - } - - my $sth=$dbh->prepare($query); -# print $query; - $sth->execute(@bind); - if (my $data2=$sth->fetchrow_hashref){ - my $dewey= $data2->{'dewey'}; - my $subclass=$data2->{'subclass'}; - $dewey=~s/\.*0*$//; - ($dewey == 0) && ($dewey=''); - ($dewey) && ($dewey.=" $subclass") ; - $sth->finish; - $data2->{'dewey'}=$dewey; - - $res2[$i]=$data2; -# $res2[$i]="$data2->{'author'}\t$data2->{'title'}\t$data2->{'biblionumber'}\t$data2->{'copyrightdate'}\t$dewey"; - $i++; - } - $i2++; - - } - } - - #$count=$i; - return($count,@res2); -} - -sub KeywordSearch2 { - my ($env,$type,$search,$num,$offset)=@_; - my $dbh = C4::Context->dbh; - $search->{'keyword'}=~ s/ +$//; - my @key=split(' ',$search->{'keyword'}); - my $count=@key; - my $i=1; - my @results; - my $query ="Select * from biblio,bibliosubtitle,biblioitems where - biblio.biblionumber=biblioitems.biblionumber and - biblio.biblionumber=bibliosubtitle.biblionumber and - (((title like ? or title like ?)"; - my @bind=("$key[0]%","% $key[0]%"); - while ($i < $count){ - $query .= " and (title like ? or title like ?)"; - push(@bind,"$key[$i]%","% $key[$i]%"); - $i++; - } - $query.= ") or ((subtitle like ? or subtitle like ?)"; - push(@bind,"$key[0]%","% $key[0]%"); - for ($i=1;$i<$count;$i++){ - $query.= " and (subtitle like ? or subtitle like ?)"; - push(@bind,"$key[$i]%","% $key[$i]%"); - } - $query.= ") or ((seriestitle like ? or seriestitle like ?)"; - push(@bind,"$key[0]%","% $key[0]%"); - for ($i=1;$i<$count;$i++){ - $query.=" and (seriestitle like ? or seriestitle like ?)"; - push(@bind,"$key[$i]%","% $key[$i]%"); - } - $query.= ") or ((biblio.notes like ? or biblio.notes like ?)"; - push(@bind,"$key[0]%","% $key[0]%"); - for ($i=1;$i<$count;$i++){ - $query.=" and (biblio.notes like ? or biblio.notes like ?)"; - push(@bind,"$key[$i]%","% $key[$i]%"); - } - $query.= ") or ((biblioitems.notes like ? or biblioitems.notes like ?)"; - push(@bind,"$key[0]%","% $key[0]%"); - for ($i=1;$i<$count;$i++){ - $query.=" and (biblioitems.notes like ? or biblioitems.notes like ?)"; - push(@bind,"$key[$i]%","% $key[$i]%"); - } - if ($search->{'keyword'} =~ /new zealand/i){ - $query.= "or (title like 'nz%' or title like '% nz %' or title like '% nz' or subtitle like 'nz%' - or subtitle like '% nz %' or subtitle like '% nz' or author like 'nz %' - or author like '% nz %' or author like '% nz')" - } - if ($search->{'keyword'} eq 'nz' || $search->{'keyword'} eq 'NZ' || - $search->{'keyword'} =~ /nz /i || $search->{'keyword'} =~ / nz /i || - $search->{'keyword'} =~ / nz/i){ - $query.= "or (title like 'new zealand%' or title like '% new zealand %' - or title like '% new zealand' or subtitle like 'new zealand%' or - subtitle like '% new zealand %' - or subtitle like '% new zealand' or author like 'new zealand%' - or author like '% new zealand %' or author like '% new zealand' or - seriestitle like 'new zealand%' or seriestitle like '% new zealand %' - or seriestitle like '% new zealand')" - } - $query .= "))"; - if ($search->{'class'} ne ''){ - my @temp=split(/\|/,$search->{'class'}); - my $count=@temp; - $query.= "and ( itemtype=?"; - push(@bind,"$temp[0]"); - for (my $i=1;$i<$count;$i++){ - $query.=" or itemtype=?"; - push(@bind,"$temp[$i]"); - } - $query.=")"; - } - if ($search->{'dewey'} ne ''){ - $query.= "and (dewey like '$search->{'dewey'}%') "; - } - $query.="group by biblio.biblionumber"; - #$query.=" order by author,title"; -# print $query; - my $sth=$dbh->prepare($query); - $sth->execute(@bind); - $i=0; - while (my $data=$sth->fetchrow_hashref){ -#FIXME: rewrite to use ? before uncomment -# my $sti=$dbh->prepare("select dewey,subclass from biblioitems where biblionumber=$data->{'biblionumber'} -# "); -# $sti->execute; -# my ($dewey, $subclass) = $sti->fetchrow; - my $dewey=$data->{'dewey'}; - my $subclass=$data->{'subclass'}; - $dewey=~s/\.*0*$//; - ($dewey == 0) && ($dewey=''); - ($dewey) && ($dewey.=" $subclass"); -# $sti->finish; - $results[$i]="$data->{'author'}\t$data->{'title'}\t$data->{'biblionumber'}\t$data->{'copyrightdate'}\t$dewey"; -# print $results[$i]; - $i++; - } - $sth->finish; - $sth=$dbh->prepare("Select biblionumber from bibliosubject where subject - like ? group by biblionumber"); - $sth->execute("%".$search->{'keyword'}."%"); - while (my $data=$sth->fetchrow_hashref){ - $query="Select * from biblio,biblioitems where - biblio.biblionumber=? and - biblio.biblionumber=biblioitems.biblionumber "; - @bind=($data->{'biblionumber'}); - if ($search->{'class'} ne ''){ - my @temp=split(/\|/,$search->{'class'}); - my $count=@temp; - $query.= " and ( itemtype=?"; - push(@bind,$temp[0]); - for (my $i=1;$i<$count;$i++){ - $query.=" or itemtype=?"; - push(@bind,$temp[$i]); - } - $query.=")"; - - } - if ($search->{'dewey'} ne ''){ - $query.= "and (dewey like ?)"; - push(@bind,"$search->{'dewey'}%"); - } - my $sth2=$dbh->prepare($query); - $sth2->execute(@bind); -# print $query; - while (my $data2=$sth2->fetchrow_hashref){ - my $dewey= $data2->{'dewey'}; - my $subclass=$data2->{'subclass'}; - $dewey=~s/\.*0*$//; - ($dewey == 0) && ($dewey=''); - ($dewey) && ($dewey.=" $subclass") ; -# $sti->finish; - $results[$i]="$data2->{'author'}\t$data2->{'title'}\t$data2->{'biblionumber'}\t$data2->{'copyrightdate'}\t$dewey"; -# print $results[$i]; - $i++; - } - $sth2->finish; - } - my $i2=1; - @results=sort @results; - my @res; - $count=@results; - $i=1; - if ($count > 0){ - $res[0]=$results[0]; - } - while ($i2 < $count){ - if ($results[$i2] ne $res[$i-1]){ - $res[$i]=$results[$i2]; - $i++; - } - $i2++; - } - $i2=0; - my @res2; - $count=@res; - while ($i2 < $num && $i2 < $count){ - $res2[$i2]=$res[$i2+$offset]; -# print $res2[$i2]; - $i2++; - } - $sth->finish; -# $i--; -# $i++; - return($i,@res2); -} - - -sub add_query_line { - - my ($type,$search,$results)=@_; - my $dbh = C4::Context->dbh; - my $searchdesc = ''; - my $from; - my $borrowernumber = $search->{'borrowernumber'}; - my $remote_IP = $search->{'remote_IP'}; - my $remote_URL= $search->{'remote_URL'}; - my $searchmode = ''; - my $searchlinkdesc = ''; - - if ($search->{'from'}) { - $from = $search->{'from'}; - } else { - $from = 'opac' - } - - if ($type eq 'keyword') { - $searchdesc = $search->{'keyword'}; - if ($search->{'ttype'} eq 'exact') { - $searchmode = 'phrase'; - } else { - $searchmode = 'any word'; - } - $searchlinkdesc.= "search_type=keyword&keyword=$search->{'keyword'}&ttype=$search->{'ttype'}"; - - } elsif ($type eq 'precise') { - if ($search->{'itemnumber'}) { - $searchdesc = "barcode = $search->{'itemnumber'}"; - $searchlinkdesc.= "search_type=precise&itemnumber=$search->{'itemnumber'}"; - } else { - $searchdesc = "isbn = $search->{'itemnumber'}"; - $searchlinkdesc.= "search_type=precise&itemnumber=$search->{'isbn'}"; - } - - } elsif ($type eq 'recently_items') { - $searchdesc = "$search->{'range'}"; - $searchlinkdesc.= "recently_items=1&search=$search->{'range'}"; - } else { - $searchlinkdesc.= "search_type=loose"; - if ( ($search->{"field_name1"}) && ($search->{"field_value1"}) ) { - if ($search->{"ttype1"} eq 'exact') { - $searchmode.= ' starting with '; - } else { - $searchmode.= ' containing '; - } - $searchdesc.= " | " . $search->{"field_name1"} . " = " . $search->{"field_value1"} . " | "; - $searchlinkdesc.= "&ttype=$search->{'ttype1'}&field_name1=$search->{'field_name1'}&field_value1=$search->{'field_value1'}"; - } - - if ( ($search->{"field_name2"}) && ($search->{"field_value2"}) ) { - if ($search->{"ttype2"} eq 'exact') { - $searchmode.= ' | starting with '; - } else { - $searchmode.= ' | containing '; - } - $searchdesc.= uc($search->{"op1"}); - $searchdesc.= " | " . $search->{"field_name2"} . " = " . $search->{"field_value2"} . " | "; - $searchlinkdesc.= "&op1=$search->{'op1'}&ttype=$search->{'ttype2'}&field_name2=$search->{'field_name2'}&field_value2=$search->{'field_value2'}"; - } - - if ( ($search->{"field_name3"}) && ($search->{"field_value3"}) ) { - if ($search->{"ttype3"} eq 'exact') { - $searchmode.= ' | starting with '; - } else { - $searchmode.= ' | containing '; - } - $searchdesc.= uc($search->{"op2"}); - $searchdesc.= " | " . $search->{"field_name3"} . " = " . $search->{"field_value3"} . " | "; - $searchlinkdesc.= "&op2=$search->{'op2'}&ttype=$search->{'ttype3'}&field_name3=$search->{'field_name3'}&field_value3=$search->{'field_value3'}"; - } - } - - if ($search->{'branch'}) { - $searchdesc.= " AND branch = $search->{'branch'}"; - $searchlinkdesc.= "&branch=$search->{'branch'}"; - } - if ($search->{'class'}) { - $searchdesc.= " AND itemtype = $search->{'class'}"; - $searchlinkdesc.= "&class=$search->{'class'}"; - } - -# my $sth = $dbh->prepare("INSERT INTO querys_log (searchtype, searchdesc, searchmode, borrowernumber, number_of_results, date, execute_from, remote_IP, linkdesc) VALUES (?,?,?,?,?,NOW(),?,?,?)"); -# $sth->execute($type, $searchdesc, $searchmode, $borrowernumber, $results, $from, $remote_IP, $searchlinkdesc); -# $sth->finish; -my $sth = $dbh->prepare("INSERT INTO phrase_log(phr_phrase,phr_resultcount,phr_ip,user,actual) VALUES(?,?,?,?,?)"); - - -$sth->execute($searchdesc,$results,$remote_IP,$borrowernumber,$remote_URL); -$sth->finish; - -} - - -=item CatSearch - - ($count, @results) = &CatSearch($env, $type, $search, $num, $offset); - -C<&CatSearch> searches the Koha catalog. It returns a list whose first -element is the number of returned results, and whose subsequent -elements are the results themselves. - -Each returned element is a reference-to-hash. Most of the keys are -simply the fields from the C table in the Koha database, but -the following keys may also be present: - -=over 4 - -=item C - -The book's illustrator. - -=item C - -The publisher. - -=back - -C<$env> is ignored. - -C<$type> may be C, C, or C. This controls the -high-level behavior of C<&CatSearch>, as described below. - -In many cases, the description below says that a certain field in the -database must match the search string. In these cases, it means that -the beginning of some word in the field must match the search string. -Thus, an author search for "sm" will return books whose author is -"John Smith" or "Mike Smalls", but not "Paul Grossman", since the "sm" -does not occur at the beginning of a word. - -Note that within each search mode, the criteria are and-ed together. -That is, if you perform a loose search on the author "Jerome" and the -title "Boat", the search will only return books by Jerome containing -"Boat" in the title. - -It is not possible to cross modes, e.g., set the author to "Asimov" -and the subject to "Math" in hopes of finding books on math by Asimov. - -=head2 Loose search - -If C<$type> is set to C, the following search criteria may be -used: - -=over 4 - -=item C<$search-E{author}> - -The search string is a space-separated list of words. Each word must -match either the C or C field. - -=item C<$search-E{title}> - -Each word in the search string must match the book title. If no author -is specified, the book subtitle will also be searched. - -=item C<$search-E{abstract}> - -Searches for the given search string in the book's abstract. - -=item C<$search-E{'date-before'}> - -Searches for books whose copyright date matches the search string. -That is, setting C<$search-E{'date-before'}> to "1985" will find -books written in 1985, and setting it to "198" will find books written -between 1980 and 1989. - -=item C<$search-E{title}> - -Searches by title are also affected by the value of -C<$search-E{"ttype"}>; if it is set to C, then the book -title, (one of) the series titleZ<>(s), or (one of) the unititleZ<>(s) must -match the search string exactly (the subtitle is not searched). - -If C<$search-E{"ttype"}> is set to anything other than C, -each word in the search string must match the title, subtitle, -unititle, or series title. - -=item C<$search-E{class}> - -Restricts the search to certain item classes. The value of -C<$search-E{"class"}> is a | (pipe)-separated list of item types. -Thus, setting it to "F" restricts the search to fiction, and setting -it to "CD|CAS" will only look in compact disks and cassettes. - -=item C<$search-E{dewey}> - -Searches for books whose Dewey Decimal Classification code matches the -search string. That is, setting C<$search-E{"dewey"}> to "5" will -search for all books in 5I (Science and mathematics), setting it -to "54" will search for all books in 54I (Chemistry), and setting -it to "546" will search for books on inorganic chemistry. - -=item C<$search-E{publisher}> - -Searches for books whose publisher contains the search string (unlike -other search criteria, C<$search-E{publisher}> is a string, not a -set of words. - -=back - -=head2 Subject search - -If C<$type> is set to C, the following search criterion may -be used: - -=over 4 - -=item C<$search-E{subject}> - -The search string is a space-separated list of words, each of which -must match the book's subject. - -Special case: if C<$search-E{subject}> is set to C, -C<&CatSearch> will search for books whose subject is "New Zealand". -However, setting C<$search-E{subject}> to C<"nz football"> will -search for books on "nz" and "football", not books on "New Zealand" -and "football". - -=back - -=head2 Precise search - -If C<$type> is set to C, the following search criteria may be -used: - -=over 4 - -=item C<$search-E{item}> - -Searches for books whose barcode exactly matches the search string. - -=item C<$search-E{isbn}> - -Searches for books whose ISBN exactly matches the search string. - -=back - -For a loose search, if an author was specified, the results are -ordered by author and title. If no author was specified, the results -are ordered by title. - -For other (non-loose) searches, if a subject was specified, the -results are ordered alphabetically by subject. - -In all other cases (e.g., loose search by keyword), the results are -not ordered. - -=cut -#' -sub CatSearch { - my ($env,$type,$search,$num,$offset)=@_; - my $dbh = C4::Context->dbh; - my $query = ''; - my @bind = (); - my @results; - - my $title = lc($search->{'title'}); - - if ($type eq 'loose') { - if ($search->{'author'} ne ''){ - my @key=split(' ',$search->{'author'}); - my $count=@key; - my $i=1; - $query="select *,biblio.author,biblio.biblionumber from - biblio - left join additionalauthors - on additionalauthors.biblionumber =biblio.biblionumber - where - ((biblio.author like ? or biblio.author like ? or - additionalauthors.author like ? or additionalauthors.author - like ? - )"; - @bind=("$key[0]%","% $key[0]%","$key[0]%","% $key[0]%"); - while ($i < $count){ - $query .= " and ( - biblio.author like ? or biblio.author like ? or - additionalauthors.author like ? or additionalauthors.author like ? - )"; - push(@bind,"$key[$i]%","% $key[$i]%","$key[$i]%","% $key[$i]%"); - $i++; - } - $query .= ")"; - if ($search->{'title'} ne ''){ - my @key=split(' ',$search->{'title'}); - my $count=@key; - my $i=0; - $query.= " and (((title like ? or title like ?)"; - push(@bind,"$key[0]%","% $key[0]%"); - while ($i<$count){ - $query .= " and (title like ? or title like ?)"; - push(@bind,"$key[$i]%","% $key[$i]%"); - $i++; - } - $query.=") or ((seriestitle like ? or seriestitle like ?)"; - push(@bind,"$key[0]%","% $key[0]%"); - for ($i=1;$i<$count;$i++){ - $query.=" and (seriestitle like ? or seriestitle like ?)"; - push(@bind,"$key[$i]%","% $key[$i]%"); - } - $query.=") or ((unititle like ? or unititle like ?)"; - push(@bind,"$key[0]%","% $key[0]%"); - for ($i=1;$i<$count;$i++){ - $query.=" and (unititle like ? or unititle like ?)"; - push(@bind,"$key[$i]%","% $key[$i]%"); - } - $query .= "))"; - } - if ($search->{'abstract'} ne ''){ - $query.= " and (abstract like ?)"; - push(@bind,"%$search->{'abstract'}%"); - } - if ($search->{'date-before'} ne ''){ - $query.= " and (copyrightdate like ?)"; - push(@bind,"%$search->{'date-before'}%"); - } - $query.=" group by biblio.biblionumber"; - } else { - if ($search->{'title'} ne '') { - if ($search->{'ttype'} eq 'exact'){ - $query="select * from biblio - where - (biblio.title=? or (biblio.unititle = ? - or biblio.unititle like ? or - biblio.unititle like ? or - biblio.unititle like ?) or - (biblio.seriestitle = ? or - biblio.seriestitle like ? or - biblio.seriestitle like ? or - biblio.seriestitle like ?) - )"; - @bind=($search->{'title'},$search->{'title'},"$search->{'title'} |%","%| $search->{'title'} |%","%| $search->{'title'}",$search->{'title'},"$search->{'title'} |%","%| $search->{'title'} |%","%| $search->{'title'}"); - } else { - my @key=split(' ',$search->{'title'}); - my $count=@key; - my $i=1; - $query="select biblio.biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp,subtitle from biblio - left join bibliosubtitle on - biblio.biblionumber=bibliosubtitle.biblionumber - where - (((title like ? or title like ?)"; - @bind=("$key[0]%","% $key[0]%"); - while ($i<$count){ - $query .= " and (title like ? or title like ?)"; - push(@bind,"$key[$i]%","% $key[$i]%"); - $i++; - } - $query.=") or ((subtitle like ? or subtitle like ?)"; - push(@bind,"$key[0]%","% $key[0]%"); - for ($i=1;$i<$count;$i++){ - $query.=" and (subtitle like ? or subtitle like ?)"; - push(@bind,"$key[$i]%","% $key[$i]%"); - } - $query.=") or ((seriestitle like ? or seriestitle like ?)"; - push(@bind,"$key[0]%","% $key[0]%"); - for ($i=1;$i<$count;$i++){ - $query.=" and (seriestitle like ? or seriestitle like ?)"; - push(@bind,"$key[$i]%","% $key[$i]%"); - } - $query.=") or ((unititle like ? or unititle like ?)"; - push(@bind,"$key[0]%","% $key[0]%"); - for ($i=1;$i<$count;$i++){ - $query.=" and (unititle like ? or unititle like ?)"; - push(@bind,"$key[$i]%","% $key[$i]%"); - } - $query .= "))"; - } - if ($search->{'abstract'} ne ''){ - $query.= " and (abstract like ?)"; - push(@bind,"%$search->{'abstract'}%"); - } - if ($search->{'date-before'} ne ''){ - $query.= " and (copyrightdate like ?)"; - push(@bind,"%$search->{'date-before'}%"); - } - - } elsif ($search->{'dewey'} ne ''){ - $query="select * from biblioitems,biblio - where biblio.biblionumber=biblioitems.biblionumber - and biblioitems.dewey like ?"; - @bind=("$search->{'dewey'}%"); - } elsif ($search->{'illustrator'} ne '') { - $query="select * from biblioitems,biblio - where biblio.biblionumber=biblioitems.biblionumber - and biblioitems.illus like ?"; - @bind=("%".$search->{'illustrator'}."%"); - } elsif ($search->{'publisher'} ne ''){ - $query = "Select * from biblio,biblioitems where biblio.biblionumber - =biblioitems.biblionumber and (publishercode like ?)"; - @bind=("%$search->{'publisher'}%"); - } elsif ($search->{'abstract'} ne ''){ - $query = "Select * from biblio where abstract like ?"; - @bind=("%$search->{'abstract'}%"); - } elsif ($search->{'date-before'} ne ''){ - $query = "Select * from biblio where copyrightdate like ?"; - @bind=("%$search->{'date-before'}%"); - }elsif ($search->{'branch'} ne ''){ - $query = "Select * from biblio,items where biblio.biblionumber - =items.biblionumber and holdingbranch like ?"; - @bind=("$search->{'branch'}"); - }elsif ($search->{'class'} ne ''){ - $query="select * from biblioitems,biblio where biblio.biblionumber=biblioitems.biblionumber"; - - $query.= " where itemtype= ?"; - @bind=("$search->{'class'}"); - } - $query .=" group by biblio.biblionumber"; - } - } - if ($type eq 'subject'){ - my @key=split(' ',$search->{'subject'}); - my $count=@key; - my $i=1; - $query="select * from bibliosubject, biblioitems where -(bibliosubject.biblionumber = biblioitems.biblionumber) and ( subject like ? or subject like ? or subject like ?)"; - @bind=("$key[0]%","% $key[0]%","%($key[0])%"); - while ($i<$count){ - $query.=" and (subject like ? or subject like ? or subject like ?)"; - push(@bind,"$key[$i]%","% $key[$i]%","%($key[$i])%"); - $i++; - } - - # FIXME - Wouldn't it be better to fix the database so that if a - # book has a subject "NZ", then it also gets added the subject - # "New Zealand"? - # This can also be generalized by adding a table of subject - # synonyms to the database: just declare "NZ" to be a synonym for - # "New Zealand", "SF" a synonym for both "Science fiction" and - # "Fantastic fiction", etc. - - if (lc($search->{'subject'}) eq 'nz'){ - $query.= " or (subject like 'NEW ZEALAND %' or subject like '% NEW ZEALAND %' - or subject like '% NEW ZEALAND' or subject like '%(NEW ZEALAND)%' ) "; - } elsif ( $search->{'subject'} =~ /^nz /i || $search->{'subject'} =~ / nz /i || $search->{'subject'} =~ / nz$/i){ - $query=~ s/ nz/ NEW ZEALAND/ig; - $query=~ s/nz /NEW ZEALAND /ig; - $query=~ s/\(nz\)/\(NEW ZEALAND\)/gi; - } - } - if ($type eq 'precise'){ - if ($search->{'itemnumber'} ne ''){ - $query="select * from items,biblio "; - my $search2=uc $search->{'itemnumber'}; - $query=$query." where - items.biblionumber=biblio.biblionumber - and barcode=?"; - @bind=($search2); - # FIXME - .= <{'isbn'} ne ''){ - $query = "Select * from biblio,biblioitems where biblio.biblionumber - =biblioitems.biblionumber and (isbn like ?)"; - @bind=("$search->{'isbn'}%"); - } - } - if ($type ne 'precise' && $type ne 'subject'){ - if ($search->{'author'} ne ''){ - $query .= " order by biblio.author,title"; - } else { - $query .= " order by title"; - } - } else { - if ($type eq 'subject'){ - $query .= " group by subject "; - } - } - my $sth=$dbh->prepare($query); - $sth->execute(@bind); - my $count=1; - my $i=0; - my $limit= $num+$offset; - while (my $data=$sth->fetchrow_hashref){ - my $query="select classification,dewey,subclass,publishercode from biblioitems where biblionumber=?"; - my @bind=($data->{'biblionumber'}); - if ($search->{'class'} ne ''){ - my @temp=split(/\|/,$search->{'class'}); - my $count=@temp; - $query.= " and ( itemtype= ?"; - push(@bind,$temp[0]); - for (my $i=1;$i<$count;$i++){ - $query.=" or itemtype=?"; - push(@bind,$temp[$i]); - } - $query.=")"; - } - if ($search->{'dewey'} ne ''){ - $query.=" and dewey=? "; - push(@bind,$search->{'dewey'}); - } - if ($search->{'illustrator'} ne ''){ - $query.=" and illus like ?"; - push(@bind,"%$search->{'illustrator'}%"); - } - if ($search->{'publisher'} ne ''){ - $query.= " and (publishercode like ?)"; - push(@bind,"%$search->{'publisher'}%"); - } - my $sti=$dbh->prepare($query); - $sti->execute(@bind); - my $classification; - my $dewey; - my $subclass; - my $true=0; - my $publishercode; - my $bibitemdata; - if ($bibitemdata = $sti->fetchrow_hashref()){ - $true=1; - $classification=$bibitemdata->{'classification'}; - $dewey=$bibitemdata->{'dewey'}; - $subclass=$bibitemdata->{'subclass'}; - $publishercode=$bibitemdata->{'publishercode'}; - } - # print STDERR "$dewey $subclass $publishercode\n"; - # FIXME - The Dewey code is a string, not a number. - $dewey=~s/\.*0*$//; - ($dewey == 0) && ($dewey=''); - ($dewey) && ($dewey.=" $subclass"); - $data->{'classification'}=$classification; - $data->{'dewey'}=$dewey; - $data->{'publishercode'}=$publishercode; - $sti->finish; - if ($true == 1){ - if ($count > $offset && $count <= $limit){ - $results[$i]=$data; - $i++; - } - $count++; - } - } - $sth->finish; - $count--; - return($count,@results); -} - -sub updatesearchstats{ - my ($dbh,$query)=@_; - -} - -=item subsearch - - @results = &subsearch($env, $subject); - -Searches for books that have a subject that exactly matches -C<$subject>. - -C<&subsearch> returns an array of results. Each element of this array -is a string, containing the book's title, author, and biblionumber, -separated by tabs. - -C<$env> is ignored. - -=cut -#' -sub subsearch { - my ($env,$subject)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Select * from biblio,bibliosubject where - biblio.biblionumber=bibliosubject.biblionumber and - bibliosubject.subject=? group by biblio.biblionumber - order by biblio.title"); - $sth->execute($subject); - my $i=0; - my @results; - while (my $data=$sth->fetchrow_hashref){ - push @results, $data; - $i++; - } - $sth->finish; - return(@results); -} - -=item ItemInfo - - @results = &ItemInfo($env, $biblionumber, $type); - -Returns information about books with the given biblionumber. - -C<$type> may be either C or anything else. If it is not set to -C, then the search will exclude lost, very overdue, and -withdrawn items. - -C<$env> is ignored. - -C<&ItemInfo> returns a list of references-to-hash. Each element -contains a number of keys. Most of them are table items from the -C, C, C, and C tables in the -Koha database. Other keys include: - -=over 4 - -=item C<$data-E{branchname}> - -The name (not the code) of the branch to which the book belongs. - -=item C<$data-E{datelastseen}> - -This is simply C, except that while the date is -stored in YYYY-MM-DD format in the database, here it is converted to -DD/MM/YYYY format. A NULL date is returned as C. - -=item C<$data-E{datedue}> - -=item C<$data-E{class}> - -This is the concatenation of C, the book's -Dewey code, and C. - -=item C<$data-E{ocount}> - -I think this is the number of copies of the book available. - -=item C<$data-E{order}> - -If this is set, it is set to C. - -=back - -=cut -#' -sub ItemInfo { - my ($env,$biblionumber,$type) = @_; - my $dbh = C4::Context->dbh; - my $query = "SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems - left join itemtypes on biblioitems.itemtype = itemtypes.itemtype - WHERE items.biblionumber = ? - AND biblioitems.biblioitemnumber = items.biblioitemnumber - AND biblio.biblionumber = items.biblionumber"; - $query .= " order by items.dateaccessioned desc"; - my $sth=$dbh->prepare($query); - $sth->execute($biblionumber); - my $i=0; - my @results; -my ($date_due, $count_reserves); - while (my $data=$sth->fetchrow_hashref){ - my $datedue = ''; - my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber"); - $isth->execute($data->{'itemnumber'}); - if (my $idata=$isth->fetchrow_hashref){ - $data->{borrowernumber} = $idata->{borrowernumber}; - $data->{cardnumber} = $idata->{cardnumber}; - $datedue = format_date($idata->{'date_due'}); - } - if ($datedue eq ''){ - # $datedue="Available"; - my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'}); - if ($restype) { -# $datedue=$restype; - $count_reserves = $restype; - } - } - $isth->finish; - #get branch information..... - my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?"); - $bsth->execute($data->{'holdingbranch'}); - if (my $bdata=$bsth->fetchrow_hashref){ - $data->{'branchname'} = $bdata->{'branchname'}; - } - my $date=format_date($data->{'datelastseen'}); - $data->{'datelastseen'}=$date; - $data->{'datedue'}=$datedue; - $data->{'count_reserves'} = $count_reserves; - # get notforloan complete status if applicable - my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"'); - $sthnflstatus->execute; - my ($authorised_valuecode) = $sthnflstatus->fetchrow; - if ($authorised_valuecode) { - $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?"); - $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan}); - my ($lib) = $sthnflstatus->fetchrow; - $data->{notforloan} = $lib; - } - -# my stack procedures - - my $stackstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.stack"'); - $stackstatus->execute; - - ($authorised_valuecode) = $stackstatus->fetchrow; - if ($authorised_valuecode) { - $stackstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?"); - $stackstatus->execute($authorised_valuecode,$data->{stack}); - - my ($lib) = $stackstatus->fetchrow; - $data->{stack} = $lib; - } - $results[$i]=$data; - $i++; - } - $sth->finish; - - return(@results); -} - -=item GetItems - - @results = &GetItems($env, $biblionumber); - -Returns information about books with the given biblionumber. - -C<$env> is ignored. - -C<&GetItems> returns an array of strings. Each element is a -tab-separated list of values: biblioitemnumber, itemtype, -classification, Dewey number, subclass, ISBN, volume, number, and -itemdata. - -Itemdata, in turn, is a string of the form -"IC<[>IC<[>I" where I contains -the string C if the item is not for loan, and C if the item -is lost. - -=cut -#' -sub GetItems { - my ($env,$biblionumber)=@_; - #debug_msg($env,"GetItems"); - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Select * from biblioitems where (biblionumber = ?)"); - $sth->execute($biblionumber); - #debug_msg($env,"executed query"); - my $i=0; - my @results; - while (my $data=$sth->fetchrow_hashref) { - print ($env,$data->{'biblioitemnumber'}); - my $dewey = $data->{'dewey'}; - $dewey =~ s/0+$//; - my $isbn= $data->{'isbn'}; - - - my $line = $data->{'biblioitemnumber'}."\t".$data->{'itemtype'}; - $line .= "\t$data->{'classification'}\t$dewey"; - $line .= "\t$data->{'subclass'}\t$data->{'isbn'}"; - $line .= "\t$data->{'volume'}\t$data->{number}"; - my $isth= $dbh->prepare("select * from items where biblioitemnumber = ?"); - $isth->execute($data->{'biblioitemnumber'}); - while (my $idata = $isth->fetchrow_hashref) { - my $iline = $idata->{'barcode'}."[".$idata->{'holdingbranch'}."["; - if ($idata->{'notforloan'} == 1) { - $iline .= "NFL "; - } - if ($idata->{'itemlost'} == 1) { - $iline .= "LOST "; - } - $line .= "\t$iline"; - } - $isth->finish; - $results[$i] = $line; - $i++; - } - $sth->finish; - return(@results); -} - -=item itemdata - - $item = &itemdata($barcode); - -Looks up the item with the given barcode, and returns a -reference-to-hash containing information about that item. The keys of -the hash are the fields from the C and C tables in -the Koha database. - -=cut -#' -sub itemdata { - my ($barcode)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Select * from items,biblioitems where barcode=? - and items.biblioitemnumber=biblioitems.biblioitemnumber"); - $sth->execute($barcode); - my $data=$sth->fetchrow_hashref; - $sth->finish; - return($data); -} - -=item bibdata - - $data = &bibdata($biblionumber, $type); - -Returns information about the book with the given biblionumber. - -C<$type> is ignored. - -C<&bibdata> returns a reference-to-hash. The keys are the fields in -the C, C, and C tables in the -Koha database. - -In addition, C<$data-E{subject}> is the list of the book's -subjects, separated by C<" , "> (space, comma, space). - -If there are multiple biblioitems with the given biblionumber, only -the first one is considered. - -=cut -#' -sub bibdata { - my ($bibnum, $type) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select *, biblioitems.notes AS bnotes, biblio.notes - from biblio, biblioitems - left join bibliosubtitle on - biblio.biblionumber = bibliosubtitle.biblionumber - left join itemtypes on biblioitems.itemtype=itemtypes.itemtype - where biblio.biblionumber = ? - and biblioitems.biblionumber = biblio.biblionumber"); - $sth->execute($bibnum); - my $data; - $data = $sth->fetchrow_hashref; - $sth->finish; - # handle management of repeated subtitle - $sth = $dbh->prepare("Select * from bibliosubtitle where biblionumber = ?"); - $sth->execute($bibnum); - my @subtitles; - while (my $dat = $sth->fetchrow_hashref){ - my %line; - $line{subtitle} = $dat->{subtitle}; - push @subtitles, \%line; - } # while - $data->{subtitles} = \@subtitles; - $sth->finish; - $sth = $dbh->prepare("Select * from bibliosubject where biblionumber = ?"); - $sth->execute($bibnum); - my @subjects; - while (my $dat = $sth->fetchrow_hashref){ - my %line; - $line{subject} = $dat->{'subject'}; - push @subjects, \%line; - } # while - $data->{subjects} = \@subjects; - $sth->finish; - $sth = $dbh->prepare("Select * from additionalauthors where biblionumber = ?"); - $sth->execute($bibnum); - while (my $dat = $sth->fetchrow_hashref){ - $data->{'additionalauthors'} .= "$dat->{'author'} - "; - } # while - chop $data->{'additionalauthors'}; - chop $data->{'additionalauthors'}; - chop $data->{'additionalauthors'}; - $sth->finish; - return($data); -} # sub bibdata - -=item bibitemdata - - $itemdata = &bibitemdata($biblioitemnumber); - -Looks up the biblioitem with the given biblioitemnumber. Returns a -reference-to-hash. The keys are the fields from the C, -C, and C tables in the Koha database, except -that C is given as C<$itemdata-E{bnotes}>. - -=cut -#' -sub bibitemdata { - my ($bibitem) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select *,biblioitems.notes as bnotes from biblio, biblioitems,itemtypes where biblio.biblionumber = biblioitems.biblionumber and biblioitemnumber = ? and biblioitems.itemtype = itemtypes.itemtype"); - my $data; - - $sth->execute($bibitem); - - $data = $sth->fetchrow_hashref; - - $sth->finish; - return($data); -} # sub bibitemdata - -=item subject - - ($count, $subjects) = &subject($biblionumber); - -Looks up the subjects of the book with the given biblionumber. Returns -a two-element list. C<$subjects> is a reference-to-array, where each -element is a subject of the book, and C<$count> is the number of -elements in C<$subjects>. - -=cut -#' -sub subject { - my ($bibnum)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Select * from bibliosubject where biblionumber=?"); - $sth->execute($bibnum); - my @results; - my $i=0; - while (my $data=$sth->fetchrow_hashref){ - $results[$i]=$data; - $i++; - } - $sth->finish; - return($i,\@results); -} - -=item addauthor - - ($count, $authors) = &addauthors($biblionumber); - -Looks up the additional authors for the book with the given -biblionumber. - -Returns a two-element list. C<$authors> is a reference-to-array, where -each element is an additional author, and C<$count> is the number of -elements in C<$authors>. - -=cut -#' -sub addauthor { - my ($bibnum)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Select * from additionalauthors where biblionumber=?"); - $sth->execute($bibnum); - my @results; - my $i=0; - while (my $data=$sth->fetchrow_hashref){ - $results[$i]=$data; - $i++; - } - $sth->finish; - return($i,\@results); -} - -=item subtitle - - ($count, $subtitles) = &subtitle($biblionumber); - -Looks up the subtitles for the book with the given biblionumber. - -Returns a two-element list. C<$subtitles> is a reference-to-array, -where each element is a subtitle, and C<$count> is the number of -elements in C<$subtitles>. - -=cut -#' -sub subtitle { - my ($bibnum)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Select * from bibliosubtitle where biblionumber=?"); - $sth->execute($bibnum); - my @results; - my $i=0; - while (my $data=$sth->fetchrow_hashref){ - $results[$i]=$data; - $i++; - } - $sth->finish; - return($i,\@results); -} - -=item itemissues - - @issues = &itemissues($biblioitemnumber, $biblio); - -Looks up information about who has borrowed the bookZ<>(s) with the -given biblioitemnumber. - -C<$biblio> is ignored. - -C<&itemissues> returns an array of references-to-hash. The keys -include the fields from the C table in the Koha database. -Additional keys include: - -=over 4 - -=item C - -If the item is currently on loan, this gives the due date. - -If the item is not on loan, then this is either "Available" or -"Cancelled", if the item has been withdrawn. - -=item C - -If the item is currently on loan, this gives the card number of the -patron who currently has the item. - -=item C, C, C - -These give the timestamp for the last three times the item was -borrowed. - -=item C, C, C - -The card number of the last three patrons who borrowed this item. - -=item C, C, C - -The borrower number of the last three patrons who borrowed this item. - -=back - -=cut -#' -sub itemissues { - my ($bibitem, $biblio)=@_; - my $dbh = C4::Context->dbh; - # FIXME - If this function die()s, the script will abort, and the - # user won't get anything; depending on how far the script has - # gotten, the user might get a blank page. It would be much better - # to at least print an error message. The easiest way to do this - # is to set $SIG{__DIE__}. - my $sth = $dbh->prepare("Select * from items where -items.biblioitemnumber = ?") - || die $dbh->errstr; - my $i = 0; - my @results; - - $sth->execute($bibitem) - || die $sth->errstr; - - while (my $data = $sth->fetchrow_hashref) { - # Find out who currently has this item. - # FIXME - Wouldn't it be better to do this as a left join of - # some sort? Currently, this code assumes that if - # fetchrow_hashref() fails, then the book is on the shelf. - # fetchrow_hashref() can fail for any number of reasons (e.g., - # database server crash), not just because no items match the - # search criteria. - my $sth2 = $dbh->prepare("select * from issues,borrowers -where itemnumber = ? -and returndate is NULL -and issues.borrowernumber = borrowers.borrowernumber"); - - $sth2->execute($data->{'itemnumber'}); - if (my $data2 = $sth2->fetchrow_hashref) { - $data->{'date_due'} = $data2->{'date_due'}; - $data->{'card'} = $data2->{'cardnumber'}; - $data->{'borrower'} = $data2->{'borrowernumber'}; - } else { - if ($data->{'wthdrawn'} eq '1') { - $data->{'date_due'} = 'Cancelled'; - } else { - $data->{'date_due'} = 'Available'; - } # else - } # else - - $sth2->finish; - - # Find the last 3 people who borrowed this item. - $sth2 = $dbh->prepare("select * from issues, borrowers - where itemnumber = ? - and issues.borrowernumber = borrowers.borrowernumber - and returndate is not NULL - order by returndate desc,timestamp desc") ; - $sth2->execute($data->{'itemnumber'}) ; - for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item - if (my $data2 = $sth2->fetchrow_hashref) { - $data->{"timestamp$i2"} = $data2->{'timestamp'}; - $data->{"card$i2"} = $data2->{'cardnumber'}; - $data->{"borrower$i2"} = $data2->{'borrowernumber'}; - } # if - } # for - - $sth2->finish; - $results[$i] = $data; - $i++; - } - - $sth->finish; - return(@results); -} - -=item itemnodata - - $item = &itemnodata($env, $dbh, $biblioitemnumber); - -Looks up the item with the given biblioitemnumber. - -C<$env> and C<$dbh> are ignored. - -C<&itemnodata> returns a reference-to-hash whose keys are the fields -from the C, C, and C tables in the Koha -database. - -=cut -#' -sub itemnodata { - my ($env,$dbh,$itemnumber) = @_; - $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Select * from biblio,items,biblioitems - where items.itemnumber = ? - and biblio.biblionumber = items.biblionumber - and biblioitems.biblioitemnumber = items.biblioitemnumber"); -# print $query; - $sth->execute($itemnumber); - my $data=$sth->fetchrow_hashref; - $sth->finish; - return($data); -} - -=item BornameSearch - - ($count, $borrowers) = &BornameSearch($env, $searchstring, $type); - -Looks up patrons (borrowers) by name. - -C<$env> is ignored. - -BUGFIX 499: C<$type> is now used to determine type of search. -if $type is "simple", search is performed on the first letter of the -surname only. - -C<$searchstring> is a space-separated list of search terms. Each term -must match the beginning a borrower's surname, first name, or other -name. - -C<&BornameSearch> returns a two-element list. C<$borrowers> is a -reference-to-array; each element is a reference-to-hash, whose keys -are the fields of the C table in the Koha database. -C<$count> is the number of elements in C<$borrowers>. - -=cut -#' -#used by member enquiries from the intranet -#called by member.pl -sub BornameSearch { - my ($env,$searchstring,$orderby,$type)=@_; - my $dbh = C4::Context->dbh; - my $query = ""; my $count; my @data; - my @bind=(); - - if($type eq "simple") # simple search for one letter only - { - $query="Select * from borrowers where surname like '$searchstring%' order by $orderby"; -# @bind=("$searchstring%"); - } - else # advanced search looking in surname, firstname and othernames - { -### Try to determine whether numeric like cardnumber - if ($searchstring+1>1) { - $query="Select * from borrowers where cardnumber like '$searchstring%' "; - - }else{ - - my @words=split / /,$searchstring; - foreach my $word(@words){ - $word="+".$word; - - } - $searchstring=join " ",@words; - - $query="Select * from borrowers where MATCH(surname,firstname,othernames) AGAINST('$searchstring' in boolean mode)"; - - } - $query=$query." order by $orderby"; - } - - my $sth=$dbh->prepare($query); -# warn "Q $orderby : $query"; - $sth->execute(); - my @results; - my $cnt=$sth->rows; - while (my $data=$sth->fetchrow_hashref){ - push(@results,$data); - } - # $sth->execute; - $sth->finish; - return ($cnt,\@results); -} - -=item borrdata - - $borrower = &borrdata($cardnumber, $borrowernumber); - -Looks up information about a patron (borrower) by either card number -or borrower number. If $borrowernumber is specified, C<&borrdata> -searches by borrower number; otherwise, it searches by card number. - -C<&borrdata> returns a reference-to-hash whose keys are the fields of -the C table in the Koha database. - -=cut -#' -sub borrdata { - my ($cardnumber,$bornum)=@_; - $cardnumber = uc $cardnumber; - my $dbh = C4::Context->dbh; - my $sth; -if ($bornum eq ''&& $cardnumber eq ''){ return undef; } - if ($bornum eq ''){ - $sth=$dbh->prepare("Select * from borrowers where cardnumber=?"); - $sth->execute($cardnumber); - } else { - $sth=$dbh->prepare("Select * from borrowers where borrowernumber=?"); - $sth->execute($bornum); - } - my $data=$sth->fetchrow_hashref; - $sth->finish; - if ($data) { - return($data); - } else { # try with firstname - if ($cardnumber) { - my $sth=$dbh->prepare("select * from borrowers where firstname=?"); - $sth->execute($cardnumber); - my $data=$sth->fetchrow_hashref; - $sth->finish; - return($data); - } - } - return undef; -} - -=item borrissues - - ($count, $issues) = &borrissues($borrowernumber); - -Looks up what the patron with the given borrowernumber has borrowed. - -C<&borrissues> returns a two-element array. C<$issues> is a -reference-to-array, where each element is a reference-to-hash; the -keys are the fields from the C, C, and C tables -in the Koha database. C<$count> is the number of elements in -C<$issues>. - -=cut -#' -sub borrissues { - my ($bornum)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Select * from issues,biblio,items where borrowernumber=? - and items.itemnumber=issues.itemnumber - and items.biblionumber=biblio.biblionumber - and issues.returndate is NULL order by date_due"); - $sth->execute($bornum); - my @result; - while (my $data = $sth->fetchrow_hashref) { - push @result, $data; - } - $sth->finish; - return(scalar(@result), \@result); -} - -=item allissues - - ($count, $issues) = &allissues($borrowernumber, $sortkey, $limit); - -Looks up what the patron with the given borrowernumber has borrowed, -and sorts the results. - -C<$sortkey> is the name of a field on which to sort the results. This -should be the name of a field in the C, C, -C, or C table in the Koha database. - -C<$limit> is the maximum number of results to return. - -C<&allissues> returns a two-element array. C<$issues> is a -reference-to-array, where each element is a reference-to-hash; the -keys are the fields from the C, C, C, and -C tables of the Koha database. C<$count> is the number of -elements in C<$issues> - -=cut -#' -sub allissues { - my ($bornum,$order,$limit)=@_; - #FIXME: sanity-check order and limit - my $dbh = C4::Context->dbh; - my $query="Select * from issues,biblio,items,biblioitems - where borrowernumber=? and - items.biblioitemnumber=biblioitems.biblioitemnumber and - items.itemnumber=issues.itemnumber and - items.biblionumber=biblio.biblionumber order by $order"; - if ($limit !=0){ - $query.=" limit $limit"; - } - #print $query; - my $sth=$dbh->prepare($query); - $sth->execute($bornum); - my @result; - my $i=0; - while (my $data=$sth->fetchrow_hashref){ - $result[$i]=$data;; - $i++; - } - $sth->finish; - return($i,\@result); -} - -=item borrdata2 - - ($borrowed, $due, $fine) = &borrdata2($env, $borrowernumber); - -Returns aggregate data about items borrowed by the patron with the -given borrowernumber. - -C<$env> is ignored. - -C<&borrdata2> returns a three-element array. C<$borrowed> is the -number of books the patron currently has borrowed. C<$due> is the -number of overdue items the patron currently has borrowed. C<$fine> is -the total fine currently due by the borrower. - -=cut -#' -sub borrdata2 { - my ($env,$bornum)=@_; - my $dbh = C4::Context->dbh; - my $query="Select count(*) from issues where borrowernumber='$bornum' and - returndate is NULL"; - # print $query; - my $sth=$dbh->prepare($query); - $sth->execute; - my $data=$sth->fetchrow_hashref; - $sth->finish; - $sth=$dbh->prepare("Select count(*) from issues where - borrowernumber='$bornum' and date_due < now() and returndate is NULL"); - $sth->execute; - my $data2=$sth->fetchrow_hashref; - $sth->finish; - $sth=$dbh->prepare("Select sum(amountoutstanding) from accountlines where - borrowernumber='$bornum'"); - $sth->execute; - my $data3=$sth->fetchrow_hashref; - $sth->finish; - -return($data2->{'count(*)'},$data->{'count(*)'},$data3->{'sum(amountoutstanding)'}); -} - -sub borrdata3 { - my ($env,$bornum)=@_; - my $dbh = C4::Context->dbh; - my $query="Select count(*) from reserveissue as r where r.borrowernumber='$bornum' - and rettime is null"; - # print $query; - my $sth=$dbh->prepare($query); - $sth->execute; - my $data=$sth->fetchrow_hashref; - $sth->finish; - $sth=$dbh->prepare("Select count(*),timediff(now(), duetime ) as elapsed, hour(timediff(now(), duetime )) as hours, MINUTE(timediff(now(), duetime )) as min from - reserveissue as r where r.borrowernumber='$bornum' and rettime is null and duetime< now() group by r.borrowernumber"); - $sth->execute; - - my $data2=$sth->fetchrow_hashref; -my $resfine; -my $rescharge=C4::Context->preference('resmaterialcharge'); -if (!$rescharge){ -$rescharge=1; -} -if ($data2->{'elapsed'}>0){ - $resfine=($data2->{'hours'}+$data2->{'min'}/60)*$rescharge; -$resfine=sprintf ("%.1f",$resfine); -} - $sth->finish; - $sth=$dbh->prepare("Select sum(amountoutstanding) from accountlines where - borrowernumber='$bornum'"); - $sth->execute; - my $data3=$sth->fetchrow_hashref; - $sth->finish; - - -return($data2->{'count(*)'},$data->{'count(*)'},$data3->{'sum(amountoutstanding)'},$resfine); -} -=item getboracctrecord - - ($count, $acctlines, $total) = &getboracctrecord($env, $borrowernumber); - -Looks up accounting data for the patron with the given borrowernumber. - -C<$env> is ignored. - -(FIXME - I'm not at all sure what this is about.) - -C<&getboracctrecord> returns a three-element array. C<$acctlines> is a -reference-to-array, where each element is a reference-to-hash; the -keys are the fields of the C table in the Koha database. -C<$count> is the number of elements in C<$acctlines>. C<$total> is the -total amount outstanding for all of the account lines. - -=cut -#' -sub getboracctrecord { - my ($env,$params) = @_; - my $dbh = C4::Context->dbh; - my @acctlines; - my $numlines=0; - my $sth=$dbh->prepare("Select * from accountlines where -borrowernumber=? order by date desc,timestamp desc"); -# print $query; - $sth->execute($params->{'borrowernumber'}); - my $total=0; - while (my $data=$sth->fetchrow_hashref){ - #FIXME before reinstating: insecure? -# if ($data->{'itemnumber'} ne ''){ -# $query="Select * from items,biblio where items.itemnumber= -# '$data->{'itemnumber'}' and biblio.biblionumber=items.biblionumber"; -# my $sth2=$dbh->prepare($query); -# $sth2->execute; -# my $data2=$sth2->fetchrow_hashref; -# $sth2->finish; -# $data=$data2; - # } - $acctlines[$numlines] = $data; - $numlines++; - $total += $data->{'amountoutstanding'}; - } - $sth->finish; - return ($numlines,\@acctlines,$total); -} - -=item itemcount - - ($count, $lcount, $nacount, $fcount, $scount, $lostcount, - $mending, $transit,$ocount) = - &itemcount($env, $biblionumber, $type); - -Counts the number of items with the given biblionumber, broken down by -category. - -C<$env> is ignored. - -If C<$type> is not set to C, lost, very overdue, and withdrawn -items will not be counted. - -C<&itemcount> returns a nine-element list: - -C<$count> is the total number of items with the given biblionumber. - -C<$lcount> is the number of items at the Levin branch. - -C<$nacount> is the number of items that are neither borrowed, lost, -nor withdrawn (and are therefore presumably on a shelf somewhere). - -C<$fcount> is the number of items at the Foxton branch. - -C<$scount> is the number of items at the Shannon branch. - -C<$lostcount> is the number of lost and very overdue items. - -C<$mending> is the number of items at the Mending branch (being -mended?). - -C<$transit> is the number of items at the Transit branch (in transit -between branches?). - -C<$ocount> is the number of items that haven't arrived yet -(aqorders.quantity - aqorders.quantityreceived). - -=cut -#' - -# FIXME - There's also a &C4::Biblio::itemcount. -# Since they're all exported, acqui/acquire.pl doesn't compile with -w. -sub itemcount { - my ($env,$bibnum,$type)=@_; - my $dbh = C4::Context->dbh; - my $query="Select * from items where - biblionumber=? "; - if ($type ne 'intra'){ - $query.=" and ((itemlost <>1 and itemlost <> 2) or itemlost is NULL) and - (wthdrawn <> 1 or wthdrawn is NULL)"; - } - my $sth=$dbh->prepare($query); - # print $query; - $sth->execute($bibnum); - my $count=0; - my $lcount=0; - my $nacount=0; - my $fcount=0; - my $scount=0; - my $lostcount=0; - my $mending=0; - my $transit=0; - my $ocount=0; - while (my $data=$sth->fetchrow_hashref){ - $count++; - - my $sth2=$dbh->prepare("select * from issues,items where issues.itemnumber= - ? and returndate is NULL - and items.itemnumber=issues.itemnumber and ((items.itemlost <>1 and - items.itemlost <> 2) or items.itemlost is NULL) - and (wthdrawn <> 1 or wthdrawn is NULL)"); - $sth2->execute($data->{'itemnumber'}); - if (my $data2=$sth2->fetchrow_hashref){ - $nacount++; - } else { - if ($data->{'holdingbranch'} eq 'C' || $data->{'holdingbranch'} eq 'LT'){ - $lcount++; - } - if ($data->{'holdingbranch'} eq 'F' || $data->{'holdingbranch'} eq 'FP'){ - $fcount++; - } - if ($data->{'holdingbranch'} eq 'S' || $data->{'holdingbranch'} eq 'SP'){ - $scount++; - } - if ($data->{'itemlost'} eq '1'){ - $lostcount++; - } - if ($data->{'itemlost'} eq '2'){ - $lostcount++; - } - if ($data->{'holdingbranch'} eq 'FM'){ - $mending++; - } - if ($data->{'holdingbranch'} eq 'TR'){ - $transit++; - } - } - $sth2->finish; - } -# if ($count == 0){ - my $sth2=$dbh->prepare("Select * from aqorders where biblionumber=?"); - $sth2->execute($bibnum); - if (my $data=$sth2->fetchrow_hashref){ - $ocount=$data->{'quantity'} - $data->{'quantityreceived'}; - } -# $count+=$ocount; - $sth2->finish; - $sth->finish; - return ($count,$lcount,$nacount,$fcount,$scount,$lostcount,$mending,$transit,$ocount); -} - -=item itemcount2 - - $counts = &itemcount2($env, $biblionumber, $type); - -Counts the number of items with the given biblionumber, broken down by -category. - -C<$env> is ignored. - -C<$type> may be either C or anything else. If it is not set to -C, then the search will exclude lost, very overdue, and -withdrawn items. - -C<$&itemcount2> returns a reference-to-hash, with the following fields: - -=over 4 - -=item C - -The total number of items with this biblionumber. - -=item C - -The number of items on order (aqorders.quantity - -aqorders.quantityreceived). - -=item I - -For each branch that has at least one copy of the book, C<$counts> -will have a key with the branch name, giving the number of copies at -that branch. - -=back + $isth->finish; + #get branch information..... + my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?"); + $bsth->execute($data->{'holdingbranch'}); + if (my $bdata=$bsth->fetchrow_hashref){ + $data->{'branchname'} = $bdata->{'branchname'}; + } + my $date=substr($data->{'datelastseen'},0,8); + $data->{'datelastseen'}=format_date($date); + $data->{'datedue'}=$datedue; + $data->{'count_reserves'} = $count_reserves; + # get notforloan complete status if applicable + my ($tagfield,$tagsub)=MARCfind_marc_from_kohafield("notforloan","holdings"); + my $sthnflstatus = $dbh->prepare("select authorised_value from holdings_subfield_structure where tagfield='$tagfield' and tagsubfield='$tagsub'"); + $sthnflstatus->execute; + my ($authorised_valuecode) = $sthnflstatus->fetchrow; + if ($authorised_valuecode) { + $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?"); + $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan}); + my ($lib) = $sthnflstatus->fetchrow; + $data->{notforloan} = $lib; + } -=cut -#' -sub itemcount2 { - my ($env,$bibnum,$type)=@_; - my $dbh = C4::Context->dbh; - my $query="Select * from items,branches where - biblionumber=? and items.holdingbranch=branches.branchcode"; - if ($type ne 'intra'){ - $query.=" and ((itemlost <>1 and itemlost <> 2) or itemlost is NULL) and - (wthdrawn <> 1 or wthdrawn is NULL)"; - } - my $sth=$dbh->prepare($query); - # print $query; - $sth->execute($bibnum); - my %counts; - $counts{'total'}=0; - while (my $data=$sth->fetchrow_hashref){ - $counts{'total'}++; - my $status; - for my $test ( - [ - 'Item Lost', - 'select * from items - where itemnumber=? - and not ((items.itemlost <>1 and items.itemlost <> 2) - or items.itemlost is NULL)' - ], [ - 'Withdrawn', - 'select * from items - where itemnumber=? and not (wthdrawn <> 1 or wthdrawn is NULL)' - ], [ - 'On Loan', "select * from issues,items - where issues.itemnumber=? and returndate is NULL - and items.itemnumber=issues.itemnumber" - ], - ) { - my($testlabel, $query2) = @$test; - - my $sth2=$dbh->prepare($query2); - $sth2->execute($data->{'itemnumber'}); - - # FIXME - fetchrow_hashref() can fail for any number of reasons - # (e.g., a database server crash). Perhaps use a left join of some - # sort for this? - $status = $testlabel if $sth2->fetchrow_hashref; - $sth2->finish; - last if defined $status; - } -## find the shelving name from stack -my $stackstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.stack"'); - $stackstatus->execute; +# my shelf procedures + my ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("shelf","holdings"); - my ($authorised_valuecode) = $stackstatus->fetchrow; + my $shelfstatus = $dbh->prepare("select authorised_value from holdings_subfield_structure where tagfield='$tagfield' and tagsubfield='$tagsubfield'"); +$shelfstatus->execute; + $authorised_valuecode = $shelfstatus->fetchrow; if ($authorised_valuecode) { - $stackstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?"); - $stackstatus->execute($authorised_valuecode,$data->{stack}); + $shelfstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?"); + $shelfstatus->execute($authorised_valuecode,$data->{shelf}); - my ($lib) = $stackstatus->fetchrow; - $data->{stack} = $lib; + my ($lib) = $shelfstatus->fetchrow; + $data->{shelf} = $lib; } - + - $status = $data->{'branchname'}."[".$data->{'stack'}."]" unless defined $status; - $counts{$status}++; - - } - my $sth2=$dbh->prepare("Select * from aqorders where biblionumber=? and - datecancellationprinted is NULL and quantity > quantityreceived"); - $sth2->execute($bibnum); - if (my $data=$sth2->fetchrow_hashref){ - $counts{'order'}=$data->{'quantity'} - $data->{'quantityreceived'}; - } - $sth2->finish; - $sth->finish; - return (\%counts); -} - -=item ItemType - - $description = &ItemType($itemtype); - -Given an item type code, returns the description for that type. - -=cut -#' -# FIXME - I'm pretty sure that after the initial setup, the list of -# item types doesn't change very often. Hence, it seems slow and -# inefficient to make yet another database call to look up information -# that'll only change every few months or years. -# -# Much better, I think, to automatically build a Perl file that can be -# included in those scripts that require it, e.g.: -# @itemtypes = qw( ART BCD CAS CD F ... ); -# %itemtypedesc = ( -# ART => "Art Prints", -# BCD => "CD-ROM from book", -# CD => "Compact disc (WN)", -# F => "Free Fiction", -# ... -# ); -# The web server can then run a cron job to rebuild this file from the -# database every hour or so. -# -# The same thing goes for branches, book funds, book sellers, currency -# rates, printers, stopwords, and perhaps others. -sub ItemType { - my ($type)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("select description from itemtypes where itemtype=?"); - $sth->execute($type); - my $dat=$sth->fetchrow_hashref; - $sth->finish; - return ($dat->{'description'}); + return($data); } -=item bibitems - - ($count, @results) = &bibitems($biblionumber); -Given the biblionumber for a book, C<&bibitems> looks up that book's -biblioitems (different publications of the same book, the audio book -and film versions, etc.). -C<$count> is the number of elements in C<@results>. -C<@results> is an array of references-to-hash; the keys are the fields -of the C and C tables of the Koha database. In -addition, C indicates the availability of the item: if it is -"2", then all copies of the item are long overdue; if it is "1", then -all copies are lost; otherwise, there is at least one copy available. - -=cut -#' -sub bibitems { - my ($bibnum) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("SELECT biblioitems.*, - itemtypes.*, - MIN(items.itemlost) as itemlost, - MIN(items.dateaccessioned) as dateaccessioned - FROM biblioitems, itemtypes, items - WHERE biblioitems.biblionumber = ? - AND biblioitems.itemtype = itemtypes.itemtype - AND biblioitems.biblioitemnumber = items.biblioitemnumber - GROUP BY items.biblioitemnumber"); - my $count = 0; - my @results; - $sth->execute($bibnum); - while (my $data = $sth->fetchrow_hashref) { - $results[$count] = $data; - $count++; - } # while - $sth->finish; - return($count, @results); -} # sub bibitems =item barcodes @@ -3801,192 +483,33 @@ The returned items include very overdue items, but not lost ones. =cut #' sub barcodes{ - #called from request.pl - my ($biblioitemnumber)=@_; + #called from request.pl + my ($biblionumber)=@_; +warn $biblionumber; my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch,onloan,itemnumber FROM items - WHERE biblioitemnumber = ? - AND (wthdrawn <> 1 OR wthdrawn IS NULL)"); - $sth->execute($biblioitemnumber); - my @barcodes; - my $i=0; - while (my $data=$sth->fetchrow_hashref){ - $barcodes[$i]=$data; - $i++; - } - $sth->finish; - return(@barcodes); + my @kohafields; + my @values; + my @relations; + my $sort; + my @and_or; + my @fields; + push @kohafields, "biblionumber"; + push @values,$biblionumber; + push @relations, " "," \@attr 2=1"; ## selecting wthdrawn less then 1 + push @and_or, "\@and"; + $sort=""; + my ($count,@results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations,$sort,\@and_or,"",""); +push @fields,"barcode","itemlost","itemnumber","date_due","wthdrawn","notforloan"; + my ($biblio,@items)=XMLmarc2koha($dbh,$results[0],"holdings", @fields); +return(@items); } -=item getwebsites - - ($count, @websites) = &getwebsites($biblionumber); - -Looks up the web sites pertaining to the book with the given -biblionumber. - -C<$count> is the number of elements in C<@websites>. - -C<@websites> is an array of references-to-hash; the keys are the -fields from the C table in the Koha database. - -=cut -#' -sub getwebsites { - my ($biblionumber) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select * from websites where biblionumber = ?"); - my $count = 0; - my @results; - - $sth->execute($biblionumber); - while (my $data = $sth->fetchrow_hashref) { - # FIXME - The URL scheme shouldn't be stripped off, at least - # not here, since it's part of the URL, and will be useful in - # constructing a link to the site. If you don't want the user - # to see the "http://" part, strip that off when building the - # HTML code. - $data->{'url'} =~ s/^http:\/\///; # FIXME - Leaning toothpick - # syndrome - $results[$count] = $data; - $count++; - } # while - - $sth->finish; - return($count, @results); -} # sub getwebsites - -=item getwebbiblioitems - - ($count, @results) = &getwebbiblioitems($biblionumber); - -Given a book's biblionumber, looks up the web versions of the book -(biblioitems with itemtype C). - -C<$count> is the number of items in C<@results>. C<@results> is an -array of references-to-hash; the keys are the items from the -C table of the Koha database. - -=cut -#' -sub getwebbiblioitems { - my ($biblionumber) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ? -and itemtype = 'WEB'"); - my $count = 0; - my @results; - - $sth->execute($biblionumber); - while (my $data = $sth->fetchrow_hashref) { - $data->{'url'} =~ s/^http:\/\///; - $results[$count] = $data; - $count++; - } # while - - $sth->finish; - return($count, @results); -} # sub getwebbiblioitems - - - -=item isbnsearch - - ($count, @results) = &isbnsearch($isbn,$title); - -Given an isbn and/or a title, returns the biblios having it. -Used in acqui.simple, isbnsearch.pl only - -C<$count> is the number of items in C<@results>. C<@results> is an -array of references-to-hash; the keys are the items from the -C table of the Koha database. - -=cut - -sub isbnsearch { - my ($isbn,$title) = @_; - my $dbh = C4::Context->dbh; - my $count = 0; - my ($query,@bind); - my $sth; - my @results; - - $query = "Select distinct biblio.*, biblioitems.classification from biblio, biblioitems where - biblio.biblionumber = biblioitems.biblionumber"; - @bind=(); - if ($isbn) { - $query .= " and isbn like ?"; - @bind=(uc($isbn)."%"); - } - if ($title) { - $query .= " and title like ?"; - @bind=($title."%"); - } - $sth = $dbh->prepare($query); - - $sth->execute(@bind); - while (my $data = $sth->fetchrow_hashref) { - $results[$count] = $data; - $count++; - } # while - - $sth->finish; - return($count, @results); -} # sub isbnsearch - -=item getbranchname - - $branchname = &getbranchname($branchcode); - -Given the branch code, the function returns the corresponding -branch name for a comprehensive information display - -=cut - -sub getbranchname -{ - my ($branchcode) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("SELECT branchname FROM branches WHERE branchcode = ?"); - $sth->execute($branchcode); - my $branchname = $sth->fetchrow(); - $sth->finish(); - return $branchname; -} # sub getbranchname - -=item getborrowercategory - - $description = &getborrowercategory($categorycode); -Given the borrower's category code, the function returns the corresponding -description for a comprehensive information display. -=cut -sub getborrowercategory -{ - my ($catcode) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("SELECT description FROM categories WHERE categorycode = ?"); - $sth->execute($catcode); - my $description = $sth->fetchrow(); - $sth->finish(); - return $description; -} # sub getborrowercategory - -sub getborrowercategoryinfo -{ - my ($catcode) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("SELECT * FROM categories WHERE categorycode = ?"); - $sth->execute($catcode); - my $category = $sth->fetchrow_hashref; - $sth->finish(); - return $category; -} # sub getborrowercategoryinfo sub getMARCnotes { - my ($dbh, $bibid, $marcflavour) = @_; + my ($dbh, $record, $marcflavour) = @_; my ($mintag, $maxtag); if ($marcflavour eq "MARC21") { $mintag = "500"; @@ -3998,7 +521,6 @@ sub getMARCnotes { - my $record=MARCgetbiblio($dbh,$bibid); my @marcnotes; my $note = ""; @@ -4008,7 +530,8 @@ sub getMARCnotes { foreach my $field ($record->field('5..')) { my $value = $field->as_string(); if ( $note ne "") { - $marcnote = {marcnote => $note,}; + + $marcnote = {marcnote => $note,}; push @marcnotes, $marcnote; $note=$value; } @@ -4018,7 +541,7 @@ sub getMARCnotes { } if ($note) { - $marcnote = {marcnote => $note}; + $marcnote = {MARCNOTE => $note}; push @marcnotes, $marcnote; #load last tag into array } @@ -4030,7 +553,8 @@ sub getMARCnotes { sub getMARCsubjects { - my ($dbh, $bibid, $marcflavour) = @_; + + my ($dbh, $record, $marcflavour) = @_; my ($mintag, $maxtag); if ($marcflavour eq "MARC21") { $mintag = "600"; @@ -4039,27 +563,26 @@ sub getMARCsubjects { $mintag = "600"; $maxtag = "619"; } - my $record=MARCgetbiblio($dbh,$bibid); my @marcsubjcts; my $subjct = ""; my $subfield = ""; my $marcsubjct; foreach my $field ($record->field('6..')) { - #my $value = $field->subfield('a'); - #$marcsubjct = {MARCSUBJCT => $value,}; - $marcsubjct = {MARCSUBJCT => $field->as_string(),}; - push @marcsubjcts, $marcsubjct; - #$subjct = $value; + my $value = $field->subfield('a'); + $marcsubjct = {MARCSUBJCT => $value,}; + push @marcsubjcts, $marcsubjct; + $subjct = $value; } my $marcsubjctsarray=\@marcsubjcts; - return $marcsubjctsarray; + return $marcsubjctsarray; } #end getMARCsubjects sub getMARCurls { - my ($dbh, $bibid, $marcflavour) = @_; +### This code is wrong only works with MARC21 + my ($dbh, $record, $marcflavour) = @_; my ($mintag, $maxtag); if ($marcflavour eq "MARC21") { $mintag = "856"; @@ -4069,19 +592,15 @@ sub getMARCurls { $maxtag = "619"; } -my $record=MARCgetbiblio($dbh,$bibid); my @marcurls; my $url = ""; my $subfil = ""; my $marcurl; - foreach my $field ($record->field('856')) { - - my $value = $field->subfield('u'); # my $subfil = $data->[1]; if ( $value ne $url) { - $marcurl = {MARCURLS => $value,}; + $marcurl = {MARCURL => $value,}; push @marcurls, $marcurl; $url = $value; } @@ -4093,452 +612,262 @@ my $record=MARCgetbiblio($dbh,$bibid); } #end getMARCurls -sub searchZOOM { - my ($search_or_scan,$type,$query,$num,$startfrom,$then_sort_by,$expanded_facet) = @_; - # establish database connections - my $dbh = C4::Context->dbh; - my $zconn=C4::Context->Zconn("biblioserver"); - my $branches = GetBranches(); - # make sure all is well with the connection - if ($zconn eq "error") { - return("error with connection",undef); #FIXME: better error handling - } - my $zoom_query_obj; +sub parsefields{ +#pass this a MARC record and it will parse it for display purposes +my ($dbh,$intranet,@marcrecords)=@_; +my @results; +my @items; +my $retrieve_from=C4::Context->preference('retrieve_from'); +#Build brancnames hash for displaying in OPAC - more user friendly +#find branchname +#get branch information..... +my %branches; + my $bsth=$dbh->prepare("SELECT branchcode,branchname FROM branches"); + $bsth->execute(); + while (my $bdata=$bsth->fetchrow_hashref){ + $branches{$bdata->{'branchcode'}}= $bdata->{'branchname'}; + } - # prepare the query depending on the type - if ($type eq 'ccl') { - #$query =~ s/(\(|\))//g; - eval { - $zoom_query_obj = new ZOOM::Query::CCL2RPN($query,$zconn); - }; - if ($@) { - return ("error: Sorry, there was a problem with your query: $@",undef); #FIXME: better error handling +#Building shelving hash if library has shelves defined like junior section, non-fiction, audio-visual room etc +my %shelves; +#find shelvingname +my ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("shelf","holdings"); +my $shelfstatus = $dbh->prepare("select authorised_value from holdings_subfield_structure where tagfield='$tagfield' and tagsubfield='$tagsubfield'"); + $shelfstatus->execute; + my ($authorised_valuecode) = $shelfstatus->fetchrow; + if ($authorised_valuecode) { + $shelfstatus = $dbh->prepare("select lib,authorised_value from authorised_values where category=? "); + $shelfstatus->execute($authorised_valuecode); + while (my $lib = $shelfstatus->fetchrow_hashref){ + $shelves{$lib->{'authorised_value'}} = $lib->{'lib'}; + } } - } elsif ($type eq 'cql') { - eval { - $zoom_query_obj = new ZOOM::Query::CQL2RPN($query,$zconn); - }; - if ($@) { - return ("error: Sorry, there was a problem with your query: $@",undef); #FIXME: better error handling - } - } else { - eval { - $zoom_query_obj = new ZOOM::Query::PQF($query); - }; - if ($@) { - return("error with search: $@",undef); #FIXME: better error handling - } - } +my $even=1; +foreach my $xmlrecord(@marcrecords){ +my $xml=XML_xml2hash($xmlrecord); +my @kohafields; ## just name those necessary for the result page +push @kohafields, "biblionumber","title","author","publishercode","classification","itemtype","copyrightdate", "holdingbranch","date_due","location","shelf","itemcallnumber","notforloan","itemlost","wthdrawn"; +my ($oldbiblio,@itemrecords) = XMLmarc2koha($dbh,$xml,"",@kohafields); +my $bibliorecord; - # PERFORM THE SEARCH OR SCAN - my $result; - my @results; - my $numresults; - if ($search_or_scan =~ /scan/) { - eval { - $result = $zconn->scan($zoom_query_obj); - }; - if ($@) { - return ("error with scan: $@",undef); - } - } else { - eval { - $result = $zconn->search($zoom_query_obj); - }; - if ($@) { - return("error with search: $@",undef); #FIXME: better error handling - } - } +my %counts; - #### RESORT RESULT SET - if ($then_sort_by) { - $result->sort("yaz", "$then_sort_by") - } - ### New Facets Stuff - my $facets_counter = (); - my $facets_info = (); - my $facets = [ { - link_value => 'su-t', - label_value => 'Subject - Topic', - tags => ['650', '651',], - subfield => 'a', - }, - { - link_value => 'au', - label_value => 'Authors', - tags => ['100','700',], - subfield => 'a', - }, - { - link_value => 'se', - label_value => 'Series', - tags => ['440','490',], - subfield => 'a', - }, - { - link_value => 'branch', - label_value => 'Branches', - tags => ['952',], - subfield => 'b', - expanded => '1', - }, - ]; - - #### INITIALIZE SOME VARS USED CREATE THE FACETED RESULTS - my @facets_loop; # stores the ref to array of hashes for template - #### LOOP THROUGH THE RESULTS - $numresults = 0 | $result->size() if ($result); - for ( my $i=$startfrom; $i<(($startfrom+$num<=$numresults) ? ($startfrom+$num):$numresults) ; $i++){ - ## This is just an index scan - if ($search_or_scan =~ /scan/) { - my ($term,$occ) = $result->term($i); - # here we create a minimal MARC record and hand it off to the - # template just like a normal result ... perhaps not ideal, but - # it works for now FIXME: distinguish between MARC21 and UNIMARC - use MARC::Record; - my $tmprecord = MARC::Record->new(); - $tmprecord->encoding('UTF-8'); - my $tmptitle = MARC::Field->new( '245',' ',' ', - a => $term, - b => $occ); - $tmprecord->append_fields($tmptitle); - push @results, $tmprecord->as_usmarc(); - ## This is a real search - } else { - my $rec = $result->record($i); - push(@results,$rec->raw()) if $rec; #FIXME: sometimes this fails +$counts{'total'}=0; +my $noitems = 1; +my $norequests = 1; + ##Loop for each item field + + foreach my $item (@itemrecords) { + $norequests = 0 unless $item->{'itemnotforloan'}; + $noitems = 0; + my $status; + #renaming some fields according to templates + $item->{'branchname'}=$branches{$item->{'holdingbranch'}}; + $item->{'shelves'}=$shelves{$item->{'shelf'}}; + $status="Lost" if ($item->{'itemlost'}>0); + $status="Withdrawn" if ($item->{'wthdrawn'}>0); + if ($intranet eq "intranet"){ ## we give full itemcallnumber detail in intranet + $status="Due:".format_date($item->{'date_due'}) if ($item->{'date_due'} gt "0000-00-00"); + $status = $item->{'holdingbranch'}."-".$item->{'shelf'}."[".$item->{'itemcallnumber'}."]" unless defined $status; + }else{ + $status="On Loan" if ($item->{'date_due'} gt "0000-00-00"); + $status = $item->{'branchname'}."[".$item->{'shelves'}."]" unless defined $status; + } + + $counts{$status}++; + $counts{'total'}++; + } + $oldbiblio->{'noitems'} = $noitems; + $oldbiblio->{'norequests'} = $norequests; + $oldbiblio->{'even'} = $even; + $even= not $even; + if ($even){ + $oldbiblio->{'toggle'}="#ffffcc"; + } else { + $oldbiblio->{'toggle'}="white"; + } ; ## some forms seems to use toggle - ##### BUILD FACETS AND LIMITS #### - my $facet_record = MARC::Record->new_from_usmarc($rec->raw()); - - for (my $i=0;$i<=@$facets;$i++) { - if ($facets->[$i]) { - my @fields; - for my $tag (@{$facets->[$i]->{'tags'}}) { - push @fields, $facet_record->field($tag); - } - for my $field (@fields) { - my @subfields = $field->subfields(); - for my $subfield (@subfields) { - my ($code,$data) = @$subfield; - if ($code eq $facets->[$i]->{'subfield'}) { - $facets_counter->{ $facets->[$i]->{'link_value'} }->{ $data }++; - } - } - } - $facets_info->{ $facets->[$i]->{'link_value'} }->{ 'label_value' } = $facets->[$i]->{'label_value'}; - $facets_info->{ $facets->[$i]->{'link_value'} }->{ 'expanded' } = $facets->[$i]->{'expanded'}; - } + $oldbiblio->{'itemcount'} = $counts{'total'}; + my $totalitemcounts = 0; + foreach my $key (keys %counts){ + if ($key ne 'total'){ + $totalitemcounts+= $counts{$key}; + $oldbiblio->{'locationhash'}->{$key}=$counts{$key}; + } + } + my ($locationtext, $locationtextonly, $notavailabletext) = ('','',''); + foreach (sort keys %{$oldbiblio->{'locationhash'}}) { - } - } - # BUILD FACETS - for my $link_value ( sort { $facets_counter->{$b} <=> $facets_counter->{$a} } keys %$facets_counter) { - my $expandable; - my $number_of_facets; - my @this_facets_array; - for my $one_facet (sort { $facets_counter->{ $link_value }->{$b} <=> $facets_counter->{ $link_value }->{$a} } keys %{$facets_counter->{ $link_value }} ) { - $number_of_facets++; - if (($number_of_facets < 6) || ($expanded_facet eq $link_value) || ($facets_info->{ $link_value }->{ 'expanded'})) { - - # sanitize the link value ), ( will cause errors with CCL - my $facet_link_value = $one_facet; - $facet_link_value =~ s/(\(|\))/ /g; - - # fix the length that will display in the label - my $facet_label_value = $one_facet; - $facet_label_value = substr($one_facet,0,20)."..." unless length($facet_label_value)<=20; - # well, if it's a branch, label by the name, not the code - if ($link_value =~/branch/) { - warn "branch"; - $facet_label_value = $branches->{$one_facet}->{'branchname'}; + if ($_ eq 'notavailable') { + $notavailabletext="Not available"; + my $c=$oldbiblio->{'locationhash'}->{$_}; + $oldbiblio->{'not-available-p'}=$c; + } else { + $locationtext.="$_"; + my $c=$oldbiblio->{'locationhash'}->{$_}; + if ($_ eq 'Lost') { + $oldbiblio->{'lost-p'} = $c; + } elsif ($_ eq 'Withdrawn') { + $oldbiblio->{'withdrawn-p'} = $c; + } elsif ($_ =~/\^Due:/) { + + $oldbiblio->{'on-loan-p'} = $c; + } else { + $locationtextonly.= $_; + $locationtextonly.= " ($c)
" if $totalitemcounts > 1; } - - # but we're down with the whole label being in the link's title - my $facet_title_value = $one_facet; - - push @this_facets_array , - ( { facet_count => $facets_counter->{ $link_value }->{ $one_facet }, - facet_label_value => $facet_label_value, - facet_title_value => $facet_title_value, - facet_link_value => $facet_link_value, - type_link_value => $link_value, - }, - ); + if ($totalitemcounts>1) { + $locationtext.=" ($c)
"; } + } } - unless ($facets_info->{ $link_value }->{ 'expanded'}) { - $expandable=1 if (($number_of_facets > 6) && ($expanded_facet ne $link_value)); + if ($notavailabletext) { + $locationtext.= $notavailabletext; + } else { + $locationtext=~s/, $//; } - push @facets_loop, - ( { type_link_value => $link_value, - type_id => $link_value."_id", - type_label => $facets_info->{ $link_value }->{ 'label_value' }, - facets => \@this_facets_array, - expandable => $expandable, - expand => $link_value, - } - ); - } + $oldbiblio->{'location'} = $locationtext; + $oldbiblio->{'location-only'} = $locationtextonly; + $oldbiblio->{'use-location-flags-p'} = 1; + push @results,$oldbiblio; + +}## For each record received + return(@results); +} - return(undef,$numresults,\@facets_loop,@results); +sub getcoverPhoto { +## return the address of a cover image if defined otherwise the amazon cover images + my $record =shift @_; + +my($phototag,$photosubtag)=MARCfind_marc_from_kohafield("coverphoto","biblios"); +if ($phototag){ + my $imagetag=$record->field($phototag); + my $image=$imagetag->subfield($photosubtag) if $imagetag; +return $image if $image; +} +# if there is no image put the amazon cover image adress +my($isbntag,$isbnsubtag)=MARCfind_marc_from_kohafield("isbn","biblios"); +my $isbn=$record->field($isbntag)->subfield($isbnsubtag) if $record->field($isbntag); +return "http://images.amazon.com/images/P/".$isbn.".01.MZZZZZZZ.jpg"; } -sub getRecords { - my ($zoom_query_ref,$sort_by_ref,$servers_ref,$count,$offset) = @_; - my @zoom_query = @$zoom_query_ref; - my @servers = @$servers_ref; - my @sort_by = @$sort_by_ref; +=item itemcount - # build the query string - my $zoom_query; - foreach my $query (@zoom_query) { - $zoom_query.="$query " if $query; - } + ($count, $lcount, $nacount, $fcount, $scount, $lostcount, + $mending, $transit,$ocount) = + &itemcount($env, $biblionumber, $type); - # create the zoom connection and query object - my $zconn; - my @zconns; - my @results; - my @results_array; # stores the final array of hashes of arrays - for (my $i = 0; $i < @servers; $i++) { - $zconns[$i] = new ZOOM::Connection($servers[$i], 0, - async => 1, # asynchronous mode - count => 1, # piggyback retrieval count - preferredRecordSyntax => "usmarc"); - $zconns[$i]->option( cclfile=> "/koha/etc/ccl.properties"); - # perform the search, create the results objects - $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($zoom_query,$zconns[$i])); - - # concatenate the sort_by limits and pass them to the results object - my $sort_by; - foreach my $sort (@sort_by) { - $sort_by.=$sort." "; # used to be $sort, - } - $results[$i]->sort("yaz", $sort_by) if $sort_by; - } - while ((my $i = ZOOM::event(\@zconns)) != 0) { - my $ev = $zconns[$i-1]->last_event(); - #print("connection ", $i-1, ": ", ZOOM::event_str($ev), "\n"); - if ($ev == ZOOM::Event::ZEND) { - my $size = $results[$i-1]->size(); - if ($size) { - my $results_hash; - $results_hash->{'server'} = $servers[$i-1]; - $results_hash->{'hits'} = $size; - for ( my $j=$offset; $j<(($offset+$count<=$size) ? ($offset+$count):$size) ; $j++){ - my $records_hash; - my $record = $results[$i-1]->record($j)->raw(); - warn $record; - my ($error,$final_record) = changeEncoding($record,'MARC','MARC21','UTF-8'); - $records_hash->{'record'} = $final_record; - $results_hash->{'RECORDS'}[$j] = $records_hash; - my $dbh = C4::Context->dbh; - use MARC::Record; - my $record_obj = MARC::Record->new_from_usmarc($final_record); - my $oldbiblio = MARCmarc2koha($dbh,$record_obj,''); - $results_hash->{'BIBLIOS'}[$j] = $oldbiblio; - - } - push @results_array, $results_hash; - } - #print "connection ", $i-1, ": $size hits"; - #print $results[$i-1]->record(0)->render() if $size > 0; - } - } - return (undef, @results_array); -} +Counts the number of items with the given biblionumber, broken down by +category. +C<$env> is ignored. -sub buildQuery { - my ($operators,$operands,$limits,$sort_by) = @_; - my @operators = @$operators if $operators; - my @operands = @$operands if $operands; - my @limits = @$limits if $limits; - my @sort_by = @$sort_by if $sort_by; - my $previous_operand; # a flag used to keep track if there was a previous query - # if there was, we can apply the current operator - my @ccl; - - # construct the query with operators - for (my $i=0; $i<=@operands; $i++) { - if ($operands[$i]) { - - # only add an operator if there is a previous operand - if ($previous_operand) { - if ($operators[$i]) { - push @ccl,( {operator => $operators[$i], operand => $operands[$i]} ); - } - - # the default operator is and - else { - push @ccl,( {operator => 'and', operand => $operands[$i]} ); - } - } - else { - push @ccl, ( {operand => $operands[$i]} ); - $previous_operand = 1; - } - } - } +If C<$type> is not set to C, lost, very overdue, and withdrawn +items will not be counted. - # add limits - foreach my $limit (@limits) { - push @ccl, ( {limit => $limit} ) if $limit; - } +C<&itemcount> returns a nine-element list: - return (undef,@ccl); -} -sub searchResults { - my ($searchdesc,$num,$count,@marcresults)=@_; - use C4::Date; - - my $dbh= C4::Context->dbh; - my $toggle; - my $even=1; - my @newresults; - my @span_terms = split (/ /, $searchdesc); - #Build brancnames hash - #find branchname - #get branch information..... - my %branches; - my $bsth=$dbh->prepare("SELECT branchcode,branchname FROM branches"); - $bsth->execute(); - while (my $bdata=$bsth->fetchrow_hashref){ - $branches{$bdata->{'branchcode'}}= $bdata->{'branchname'}; - } +C<$count> is the total number of items with the given biblionumber. - #search item field code - my $sth = $dbh->prepare( - "select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'" - ); - $sth->execute; - my ($itemtag) = $sth->fetchrow; - - ## find column names of items related to MARC - my $sth2=$dbh->prepare("SHOW COLUMNS from items"); - $sth2->execute; - my %subfieldstosearch; - while ((my $column)=$sth2->fetchrow){ - my ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,"items.".$column,""); - $subfieldstosearch{$column}=$tagsubfield; - } - if ($num>$count) { - $num = $count; - } - for ( my $i=0; $i<$num ; $i++){ - my $marcrecord; - $marcrecord = MARC::File::USMARC::decode($marcresults[$i]); - my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,''); - # add spans to search term in results - foreach my $term (@span_terms) { - if (length($term) > 3) { - $term =~ s/(.*=|\)|\))//g; - $oldbiblio->{'title'} =~ s/$term/$term<\/span>/gi; - $oldbiblio->{'subtitle'} =~ s/$term/$term<\/span>/gi; - $oldbiblio->{'author'} =~ s/$term/$term<\/span>/gi; - $oldbiblio->{'publishercode'} =~ s/$term/$term<\/span>/gi; - $oldbiblio->{'place'} =~ s/$term/$term<\/span>/gi; - $oldbiblio->{'pages'} =~ s/$term/$term<\/span>/gi; - $oldbiblio->{'notes'} =~ s/$term/$term<\/span>/gi; - $oldbiblio->{'size'} =~ s/$term/$term<\/span>/gi; - } - } +C<$lcount> is the number of items at the Levin branch. - if ($i % 2) { - $toggle="#ffffcc"; - } else { - $toggle="white"; - } - $oldbiblio->{'toggle'}=$toggle; - my @fields = $marcrecord->field($itemtag); - my @items; - my $item; - my %counts; - $counts{'total'}=0; +C<$nacount> is the number of items that are neither borrowed, lost, +nor withdrawn (and are therefore presumably on a shelf somewhere). -# -##Loop for each item field - foreach my $field (@fields) { - foreach my $code ( keys %subfieldstosearch ) { - - $item->{$code}=$field->subfield($subfieldstosearch{$code}); - } - - my $status; - $item->{'branchname'}=$branches{$item->{'homebranch'}}; - $item->{'date_due'}=$item->{onloan}; - $status="Lost" if ($item->{itemlost}); - $status="Withdrawn" if ($item->{wthdrawn}); - $status =" On loan" if ($item->{onloan}); - #$status="Due:".format_date($item->{onloan}) if ($item->{onloan}>0 ); - # $status="On Loan" if ($item->{onloan} ); - if ($item->{'location'}){ - $status = $item->{'branchname'}."[".$item->{'location'}."]" unless defined $status; - }else{ - $status = $item->{'branchname'} unless defined $status; - } - $counts{$status}++; - $counts{'total'}++; - push @items,$item; - } - my $norequests = 1; - my $noitems = 1; - if (@items) { - $noitems = 0; - foreach my $itm (@items) { - $norequests = 0 unless $itm->{'itemnotforloan'}; - } - } - $oldbiblio->{'noitems'} = $noitems; - $oldbiblio->{'norequests'} = $norequests; - $oldbiblio->{'even'} = $even = not $even; - $oldbiblio->{'itemcount'} = $counts{'total'}; - my $totalitemcounts = 0; - foreach my $key (keys %counts){ - if ($key ne 'total'){ - $totalitemcounts+= $counts{$key}; - $oldbiblio->{'locationhash'}->{$key}=$counts{$key}; - } - } - my ($locationtext, $locationtextonly, $notavailabletext) = ('','',''); - foreach (sort keys %{$oldbiblio->{'locationhash'}}) { - if ($_ eq 'notavailable') { - $notavailabletext="Not available"; - my $c=$oldbiblio->{'locationhash'}->{$_}; - $oldbiblio->{'not-available-p'}=$c; - } else { - $locationtext.="$_"; - my $c=$oldbiblio->{'locationhash'}->{$_}; - if ($_ eq 'Item Lost') { - $oldbiblio->{'lost-p'} = $c; - } elsif ($_ eq 'Withdrawn') { - $oldbiblio->{'withdrawn-p'} = $c; - } elsif ($_ eq 'On Loan') { - $oldbiblio->{'on-loan-p'} = $c; - } else { - $locationtextonly.= $_; - $locationtextonly.= " ($c)
" if $totalitemcounts > 1; - } - if ($totalitemcounts>1) { - $locationtext.=" ($c)
"; - } - } - } - if ($notavailabletext) { - $locationtext.= $notavailabletext; - } else { - $locationtext=~s/, $//; - } - $oldbiblio->{'location'} = $locationtext; - $oldbiblio->{'location-only'} = $locationtextonly; - $oldbiblio->{'use-location-flags-p'} = 1; - push (@newresults, $oldbiblio); +C<$fcount> is the number of items at the Foxton branch. + +C<$scount> is the number of items at the Shannon branch. + +C<$lostcount> is the number of lost and very overdue items. + +C<$mending> is the number of items at the Mending branch (being +mended?). + +C<$transit> is the number of items at the Transit branch (in transit +between branches?). + +C<$ocount> is the number of items that haven't arrived yet +(aqorders.quantity - aqorders.quantityreceived). + +=cut +#' + + + +sub itemcount { + my ($env,$bibnum,$type)=@_; + my $dbh = C4::Context->dbh; +my @kohafield; +my @value; +my @relation; +my @and_or; +my $sort; + my $query="Select * from items where + biblionumber=? "; +push @kohafield,"biblionumber"; +push @value,$bibnum; + +my ($total,@result)=ZEBRAsearch_kohafields(\@kohafield,\@value, \@relation,"", \@and_or, 0);## there is only one record no need for $num or $offset +my @fields;## extract only the fields required +push @fields,"itemnumber","itemlost","wthdrawn","holdingbranch","date_due"; +my ($biblio,@items)=XMLmarc2koha ($dbh,$result[0],"holdings",\@fields); + my $count=0; + my $lcount=0; + my $nacount=0; + my $fcount=0; + my $scount=0; + my $lostcount=0; + my $mending=0; + my $transit=0; + my $ocount=0; + foreach my $data(@items){ + if ($type ne "intra"){ + next if ($data->{itemlost} || $data->{wthdrawn}); + } ## Probably trying to hide lost item from opac ? + $count++; + +## Now it seems we want to find those which are onloan + + if ( $data->{date_due} gt "0000-00-00"){ + $nacount++; + next; + } +### The rest of this code is hardcoded for Foxtrot Shanon etc. We urgently need a global understanding of these terms--TG + if ($data->{'holdingbranch'} eq 'C' || $data->{'holdingbranch'} eq 'LT'){ + $lcount++; + } + if ($data->{'holdingbranch'} eq 'F' || $data->{'holdingbranch'} eq 'FP'){ + $fcount++; + } + if ($data->{'holdingbranch'} eq 'S' || $data->{'holdingbranch'} eq 'SP'){ + $scount++; + } + if ($data->{'itemlost'} eq '1'){ + $lostcount++; + } + if ($data->{'itemlost'} eq '2'){ + $lostcount++; + } + if ($data->{'holdingbranch'} eq 'FM'){ + $mending++; + } + if ($data->{'holdingbranch'} eq 'TR'){ + $transit++; + } + + } +# if ($count == 0){ + my $sth2=$dbh->prepare("Select * from aqorders where biblionumber=?"); + $sth2->execute($bibnum); + if (my $data=$sth2->fetchrow_hashref){ + $ocount=$data->{'quantity'} - $data->{'quantityreceived'}; } - return @newresults; +# $count+=$ocount; + + return ($count,$lcount,$nacount,$fcount,$scount,$lostcount,$mending,$transit,$ocount); } END { } # module clean-up code here (global destructor) @@ -4551,5 +880,6 @@ __END__ =head1 AUTHOR Koha Developement team +# New functions to comply with ZEBRA search and new KOHA 3 API added 2006 Tumer Garip tgarip@neu.edu.tr =cut diff --git a/C4/SearchBiblio.pm b/C4/SearchBiblio.pm deleted file mode 100644 index c896723061..0000000000 --- a/C4/SearchBiblio.pm +++ /dev/null @@ -1,716 +0,0 @@ -package C4::SearchBiblio; - -# Copyright 2000-2002 Katipo Communications -# -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. -# -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA - -use strict; -require Exporter; -use DBI; -use C4::Context; -use C4::Biblio; -use C4::Date; -use Date::Manip; - -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - -# set the version for version checking -$VERSION = 0.02; - -=head1 NAME - -C4::Search - Functions for searching the Koha MARC catalog - -=head1 FUNCTIONS - -This module provides the searching facilities for the Koha MARC catalog - -=cut - -@ISA = qw(Exporter); -@EXPORT = qw(&catalogsearch1 &catalogsearch &findseealso &findsuggestion &getMARCnotes &getMARCsubjects); - -=head1 findsuggestion($dbh,$values); - -=head2 $dbh is a link to the DB handler. - -use C4::Context; -my $dbh =C4::Context->dbh; - -=head2 $values is a word - -Searches words with the same soundex, ordered by frequency of use. -Useful to suggest other searches to the users. - -=cut - -sub findsuggestion { - my ($dbh,$values) = @_; - my $sth = $dbh->prepare("SELECT count( * ) AS total, word FROM marc_word WHERE sndx_word = soundex( ? ) AND word <> ? GROUP BY word ORDER BY total DESC"); - my @results; - for(my $i = 0 ; $i <= $#{$values} ; $i++) { - if (length(@$values[$i]) >=5) { - $sth->execute(@$values[$i],@$values[$i]); - my $resfound = 1; - my @resline; - while ((my ($count,$word) = $sth->fetchrow) and $resfound <=10) { - push @results, "@$values[$i]|$word|$count"; -# $results{@$values[$i]} = \@resline; - $resfound++; - } - } - } - return \@results; -} - -=head1 findseealso($dbh,$fields); - -=head2 $dbh is a link to the DB handler. - -use C4::Context; -my $dbh =C4::Context->dbh; - -=head2 $fields is a reference to the fields array - -This function modify the @$fields array and add related fields to search on. - -=cut - -sub findseealso { - my ($dbh, $fields) = @_; - my $tagslib = MARCgettagslib ($dbh,1); - for (my $i=0;$i<=$#{$fields};$i++) { - my ($tag) =substr(@$fields[$i],1,3); - my ($subfield) =substr(@$fields[$i],4,1); - @$fields[$i].=','.$tagslib->{$tag}->{$subfield}->{seealso} if ($tagslib->{$tag}->{$subfield}->{seealso}); - } -} - -=head1 my ($count, @results) = catalogsearch($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$sqlstring); - -=head2 $dbh is a link to the DB handler. - -use C4::Context; -my $dbh =C4::Context->dbh; - -$tags,$and_or, $excluding, $operator, $value are references to array - -=head2 $tags - -contains the list of tags+subfields (for example : $@tags[0] = '200a') -A field can be a list of fields : '200f','700a','700b','701a','701b' - -Example - -=head2 $and_or - -contains a list of strings containing and or or. The 1st value is useless. - -=head2 $excluding - -contains 0 or 1. If 1, then the request is negated. - -=head2 $operator - -contains contains,=,start,>,>=,<,<= the = and start work on the complete subfield. The contains operator works on every word in the subfield. - -examples : -contains home, search home anywhere. -= home, search a string being home. - -=head2 $value - -contains the value to search -If it contains a * or a %, then the search is partial. - -=head2 $offset and $length - -returns $length results, beginning at $offset - -=head2 $orderby - -define the field used to order the request. Any field in the biblio/biblioitem tables can be used. DESC is possible too - -(for example title, title DESC,...) - -=head2 $sqlstring - -optional argument containing an sql string to be used in the 'where' statement. see usage in opac-search.pl. - -=head2 RETURNS - -returns an array containing hashes. The hash contains all biblio & biblioitems fields and a reference to an item hash. The "item hash contains one line for each callnumber & the number of items related to the callnumber. - -=cut - -=head2 my $marcnotesarray = &getMARCnotes($dbh,$bibid,$marcflavour); - -Returns a reference to an array containing all the notes stored in the MARC database for the given bibid. -$marcflavour ("MARC21" or "UNIMARC") determines which tags are used for retrieving subjects. - -=head2 my $marcsubjctsarray = &getMARCsubjects($dbh,$bibid,$marcflavour); - -Returns a reference to an array containing all the subjects stored in the MARC database for the given bibid. -$marcflavour ("MARC21" or "UNIMARC") determines which tags are used for retrieving subjects. - -=cut - -sub catalogsearch1 { - my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$desc_or_asc,$sqlstring) = @_; -# warn "=================="; -# warn " -# db: $dbh, -# tags_array: @$tags, -# andor_array: @$and_or, -# excludes_array: @$excluding, -# operator_array: @$operator, -# value_array: @$value, -# start: $offset, -# resultsperpage: $length, -# orderby: $orderby, -# order: $desc_or_asc, -# sqlstring: $sqlstring)\n"; -# warn "==================\n"; - - my @cols = ('biblionumber','author','title','unititle','notes','serial','seriestitle', - 'copyrightdate','timestamp','abstract','illus','biblioitemnumber','marc', - 'url','isbn','volumeddesc','classification','publicationyear','pages','number', - 'itemtype','place','issn','size','dewey','publishercode','lccn','volume', - 'subclass', 'volumedate','subtitle','bibid','notforloan',); - # missing 'CN', 'description', 'odd', 'bn', 'norequests', 'totitem', - my @valarray = @$value; -# warn "@$value\n"; -# warn "$valarray[0]\n"; - my $sql = " - SELECT biblio.biblionumber, biblio.author, biblio.title, biblio.unititle, - biblio.notes, biblio.serial, biblio.seriestitle, biblio.copyrightdate, - biblio.timestamp, biblio.abstract, - biblioitems.illus, biblioitems.biblioitemnumber, biblioitems.marc, - biblioitems.url, biblioitems.isbn, biblioitems.volumeddesc, - biblioitems.classification, biblioitems.publicationyear, - biblioitems.pages, biblioitems.number, biblioitems.itemtype, - biblioitems.place, biblioitems.issn, biblioitems.size, - biblioitems.dewey, biblioitems.publishercode, biblioitems.lccn, - biblioitems.volume, biblioitems.subclass, biblioitems.volumedate, - bibliosubtitle.subtitle, - marc_biblio.bibid, - items.notforloan, - MATCH(biblio.title,biblio.author,biblio.unititle,biblio.seriestitle) - AGAINST ('$$value[0]' IN BOOLEAN MODE) as Relevance - FROM biblio - LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber - LEFT JOIN bibliosubtitle ON bibliosubtitle.biblionumber=biblio.biblionumber - LEFT JOIN marc_biblio ON marc_biblio.biblionumber=biblio.biblionumber - LEFT JOIN items ON items.biblionumber=biblio.biblionumber - WHERE MATCH(biblio.title,biblio.author,biblio.unititle,biblio.seriestitle) - AGAINST ('$$value[0]' IN BOOLEAN MODE) - ORDER BY Relevance DESC;"; - warn "$sql\n"; - my $sth = $dbh->prepare($sql); - $sth->execute; - my @biblioArray=(); - my $numBooks=0; - while (my @vals = $sth->fetchrow) { - my $numcols = $#vals; - my %biblioEntryHash=(); - for(my $i=0; $i<$numcols; $i++) { - $biblioEntryHash{$cols[$i]} = $vals[$i]; - } - $biblioEntryHash{odd} = ((($numBooks+1) % 2) > 0) ? 1 : ""; - #FIXME - $biblioEntryHash{notforloan} = ""; - #warn "\$biblioEntryHash{odd} = .$biblioEntryHash{odd}.\n"; - push(@biblioArray,\%biblioEntryHash); - $numBooks++; - } - - -# CN: ARRAY(0x89d1540)? branch + location + callnumber + status -# CDI SL (N8KIM) (2) (if several, group them) -# description: ? -# odd: 1 ? -# bn: 501? biblionumber? -# norequests: 0? -# totitem: 1? - -# my ($res,$numres) = catalogsearch(@_); -# my @results = @$res; -# warn "==================\n"; -# warn "\n\tres: @$res:,\n\tnumres: $numres\n"; -# while ( (my ($key, $value) = each(%{$results[0]})) && (my ($key1, $value1) = each(%{$biblioArray[0]})) ) { -# warn "\t$key => $value\t$key1 => $value1\n"; -# } -# warn "a. " . $results[0]->{odd} . "\t" . $biblioArray[0]->{odd}. "\n"; -# warn "b. " . $results[1]->{odd} . "\t" . $biblioArray[1]->{odd}. "\n"; -# warn "==================\n"; - #return ($res,$numres); - return (\@biblioArray,$numBooks); -} - -sub catalogsearch { - my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$desc_or_asc,$sqlstring) = @_; - # build the sql request. She will look like : - # select m1.bibid - # from marc_subfield_table as m1, marc_subfield_table as m2 - # where m1.bibid=m2.bibid and - # (m1.subfieldvalue like "Des%" and m2.subfieldvalue like "27%") - - # last minute stripping out of stuff - # doesn't work @$value =~ s/\'/ /; - # @$value = map { $_ =~ s/\'/ /g } @$value; - - # "Normal" statements - my @normal_tags = (); - my @normal_and_or = (); - my @normal_operator = (); - my @normal_value = (); - # Extracts the NOT statements from the list of statements - my @not_tags = (); - my @not_and_or = (); - my @not_operator = (); - my @not_value = (); - my $any_not = 0; - $orderby = "biblio.title" unless $orderby; - $desc_or_asc = "ASC" unless $desc_or_asc; - #last minute stripping out of ' and , -# paul : quoting, it's done a few lines lated. -# foreach $_ (@$value) { -# $_=~ s/\'/ /g; -# $_=~ s/\,/ /g; -# } - -# the item.notforloan contains an integer. Every value <>0 means "book unavailable for loan". -# but each library can have it's own table of meaning for each value. Get them -# 1st search if there is a list of authorised values connected to items.notforloan - my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"'); - $sth->execute; - my %notforloanstatus; - my ($authorised_valuecode) = $sth->fetchrow; - if ($authorised_valuecode) { - $sth = $dbh->prepare("select authorised_value,lib from authorised_values where category=?"); - $sth->execute($authorised_valuecode); - while (my ($authorised_value,$lib) = $sth->fetchrow) { - $notforloanstatus{$authorised_value} = $lib?$lib:$authorised_value; - } - } - for(my $i = 0 ; $i <= $#{$value} ; $i++) - { - # replace * by % - @$value[$i] =~ s/\*/%/g; - # remove % at the beginning - @$value[$i] =~ s/^%//g; - @$value[$i] =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)/ /g if @$operator[$i] eq "contains"; - if(@$excluding[$i]) # NOT statements - { - $any_not = 1; - if(@$operator[$i] eq "contains") - { - foreach my $word (split(/ /, @$value[$i])) # if operator is contains, splits the words in separate requests - { - # remove the "%" for small word (3 letters. (note : the >4 is due to the % at the end) -# warn "word : $word"; - $word =~ s/%//g unless length($word)>4; - unless (C4::Context->stopwords->{uc($word)} or length($word)==1) { #it's NOT a stopword => use it. Otherwise, ignore - push @not_tags, @$tags[$i]; - push @not_and_or, "or"; # as request is negated, finds "foo" or "bar" if final request is NOT "foo" and "bar" - push @not_operator, @$operator[$i]; - push @not_value, $word; - } - } - } - else - { - push @not_tags, @$tags[$i]; - push @not_and_or, "or"; # as request is negated, finds "foo" or "bar" if final request is NOT "foo" and "bar" - push @not_operator, @$operator[$i]; - push @not_value, @$value[$i]; - } - } - else # NORMAL statements - { - if(@$operator[$i] eq "contains") # if operator is contains, splits the words in separate requests - { - foreach my $word (split(/ /, @$value[$i])) - { - # remove the "%" for small word (3 letters. (note : the >4 is due to the % at the end) -# warn "word : $word"; - $word =~ s/%//g unless length($word)>4; - unless (C4::Context->stopwords->{uc($word)} or length($word)==1) { #it's NOT a stopword => use it. Otherwise, ignore - push @normal_tags, @$tags[$i]; - push @normal_and_or, "and"; # assumes "foo" and "bar" if "foo bar" is entered - push @normal_operator, @$operator[$i]; - push @normal_value, $word; - } - } - } - else - { - push @normal_tags, @$tags[$i]; - push @normal_and_or, @$and_or[$i]; - push @normal_operator, @$operator[$i]; - push @normal_value, @$value[$i]; - } - } - } - - # Finds the basic results without the NOT requests - my ($sql_tables, $sql_where1, $sql_where2) = create_request($dbh,\@normal_tags, \@normal_and_or, \@normal_operator, \@normal_value); - $sql_where1 .=" ". $sqlstring; - $sql_where1 .= "and TO_DAYS( NOW( ) ) - TO_DAYS( biblio.timestamp ) <30" if $orderby =~ "biblio.timestamp"; - my $sth; - if ($sql_where2) { - $sth = $dbh->prepare("select distinct m1.bibid from biblio,biblioitems,items,marc_biblio,$sql_tables where biblio.biblionumber=marc_biblio.biblionumber and biblio.biblionumber=biblioitems.biblionumber and m1.bibid=marc_biblio.bibid and $sql_where2 and ($sql_where1) order by $orderby $desc_or_asc"); - warn "Q2 : select distinct m1.bibid from biblio,biblioitems,items,marc_biblio,$sql_tables where biblio.biblionumber=marc_biblio.biblionumber and biblio.biblionumber=biblioitems.biblionumber and m1.bibid=marc_biblio.bibid and $sql_where2 and ($sql_where1) order by $orderby $desc_or_asc term is @$value"; - } else { - $sth = $dbh->prepare("select distinct m1.bibid from biblio,biblioitems,items,marc_biblio,$sql_tables where biblio.biblionumber=marc_biblio.biblionumber and biblio.biblionumber=biblioitems.biblionumber and m1.bibid=marc_biblio.bibid and $sql_where1 order by $orderby $desc_or_asc"); - warn "Q : select distinct m1.bibid from biblio,biblioitems,items,marc_biblio,$sql_tables where biblio.biblionumber=marc_biblio.biblionumber and biblio.biblionumber=biblioitems.biblionumber and m1.bibid=marc_biblio.bibid and $sql_where1 order by $orderby $desc_or_asc"; - } - $sth->execute(); - my @result = (); - my $subtitle; # Added by JF for Subtitles - - # Processes the NOT if any and there are results - my ($not_sql_tables, $not_sql_where1, $not_sql_where2); - - if( ($sth->rows) && $any_not ) # some results to tune up and some NOT statements - { - ($not_sql_tables, $not_sql_where1, $not_sql_where2) = create_request($dbh,\@not_tags, \@not_and_or, \@not_operator, \@not_value); - - my @tmpresult; - - while (my ($bibid) = $sth->fetchrow) { - push @tmpresult,$bibid; - } - my $sth_not; - warn "NOT : select distinct m1.bibid from $not_sql_tables where $not_sql_where2 and ($not_sql_where1)"; - if ($not_sql_where2) { - $sth_not = $dbh->prepare("select distinct m1.bibid from $not_sql_tables where $not_sql_where2 and ($not_sql_where1)"); - } else { - $sth_not = $dbh->prepare("select distinct m1.bibid from $not_sql_tables where $not_sql_where1"); - } - $sth_not->execute(); - - if($sth_not->rows) - { - my %not_bibids = (); - while(my $bibid = $sth_not->fetchrow()) { - $not_bibids{$bibid} = 1; # populates the hashtable with the bibids matching the NOT statement - } - - foreach my $bibid (@tmpresult) - { - if(!$not_bibids{$bibid}) - { - push @result, $bibid; - } - } - } - $sth_not->finish(); - } - else # no NOT statements - { - while (my ($bibid) = $sth->fetchrow) { - push @result,$bibid; - } - } - - # we have bibid list. Now, loads title and author from [offset] to [offset]+[length] - my $counter = $offset; - # HINT : biblionumber as bn is important. The hash is fills biblionumber with items.biblionumber. - # so if you dont' has an item, you get a not nice empty value. - $sth = $dbh->prepare("SELECT biblio.biblionumber as bn,biblio.*, biblioitems.*,marc_biblio.bibid,itemtypes.notforloan,itemtypes.description - FROM biblio, marc_biblio - LEFT JOIN biblioitems on biblio.biblionumber = biblioitems.biblionumber - LEFT JOIN itemtypes on itemtypes.itemtype=biblioitems.itemtype - WHERE biblio.biblionumber = marc_biblio.biblionumber AND bibid = ?"); - my $sth_subtitle = $dbh->prepare("SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?"); # Added BY JF for Subtitles - my @finalresult = (); - my @CNresults=(); - my $totalitems=0; - my $oldline; - my ($oldbibid, $oldauthor, $oldtitle); - my $sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=?"); - my $sth_issue = $dbh->prepare("select date_due,returndate from issues where itemnumber=?"); - # parse all biblios between start & end. - while (($counter <= $#result) && ($counter <= ($offset + $length))) { - # search & parse all items & note itemcallnumber - $sth->execute($result[$counter]); - my $continue=1; - my $line = $sth->fetchrow_hashref; - my $biblionumber=$line->{bn}; - # Return subtitles first ADDED BY JF - $sth_subtitle->execute($biblionumber); - my $subtitle_here.= $sth_subtitle->fetchrow." "; - chop $subtitle_here; - $subtitle = $subtitle_here; -# warn "Here's the Biblionumber ".$biblionumber; -# warn "and here's the subtitle: ".$subtitle_here; - - # /ADDED BY JF - -# $continue=0 unless $line->{bn}; -# my $lastitemnumber; - $sth_itemCN->execute($biblionumber); - my @CNresults = (); - my $notforloan=1; # to see if there is at least 1 item that can be issued - while (my $item = $sth_itemCN->fetchrow_hashref) { - # parse the result, putting holdingbranch & itemcallnumber in separate array - # then all other fields in the main array - - # search if item is on loan - my $date_due; - $sth_issue->execute($item->{itemnumber}); - while (my $loan = $sth_issue->fetchrow_hashref) { - if ($loan->{date_due} and !$loan->{returndate}) { - $date_due = $loan->{date_due}; - } - } - # store this item - my %lineCN; - $lineCN{holdingbranch} = $item->{holdingbranch}; - $lineCN{itemcallnumber} = $item->{itemcallnumber}; - $lineCN{location} = $item->{location}; - $lineCN{date_due} = format_date($date_due); - $lineCN{notforloan} = $notforloanstatus{$line->{notforloan}} if ($line->{notforloan}); # setting not forloan if itemtype is not for loan - $lineCN{notforloan} = $notforloanstatus{$item->{notforloan}} if ($item->{notforloan}); # setting not forloan it this item is not for loan - $notforloan=0 unless ($item->{notforloan} or $item->{wthdrawn} or $item->{itemlost}); - push @CNresults,\%lineCN; - $totalitems++; - } - # save the biblio in the final array, with item and item issue status - my %newline; - %newline = %$line; - $newline{totitem} = $totalitems; - # if $totalitems == 0, check if it's being ordered. - if ($totalitems == 0) { - my $sth = $dbh->prepare("select count(*) from aqorders where biblionumber=? and datecancellationprinted is NULL"); - $sth->execute($biblionumber); - my ($ordered) = $sth->fetchrow; - $newline{onorder} = 1 if $ordered; - } - $newline{biblionumber} = $biblionumber; - $newline{norequests} = 0; - $newline{norequests} = 1 if ($line->{notforloan}); # itemtype not issuable - $newline{norequests} = 1 if (!$line->{notforloan} && $notforloan); # itemtype issuable but all items not issuable for instance - $newline{subtitle} = $subtitle; # put the subtitle in ADDED BY JF - - my @CNresults2= @CNresults; - $newline{CN} = \@CNresults2; - $newline{'even'} = 1 if $#finalresult % 2 == 0; - $newline{'odd'} = 1 if $#finalresult % 2 == 1; - $newline{'timestamp'} = format_date($newline{timestamp}); - @CNresults = (); - push @finalresult, \%newline; - $totalitems=0; - $counter++; - } - my $nbresults = $#result+1; - return (\@finalresult, $nbresults); -} - -# Creates the SQL Request - -sub create_request { - my ($dbh,$tags, $and_or, $operator, $value) = @_; - - my $sql_tables; # will contain marc_subfield_table as m1,... - my $sql_where1; # will contain the "true" where - my $sql_where2 = "("; # will contain m1.bibid=m2.bibid - my $nb_active=0; # will contain the number of "active" entries. an entry is active if a value is provided. - my $nb_table=1; # will contain the number of table. ++ on each entry EXCEPT when an OR is provided. - - my $maxloop=8; # the maximum number of words to avoid a too complex search. - $maxloop = @$value if @$value<$maxloop; - - for(my $i=0; $i<=$maxloop;$i++) { - if (@$value[$i]) { - $nb_active++; - if ($nb_active==1) { - if (@$operator[$i] eq "start") { - $sql_tables .= "marc_subfield_table as m$nb_table,"; - $sql_where1 .= "(m1.subfieldvalue like ".$dbh->quote("@$value[$i]%"); - if (@$tags[$i]) { - $sql_where1 .=" and concat(m1.tag,m1.subfieldcode) in (@$tags[$i])"; - } - $sql_where1.=")"; - } elsif (@$operator[$i] eq "contains") { - $sql_tables .= "marc_word as m$nb_table,"; - $sql_where1 .= "(m1.word like ".$dbh->quote("@$value[$i]"); - if (@$tags[$i]) { - $sql_where1 .=" and m1.tagsubfield in (@$tags[$i])"; - } - $sql_where1.=")"; - } else { - $sql_tables .= "marc_subfield_table as m$nb_table,"; - $sql_where1 .= "(m1.subfieldvalue @$operator[$i] ".$dbh->quote("@$value[$i]"); - if (@$tags[$i]) { - $sql_where1 .=" and concat(m1.tag,m1.subfieldcode) in (@$tags[$i])"; - } - $sql_where1.=")"; - } - } else { - if (@$operator[$i] eq "start") { - $nb_table++; - $sql_tables .= "marc_subfield_table as m$nb_table,"; - $sql_where1 .= "@$and_or[$i] (m$nb_table.subfieldvalue like ".$dbh->quote("@$value[$i]%"); - if (@$tags[$i]) { - $sql_where1 .=" and concat(m$nb_table.tag,m$nb_table.subfieldcode) in (@$tags[$i])"; - } - $sql_where1.=")"; - $sql_where2 .= "m1.bibid=m$nb_table.bibid and "; - } elsif (@$operator[$i] eq "contains") { - if (@$and_or[$i] eq 'and') { - $nb_table++; - $sql_tables .= "marc_word as m$nb_table,"; - $sql_where1 .= "@$and_or[$i] (m$nb_table.word like ".$dbh->quote("@$value[$i]"); - if (@$tags[$i]) { - $sql_where1 .=" and m$nb_table.tagsubfield in(@$tags[$i])"; - } - $sql_where1.=")"; - $sql_where2 .= "m1.bibid=m$nb_table.bibid and "; - } else { - $sql_where1 .= "@$and_or[$i] (m$nb_table.word like ".$dbh->quote("@$value[$i]"); - if (@$tags[$i]) { - $sql_where1 .=" and m$nb_table.tagsubfield in (@$tags[$i])"; - } - $sql_where1.=")"; - $sql_where2 .= "m1.bibid=m$nb_table.bibid and "; - } - } else { - $nb_table++; - $sql_tables .= "marc_subfield_table as m$nb_table,"; - $sql_where1 .= "@$and_or[$i] (m$nb_table.subfieldvalue @$operator[$i] ".$dbh->quote(@$value[$i]); - if (@$tags[$i]) { - $sql_where1 .=" and concat(m$nb_table.tag,m$nb_table.subfieldcode) in (@$tags[$i])"; - } - $sql_where2 .= "m1.bibid=m$nb_table.bibid and "; - $sql_where1.=")"; - } - } - } - } - - if($sql_where2 ne "(") # some datas added to sql_where2, processing - { - $sql_where2 = substr($sql_where2, 0, (length($sql_where2)-5)); # deletes the trailing ' and ' - $sql_where2 .= ")"; - } - else # no sql_where2 statement, deleting '(' - { - $sql_where2 = ""; - } - chop $sql_tables; # deletes the trailing ',' - return ($sql_tables, $sql_where1, $sql_where2); -} - -sub getMARCnotes { - my ($dbh, $bibid, $marcflavour) = @_; - my ($mintag, $maxtag); - if ($marcflavour eq "MARC21") { - $mintag = "500"; - $maxtag = "599"; - } else { # assume unimarc if not marc21 - $mintag = "300"; - $maxtag = "399"; - } - - my $sth=$dbh->prepare("SELECT subfieldvalue,tag FROM marc_subfield_table WHERE bibid=? AND tag BETWEEN ? AND ? ORDER BY tagorder"); - - $sth->execute($bibid,$mintag,$maxtag); - - my @marcnotes; - my $note = ""; - my $tag = ""; - my $marcnote; - - while (my $data=$sth->fetchrow_arrayref) { - my $value=$data->[0]; - my $thistag=$data->[1]; - if ($value=~/\.$/) { - $value=$value . " "; - } - if ($thistag ne $tag && $note ne "") { - $marcnote = {marcnote => $note,}; - push @marcnotes, $marcnote; - $note=$value; - $tag=$thistag; - } - if ($note ne $value) { - $note = $note." ".$value; - } - } - - if ($note) { - $marcnote = {marcnote => $note}; - push @marcnotes, $marcnote; #load last tag into array - } - - $sth->finish; - $dbh->disconnect; - - my $marcnotesarray=\@marcnotes; - return $marcnotesarray; -} # end getMARCnotes - - -sub getMARCsubjects { - my ($dbh, $bibid, $marcflavour) = @_; - my ($mintag, $maxtag); - if ($marcflavour eq "MARC21") { - $mintag = "600"; - $maxtag = "699"; - } else { # assume unimarc if not marc21 - $mintag = "600"; - $maxtag = "619"; - } - my $sth=$dbh->prepare("SELECT subfieldvalue,subfieldcode FROM marc_subfield_table WHERE bibid=? AND tag BETWEEN ? AND ? ORDER BY tagorder"); - - $sth->execute($bibid,$mintag,$maxtag); - - my @marcsubjcts; - my $subjct = ""; - my $subfield = ""; - my $marcsubjct; - - while (my $data=$sth->fetchrow_arrayref) { - my $value = $data->[0]; - my $subfield = $data->[1]; - if ($subfield eq "a" && $value ne $subjct) { - $marcsubjct = {MARCSUBJCT => $value,}; - push @marcsubjcts, $marcsubjct; - $subjct = $value; - } - } - - $sth->finish; - $dbh->disconnect; - - my $marcsubjctsarray=\@marcsubjcts; - return $marcsubjctsarray; -} #end getMARCsubjects - -END { } # module clean-up code here (global destructor) - -1; -__END__ - -=back - -=head1 AUTHOR - -Koha Developement team - -=cut diff --git a/C4/Serials.pm b/C4/Serials.pm index 54c0adc6ec..7d6852a5ec 100644 --- a/C4/Serials.pm +++ b/C4/Serials.pm @@ -53,16 +53,16 @@ Give all XYZ functions @ISA = qw(Exporter); @EXPORT = qw( &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions &GetSubscription - &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber + &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber &GetFullSubscriptionsFromBiblionumber &GetNextSeq - &ModSubscriptionHistory &NewIssue &ItemizeSerials + &ModSubscriptionHistory &NewIssue &GetSerials &GetLatestSerials &ModSerialStatus &HasSubscriptionExpired &GetSubscriptionExpirationDate &ReNewSubscription &GetSuppliersWithLateIssues &GetLateIssues &GetMissingIssues - &GetDistributedTo &SetDistributedto &serialchangestatus + &GetDistributedTo &SetDistributedto &getroutinglist &delroutingmember &addroutingmember &reorder_members &check_routing &getsupplierbyserialid &updateClaim &removeMissingIssue &abouttoexpire - &old_newsubscription &old_modsubscription &old_getserials &Get_Next_Date + &Get_Next_Date ); =head2 GetSuppliersWithLateIssues @@ -177,7 +177,7 @@ sub GetSubscriptionHistoryFromSubscriptionId() { my $dbh = C4::Context->dbh; my $query = qq| SELECT * - FROM subcriptionhistory + FROM subscriptionhistory WHERE subscriptionid = ? |; return $dbh->prepare($query); @@ -251,7 +251,7 @@ this function get the subscription list. it reads on subscription table. return : table of subscription which has the biblionumber given on input arg. each line of this table is a hashref. All hashes containt -startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate +planned, histstartdate,opacnote,missinglist,receivedlist,periodicity,status & enddate =back @@ -276,11 +276,12 @@ sub GetSubscriptionsFromBiblionumber { $sth->execute($biblionumber); my @res; while (my $subs = $sth->fetchrow_hashref) { - $subs->{startdate} = format_date($subs->{startdate}); + $subs->{planneddate} = format_date($subs->{planneddate}); + $subs->{publisheddate} = format_date($subs->{publisheddate}); $subs->{histstartdate} = format_date($subs->{histstartdate}); $subs->{opacnote} =~ s/\n/\/g; $subs->{missinglist} =~ s/\n/\/g; - $subs->{recievedlist} =~ s/\n/\/g; + $subs->{receivedlist} =~ s/\n/\/g; $subs->{"periodicity".$subs->{periodicity}} = 1; $subs->{"status".$subs->{'status'}} = 1; if ($subs->{enddate} eq '0000-00-00') { @@ -396,10 +397,9 @@ sub GetSubscriptions { my $sth; if ($biblionumber) { my $query = qq( - SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber - FROM subscription,biblio,biblioitems - WHERE biblio.biblionumber = biblioitems.biblionumber - AND biblio.biblionumber = subscription.biblionumber + SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber + FROM subscription,biblio + WHERE biblio.biblionumber = subscription.biblionumber AND biblio.biblionumber=? ORDER BY title ); @@ -408,11 +408,10 @@ sub GetSubscriptions { } else { if ($ISSN and $title){ my $query = qq| - SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber - FROM subscription,biblio,biblioitems - WHERE biblio.biblionumber = biblioitems.biblionumber - AND biblio.biblionumber= subscription.biblionumber - AND (biblio.title LIKE ? or biblioitems.issn = ?) + SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber + FROM subscription,biblio + WHERE biblio.biblionumber= subscription.biblionumber + AND (biblio.title LIKE ? or biblio.issn = ?) ORDER BY title |; $sth = $dbh->prepare($query); @@ -421,8 +420,8 @@ sub GetSubscriptions { else{ if ($ISSN){ my $query = qq( - SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber - FROM subscription,biblio,biblioitems + SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber + FROM subscription,biblio WHERE biblio.biblionumber = biblioitems.biblionumber AND biblio.biblionumber=subscription.biblionumber AND biblioitems.issn = ? @@ -432,10 +431,9 @@ sub GetSubscriptions { $sth->execute($ISSN); } else { my $query = qq( - SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber - FROM subscription,biblio,biblioitems - WHERE biblio.biblionumber = biblioitems.biblionumber - AND biblio.biblionumber=subscription.biblionumber + SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber + FROM subscription,biblio + WHERE biblio.biblionumber=subscription.biblionumber AND biblio.title LIKE ? ORDER BY title ); @@ -477,36 +475,39 @@ this number is used to see if a subscription can be deleted (=it must have only sub GetSerials { my ($subscriptionid) = @_; my $dbh = C4::Context->dbh; - # OK, now add the last 5 issues arrives/missing + + my $counter=0; + my @serials; + + # status = 2 is "arrived" my $query = qq| - SELECT serialid,serialseq, status, planneddate,notes - FROM serial - WHERE subscriptionid = ? - AND (status in (2,4,5)) - ORDER BY serialid DESC + SELECT * + FROM serial + WHERE subscriptionid = ? AND status NOT IN (2,4,5) |; my $sth=$dbh->prepare($query); $sth->execute($subscriptionid); - my $counter=0; - my @serials; - while((my $line = $sth->fetchrow_hashref) && $counter <5) { - $counter++; + while(my $line = $sth->fetchrow_hashref) { $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list + $line->{"publisheddate"} = format_date($line->{"publisheddate"}); $line->{"planneddate"} = format_date($line->{"planneddate"}); push @serials,$line; } - # status = 2 is "arrived" + # OK, now add the last 5 issues arrived/missing my $query = qq| - SELECT serialid,serialseq, status, publisheddate, planneddate,notes - FROM serial - WHERE subscriptionid = ? AND status NOT IN (2,4,5) + SELECT * + FROM serial + WHERE subscriptionid = ? + AND (status in (2,4,5)) + ORDER BY serialid DESC |; my $sth=$dbh->prepare($query); $sth->execute($subscriptionid); - while(my $line = $sth->fetchrow_hashref) { + while((my $line = $sth->fetchrow_hashref) && $counter <5) { + $counter++; $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list - $line->{"publisheddate"} = format_date($line->{"publisheddate"}); $line->{"planneddate"} = format_date($line->{"planneddate"}); + $line->{"publisheddate"} = format_date($line->{"publisheddate"}); push @serials,$line; } my $query = qq| @@ -603,7 +604,7 @@ sub GetNextSeq { my ($val) =@_; my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3); $calculated = $val->{numberingmethod}; -# calculate the (expected) value of the next issue recieved. +# calculate the (expected) value of the next issue received. $newlastvalue1 = $val->{lastvalue1}; # check if we have to increase the new value. $newinnerloop1 = $val->{innerloop1}+1; @@ -836,7 +837,7 @@ sub CountSubscriptionFromBiblionumber { =over 4 -ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote); +ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote); this function modify the history of a subscription. Put your new values on input arg. @@ -844,18 +845,18 @@ this function modify the history of a subscription. Put your new values on input =cut sub ModSubscriptionHistory { - my ($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)=@_; + my ($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote)=@_; my $dbh=C4::Context->dbh; my $query = qq( UPDATE subscriptionhistory - SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=? + SET histstartdate=?,enddate=?,receivedlist=?,missinglist=?,opacnote=?,librariannote=? WHERE subscriptionid=? ); my $sth = $dbh->prepare($query); - $recievedlist =~ s/^,//g; + $receivedlist =~ s/^,//g; $missinglist =~ s/^,//g; $opacnote =~ s/^,//g; - $sth->execute($histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid); + $sth->execute($histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote,$subscriptionid); } =head2 ModSerialStatus @@ -871,7 +872,8 @@ Note : if we change from "waited" to something else,then we will have to create =cut sub ModSerialStatus { - my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)=@_; + my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes,$itemnumber)=@_; + # 1st, get previous status : my $dbh = C4::Context->dbh; my $query = qq| @@ -888,31 +890,31 @@ sub ModSerialStatus { } else { my $query = qq( UPDATE serial - SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? + SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?,itemnumber=? WHERE serialid = ? ); $sth = $dbh->prepare($query); - $sth->execute($serialseq,$publisheddate,$planneddate,$status,$notes,$serialid); + $sth->execute($serialseq,format_date_in_iso($publisheddate),format_date_in_iso($planneddate),$status,$notes,$itemnumber,$serialid); my $query = qq( - SELECT missinglist,recievedlist + SELECT missinglist,receivedlist FROM subscriptionhistory WHERE subscriptionid=? ); $sth = $dbh->prepare($query); $sth->execute($subscriptionid); - my ($missinglist,$recievedlist) = $sth->fetchrow; - if ($status eq 2) { - $recievedlist .= ",$serialseq"; + my ($missinglist,$receivedlist) = $sth->fetchrow; + if ($status == 2 && $oldstatus != 2) { + $receivedlist .= ",$serialseq"; } $missinglist .= ",$serialseq" if ($status eq 4) ; $missinglist .= ",not issued $serialseq" if ($status eq 5); my $query = qq( UPDATE subscriptionhistory - SET recievedlist=?, missinglist=? + SET receivedlist=?, missinglist=? WHERE subscriptionid=? ); $sth=$dbh->prepare($query); - $sth->execute($recievedlist,$missinglist,$subscriptionid); + $sth->execute($receivedlist,$missinglist,$subscriptionid); } # create new waited entry if needed (ie : was a "waited" and has changed) if ($oldstatus eq 1 && $status ne 1) { @@ -927,8 +929,9 @@ sub ModSerialStatus { # next issue number my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val); # next date (calculated from actual date & frequency parameters) - my $nextpublisheddate = GetNextDate($publisheddate,$val); - NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,0); + my $nextplanneddate = Get_Next_Date($planneddate,$val); + my $nextpublisheddate = Get_Next_Date($publisheddate,$val); + NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,$nextplanneddate,0); my $query = qq| UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, @@ -955,7 +958,7 @@ sub ModSubscription { $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1, $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2, $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3, - $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid)= @_; + $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate)= @_; my $dbh = C4::Context->dbh; my $query = qq| UPDATE subscription @@ -964,7 +967,7 @@ sub ModSubscription { add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?, add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?, add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?, - numberingmethod=?, status=?, biblionumber=?, notes=?, letter=? + numberingmethod=?, status=?, biblionumber=?, notes=?, letter=?,irregularity=?,hemisphere=?,callnumber=?,numberpattern=? ,publisheddate=? WHERE subscriptionid = ? |; my $sth=$dbh->prepare($query); @@ -973,7 +976,7 @@ sub ModSubscription { $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1, $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2, $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3, - $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid); + $numberingmethod, $status, $biblionumber, $notes, $letter, $irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate,$subscriptionid); $sth->finish; } @@ -1000,41 +1003,48 @@ the id of this new subscription sub NewSubscription { my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber, $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength, - $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1, - $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2, - $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3, - $numberingmethod, $status, $notes, $letter) = @_; + $add1,$every1,$whenmorethan1,$setto1,$lastvalue1, + $add2,$every2,$whenmorethan2,$setto2,$lastvalue2, + $add3,$every3,$whenmorethan3,$setto3,$lastvalue3, + $numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate) = @_; + my $dbh = C4::Context->dbh; #save subscription (insert into database) my $query = qq| INSERT INTO subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber, startdate,periodicity,dow,numberlength,weeklength,monthlength, - add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1, - add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2, - add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3, - numberingmethod, status, notes, letter) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) - |; + add1,every1,whenmorethan1,setto1,lastvalue1, + add2,every2,whenmorethan2,setto2,lastvalue2, + add3,every3,whenmorethan3,setto3,lastvalue3, + numberingmethod, status, notes, letter,irregularity,hemisphere,callnumber,numberpattern,publisheddate) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + |; my $sth=$dbh->prepare($query); $sth->execute( $auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber, format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength, - $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1, - $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2, - $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3, - $numberingmethod, $status, $notes, $letter); + $add1,$every1,$whenmorethan1,$setto1,$lastvalue1, + $add2,$every2,$whenmorethan2,$setto2,$lastvalue2, + $add3,$every3,$whenmorethan3,$setto3,$lastvalue3, + $numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,format_date_in_iso($publisheddate)); + #then create the 1st waited number my $subscriptionid = $dbh->{'mysql_insertid'}; + my $enddate = GetSubscriptionExpirationDate($subscriptionid); my $query = qq( INSERT INTO subscriptionhistory - (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) + (biblionumber, subscriptionid, histstartdate, enddate, missinglist, receivedlist, opacnote, librariannote) VALUES (?,?,?,?,?,?,?,?) ); $sth = $dbh->prepare($query); - $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), 0, "", "", "", $notes); - + $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes); +## User may have subscriptionid stored in MARC so check and fill it +my $record=MARCgetbiblio($dbh,$biblionumber); +MARCkoha2marcOnefield( $record, "subscriptionid", $subscriptionid,"biblios" ); +my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber); +NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode); # reread subscription to get a hash (for calculation of the 1st issue number) my $query = qq( SELECT * @@ -1049,11 +1059,12 @@ sub NewSubscription { my $serialseq = GetSeq($val); my $query = qq| INSERT INTO serial - (serialseq,subscriptionid,biblionumber,status, planneddate) - VALUES (?,?,?,?,?) + (serialseq,subscriptionid,biblionumber,status, planneddate,publisheddate) + VALUES (?,?,?,?,?,?) |; + $sth = $dbh->prepare($query); - $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate)); + $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate),format_date_in_iso($publisheddate)); return $subscriptionid; } @@ -1073,15 +1084,9 @@ sub ReNewSubscription { my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_; my $dbh = C4::Context->dbh; my $subscription = GetSubscription($subscriptionid); - my $query = qq| - SELECT * - FROM biblio,biblioitems - WHERE biblio.biblionumber=biblioitems.biblionumber - AND biblio.biblionumber=? - |; - my $sth = $dbh->prepare($query); - $sth->execute($subscription->{biblionumber}); - my $biblio = $sth->fetchrow_hashref; + my $record=MARCgetbiblio($dbh,$subscription->{biblionumber}); + + my $biblio = MARCmarc2koha($dbh,$record,"biblios"); NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber}); # renew subscription my $query = qq| @@ -1089,7 +1094,7 @@ sub ReNewSubscription { SET startdate=?,numberlength=?,weeklength=?,monthlength=? WHERE subscriptionid=? |; - $sth=$dbh->prepare($query); +my $sth=$dbh->prepare($query); $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid); } @@ -1101,42 +1106,43 @@ sub ReNewSubscription { NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate) Create a new issue stored on the database. -Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription. +Note : we have to update the receivedlist and missinglist on subscriptionhistory for this subscription. =back =cut sub NewIssue { - my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate) = @_; + my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate,$itemnumber) = @_; my $dbh = C4::Context->dbh; my $query = qq| INSERT INTO serial - (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate) - VALUES (?,?,?,?,?,?) + (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,itemnumber) + VALUES (?,?,?,?,?,?,?) |; my $sth = $dbh->prepare($query); - $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,$publisheddate, $planneddate); + $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,format_date_in_iso($publisheddate), format_date_in_iso($planneddate),$itemnumber); + my $query = qq| - SELECT missinglist,recievedlist + SELECT missinglist,receivedlist FROM subscriptionhistory WHERE subscriptionid=? |; $sth = $dbh->prepare($query); $sth->execute($subscriptionid); - my ($missinglist,$recievedlist) = $sth->fetchrow; + my ($missinglist,$receivedlist) = $sth->fetchrow; if ($status eq 2) { - $recievedlist .= ",$serialseq"; + $receivedlist .= ",$serialseq"; } if ($status eq 4) { $missinglist .= ",$serialseq"; } my $query = qq| UPDATE subscriptionhistory - SET recievedlist=?, missinglist=? + SET receivedlist=?, missinglist=? WHERE subscriptionid=? |; $sth=$dbh->prepare($query); - $sth->execute($recievedlist,$missinglist,$subscriptionid); + $sth->execute($receivedlist,$missinglist,$subscriptionid); } =head2 serialchangestatus @@ -1163,19 +1169,20 @@ sub serialchangestatus { delissue($serialseq, $subscriptionid) }else{ $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?"); - $sth->execute($serialseq,$planneddate,$status,$notes,$serialid); - $sth = $dbh->prepare("select missinglist,recievedlist from subscriptionhistory where subscriptionid=?"); + $sth->execute($serialseq,format_date_in_iso($planneddate),$status,$notes,$serialid); + + $sth = $dbh->prepare("select missinglist,receivedlist from subscriptionhistory where subscriptionid=?"); $sth->execute($subscriptionid); - my ($missinglist,$recievedlist) = $sth->fetchrow; + my ($missinglist,$receivedlist) = $sth->fetchrow; if ($status eq 2) { - $recievedlist .= "| $serialseq"; - $recievedlist =~ s/^\| //g; + $receivedlist .= "| $serialseq"; + $receivedlist =~ s/^\| //g; } $missinglist .= "| $serialseq" if ($status eq 4) ; $missinglist .= "| not issued $serialseq" if ($status eq 5); $missinglist =~ s/^\| //g; - $sth=$dbh->prepare("update subscriptionhistory set recievedlist=?, missinglist=? where subscriptionid=?"); - $sth->execute($recievedlist,$missinglist,$subscriptionid); + $sth=$dbh->prepare("update subscriptionhistory set receivedlist=?, missinglist=? where subscriptionid=?"); + $sth->execute($receivedlist,$missinglist,$subscriptionid); } # create new waited entry if needed (ie : was a "waited" and has changed) if ($oldstatus eq 1 && $status ne 1) { @@ -1199,167 +1206,7 @@ sub serialchangestatus { } -=head2 ItemizeSerials - -=over 4 - -ItemizeSerials($serialid, $info); -$info is a hashref containing barcode branch, itemcallnumber, status, location -$serialid the serialid -return : -1 if the itemize is a succes. -0 and @error else. @error containts the list of errors found. - -=back - -=cut -sub ItemizeSerials { - my ($serialid, $info) =@_; - my $now = ParseDate("today"); - $now = UnixDate($now,"%Y-%m-%d"); - my $dbh= C4::Context->dbh; - my $query = qq| - SELECT * - FROM serial - WHERE serialid=? - |; - my $sth=$dbh->prepare($query); - $sth->execute($serialid); - my $data=$sth->fetchrow_hashref; - if(C4::Context->preference("RoutingSerials")){ - # check for existing biblioitem relating to serial issue - my($count, @results) = getbiblioitembybiblionumber($data->{'biblionumber'}); - my $bibitemno = 0; - for(my $i=0;$i<$count;$i++){ - if($results[$i]->{'volumeddesc'} eq $data->{'serialseq'}.' ('.$data->{'planneddate'}.')'){ - $bibitemno = $results[$i]->{'biblioitemnumber'}; - last; - } - } - if($bibitemno == 0){ - # warn "need to add new biblioitem so copy last one and make minor changes"; - my $sth=$dbh->prepare("SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"); - $sth->execute($data->{'biblionumber'}); - my $biblioitem; - my $biblioitem = $sth->fetchrow_hashref; - $biblioitem->{'volumedate'} = format_date_in_iso($data->{planneddate}); - $biblioitem->{'volumeddesc'} = $data->{serialseq}.' ('.format_date($data->{'planneddate'}).')'; - $biblioitem->{'dewey'} = $info->{itemcallnumber}; - if ($info->{barcode}){ # only make biblioitem if we are going to make item also - $bibitemno = newbiblioitem($biblioitem); - } - } - } - - my $bibid=MARCfind_MARCbibid_from_oldbiblionumber($dbh,$data->{biblionumber}); - my $fwk=MARCfind_frameworkcode($dbh,$bibid); - if ($info->{barcode}){ - my @errors; - my $exists = itemdata($info->{'barcode'}); - push @errors,"barcode_not_unique" if($exists); - unless ($exists){ - my $marcrecord = MARC::Record->new(); - my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.barcode",$fwk); - my $newField = MARC::Field->new( - "$tag",'','', - "$subfield" => $info->{barcode} - ); - $marcrecord->insert_fields_ordered($newField); - if ($info->{branch}){ - my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.homebranch",$fwk); - #warn "items.homebranch : $tag , $subfield"; - if ($marcrecord->field($tag)) { - $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch}) - } else { - my $newField = MARC::Field->new( - "$tag",'','', - "$subfield" => $info->{branch} - ); - $marcrecord->insert_fields_ordered($newField); - } - my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.holdingbranch",$fwk); - #warn "items.holdingbranch : $tag , $subfield"; - if ($marcrecord->field($tag)) { - $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch}) - } else { - my $newField = MARC::Field->new( - "$tag",'','', - "$subfield" => $info->{branch} - ); - $marcrecord->insert_fields_ordered($newField); - } - } - if ($info->{itemcallnumber}){ - my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemcallnumber",$fwk); - #warn "items.itemcallnumber : $tag , $subfield"; - if ($marcrecord->field($tag)) { - $marcrecord->field($tag)->add_subfields("$subfield" => $info->{itemcallnumber}) - } else { - my $newField = MARC::Field->new( - "$tag",'','', - "$subfield" => $info->{itemcallnumber} - ); - $marcrecord->insert_fields_ordered($newField); - } - } - if ($info->{notes}){ - my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemnotes",$fwk); - # warn "items.itemnotes : $tag , $subfield"; - if ($marcrecord->field($tag)) { - $marcrecord->field($tag)->add_subfields("$subfield" => $info->{notes}) - } else { - my $newField = MARC::Field->new( - "$tag",'','', - "$subfield" => $info->{notes} - ); - $marcrecord->insert_fields_ordered($newField); - } - } - if ($info->{location}){ - my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.location",$fwk); - # warn "items.location : $tag , $subfield"; - if ($marcrecord->field($tag)) { - $marcrecord->field($tag)->add_subfields("$subfield" => $info->{location}) - } else { - my $newField = MARC::Field->new( - "$tag",'','', - "$subfield" => $info->{location} - ); - $marcrecord->insert_fields_ordered($newField); - } - } - if ($info->{status}){ - my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.notforloan",$fwk); - # warn "items.notforloan : $tag , $subfield"; - if ($marcrecord->field($tag)) { - $marcrecord->field($tag)->add_subfields("$subfield" => $info->{status}) - } else { - my $newField = MARC::Field->new( - "$tag",'','', - "$subfield" => $info->{status} - ); - $marcrecord->insert_fields_ordered($newField); - } - } - if(C4::Context->preference("RoutingSerials")){ - my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.dateaccessioned",$fwk); - if ($marcrecord->field($tag)) { - $marcrecord->field($tag)->add_subfields("$subfield" => $now) - } else { - my $newField = MARC::Field->new( - "$tag",'','', - "$subfield" => $now - ); - $marcrecord->insert_fields_ordered($newField); - } - } - NEWnewitem($dbh,$marcrecord,$bibid); - return 1; - } - return (0,@errors); - } -} =head2 HasSubscriptionExpired @@ -1380,7 +1227,7 @@ sub HasSubscriptionExpired { my $dbh = C4::Context->dbh; my $subscription = GetSubscription($subscriptionid); # we don't do the same test if the subscription is based on X numbers or on X weeks/months - if ($subscription->{numberlength}) { + if ($subscription->{numberlength} ) { my $query = qq| SELECT count(*) FROM serial @@ -1445,12 +1292,18 @@ this function delete the subscription which has $subscriptionid as id. =cut sub DelSubscription { - my ($subscriptionid) = @_; + my ($subscriptionid,$biblionumber) = @_; my $dbh = C4::Context->dbh; +## User may have subscriptionid stored in MARC so check and remove it +my $record=MARCgetbiblio($dbh,$biblionumber); +MARCkoha2marcOnefield( $record, "subscriptionid", "","biblios" ); +my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber); +NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode); $subscriptionid=$dbh->quote($subscriptionid); $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid"); $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid"); $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid"); + } =head2 DelIssue @@ -1799,7 +1652,7 @@ returns 0 - if not sub abouttoexpire { my ($subscriptionid) = @_; my $dbh = C4::Context->dbh; - my $subscription = getsubscription($subscriptionid); + my $subscription = GetSubscription($subscriptionid); # we don't do the same test if the subscription is based on X numbers or on X weeks/months if ($subscription->{numberlength}) { my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=? and planneddate>=?"); @@ -1839,172 +1692,7 @@ sub abouttoexpire { } } -=head2 old_newsubscription - -=over 4 - -($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber, - $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength, - $add1,$every1,$whenmorethan1,$setto1,$lastvalue1, - $add2,$every2,$whenmorethan2,$setto2,$lastvalue2, - $add3,$every3,$whenmorethan3,$setto3,$lastvalue3, - $numberingmethod, $status, $callnumber, $notes, $hemisphere) - -this function is similar to the NewSubscription subroutine but has a few different -values passed in -$firstacquidate - date of first serial issue to arrive -$irregularity - the issues not expected separated by a '|' -- eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7' -$numberpattern - the number for an array of labels to reconstruct the javascript correctly in the - alt_subscription-add.tmpl file -$callnumber - display the callnumber of the serial -$hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials - -return : -the $subscriptionid number of the new subscription - -=back -=cut -sub old_newsubscription { - my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber, - $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength, - $add1,$every1,$whenmorethan1,$setto1,$lastvalue1, - $add2,$every2,$whenmorethan2,$setto2,$lastvalue2, - $add3,$every3,$whenmorethan3,$setto3,$lastvalue3, - $numberingmethod, $status, $callnumber, $notes, $hemisphere) = @_; - my $dbh = C4::Context->dbh; - #save subscription - my $sth=$dbh->prepare("insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber, - startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength, - add1,every1,whenmorethan1,setto1,lastvalue1, - add2,every2,whenmorethan2,setto2,lastvalue2, - add3,every3,whenmorethan3,setto3,lastvalue3, - numberingmethod, status, callnumber, notes, hemisphere) values - (?,?,?,?,?,?,?,?,?,?,?, - ?,?,?,?,?,?,?,?,?,?,?, - ?,?,?,?,?,?,?,?,?,?,?,?)"); - $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber, - format_date_in_iso($startdate),$periodicity,format_date_in_iso($firstacquidate),$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength, - $add1,$every1,$whenmorethan1,$setto1,$lastvalue1, - $add2,$every2,$whenmorethan2,$setto2,$lastvalue2, - $add3,$every3,$whenmorethan3,$setto3,$lastvalue3, - $numberingmethod, $status,$callnumber, $notes, $hemisphere); - #then create the 1st waited number - my $subscriptionid = $dbh->{'mysql_insertid'}; - my $enddate = subscriptionexpirationdate($subscriptionid); - - $sth = $dbh->prepare("insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"); - $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes); - # reread subscription to get a hash (for calculation of the 1st issue number) - $sth = $dbh->prepare("select * from subscription where subscriptionid = ? "); - $sth->execute($subscriptionid); - my $val = $sth->fetchrow_hashref; - - # calculate issue number - my $serialseq = Get_Seq($val); - $sth = $dbh->prepare("insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"); - $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate)); - return $subscriptionid; -} - -=head2 old_modsubscription - -=over 4 - -($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber, - $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength, - $add1,$every1,$whenmorethan1,$setto1,$lastvalue1, - $add2,$every2,$whenmorethan2,$setto2,$lastvalue2, - $add3,$every3,$whenmorethan3,$setto3,$lastvalue3, - $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid) - -this function is similar to the ModSubscription subroutine but has a few different -values passed in -$firstacquidate - date of first serial issue to arrive -$irregularity - the issues not expected separated by a '|' -- eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7' -$numberpattern - the number for an array of labels to reconstruct the javascript correctly in the - alt_subscription-add.tmpl file -$callnumber - display the callnumber of the serial -$hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials - -=back - -=cut -sub old_modsubscription { - my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate, - $periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength, - $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1, - $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2, - $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3, - $numberingmethod, $status, $biblionumber, $callnumber, $notes, $hemisphere, $subscriptionid)= @_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?, - periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?, - add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?, - add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?, - add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?, - numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"); - $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate, - $periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength, - $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1, - $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2, - $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3, - $numberingmethod, $status, $biblionumber, $callnumber, $notes, $hemisphere, $subscriptionid); - $sth->finish; - - - $sth = $dbh->prepare("select * from subscription where subscriptionid = ? "); - $sth->execute($subscriptionid); - my $val = $sth->fetchrow_hashref; - - # calculate issue number - my $serialseq = Get_Seq($val); - $sth = $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?"); - $sth->execute($serialseq,$subscriptionid); - - my $enddate = subscriptionexpirationdate($subscriptionid); - $sth = $dbh->prepare("update subscriptionhistory set enddate=?"); - $sth->execute(format_date_in_iso($enddate)); -} - -=head2 old_getserials - -=over 4 - -($totalissues,@serials) = &old_getserials($subscriptionid) - -this function get a hashref of serials and the total count of them - -return : -$totalissues - number of serial lines -the serials into a table. Each line of this table containts a ref to a hash which it containts -serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5 - -=back - -=cut -sub old_getserials { - my ($subscriptionid) = @_; - my $dbh = C4::Context->dbh; - # status = 2 is "arrived" - my $sth=$dbh->prepare("select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"); - $sth->execute($subscriptionid); - my @serials; - my $num = 1; - while(my $line = $sth->fetchrow_hashref) { - $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list - $line->{"planneddate"} = format_date($line->{"planneddate"}); - $line->{"num"} = $num; - $num++; - push @serials,$line; - } - $sth=$dbh->prepare("select count(*) from serial where subscriptionid=?"); - $sth->execute($subscriptionid); - my ($totalissues) = $sth->fetchrow; - return ($totalissues,@serials); -} =head2 Get_Next_Date diff --git a/C4/Shelf.pm b/C4/Shelf.pm deleted file mode 100644 index c7487bc542..0000000000 --- a/C4/Shelf.pm +++ /dev/null @@ -1,476 +0,0 @@ -package Shelf; - -=head1 NAME - -Shelf - Perl extension for Virtual Bookshelves - -=cut - -use strict; -use C4::Context; -use Cache::FileCache; - -=head1 VERSION - - $Id$ - -=cut - -=head1 DESCRIPTION - -Module for querying and stocking Virtual Bookshelves - - 1. can contain a list of items, a list of biblioitems, or a list of biblios - 2. can have an arbitrary name, and will have a unique numerical identifier - 3. will have arbitrary metadata (properties) associated with it - * Sharing information (private, only visible by the owner of the - shelf; shared with a group of patrons; public, viewable by anybody) - * Special circulation rules - Do not return to home branch, do not - circulate, reduced loan time (ie 3 day loan) - * Search query term - if the shelf is the result of a query, the - query itself can be stored with the list of books that resulted - * Creation date - useful for 'retiring' a stale cached query result - * Access information - who has "write" or "read" access to the shelf. - * Searchable - If a patron can perform a search query on the contents - of this shelf - - -Patrons typically will only use "biblioitem" bookshelves, and will not need to -be presented with the differences between biblioitem and item bookshelves. - - -Some uses for VirtualBookshelves - - 1. Cache search results for faster response on popular searches - 2. Name search results so that patrons can pull up saved searches - 3. Creation of sub-collections within a library or branch - 4. replacing "itemtypes" field... this would allow an individual item to be - a member of more than one itemtype - 5. store a patron's reading record (if he chooses to store such data) - 6. store a patron's "To be read" list - 7. A teacher of a course could add a list of books to a shelf for his course - and ask that those items be marked non-circulating so students always - have access to them at the library. - * The teacher creates the list of materials that she wants to be - non-circulating (or reduced to 3-day loan) and marks them as such - * A librarian receives a notice that a shelf requires her attention. - He can pull up a list of the contents of the shelf, the owner of - the shelf, and the reason the owner is requesting this change in - circulation rules. The librarian can approve or deny the request. - * Optionally, create an access flag that grants teachers the right to - put items on modified circulation shelves without librarian - intervention. - - -=cut - -=head1 METHODS - -=head2 C - -Base constructor for the class. - - my $shelf=Shelf->new(56); - will load bookshelf 56. - my $shelf=Shelf->new(-name => 'Fiction'); - my $shelf=Shelf->new('Fiction'); - will load the internal 'Fiction' shelf - my $shelf=Shelf->new('Favourite Books', 'sjohnson'); - my $shelf=Shelf->new(-name => 'Favourite Books', -owner => 'sjohnson'); - will load sjohnson's "Favourite Books" bookshelf - - Any of the last four invocations will create a new shelf with the name and - owner given if one doesn't already exist. - - -=cut - -sub new { - my $self = {}; - $self->{ID} = undef; - $self->{NAME}=undef; - $self->{OWNDER}=undef; - $self->{BIBLIOCONTENTS}={}; - $self->{BIBLIOITEMCONTENTS}={}; - $self->{ITEMCONTENTS}={}; - $self->{ATTRIBUTES}={}; - $self->{CACHE}=new Cache::FileCache( { 'namespace' => 'KohaShelves' } ); - - if (@_) { - my $dbh=C4::Context->dbh(); - shift; - if ($#_ == 0) { - $self->{ID}=shift; - # load attributes of shelf #ID - my $sth; - $sth=$dbh->prepare("select bookshelfname,bookshelfowner from bookshelves where bookshelfid=?"); - $sth->execute($self->{ID}); - ($self->{NAME},$self->{OWNER}) = $sth->fetchrow; - $sth=$dbh->prepare("select attribute,value from bookshelfattributes where bookshelfid=?"); - $sth->execute($self->{ID}); - while (my ($attribute,$value) = $sth->fetchrow) { - $self->{ATTRIBUTES}->{$attribute}=$value; - } - } elsif ($#_) { - my ($name,$owner,$attributes); - if ($_[0] =~/^-/) { - my %params=@_; - $name=$params{name}; - $owner=$params{owner}; - $attributes=$params{attributes}; - } else { - $name=shift; - $owner=shift; - $attributes=shift; - } - my $sth=$dbh->prepare("select bookshelfid from bookshelves where bookshelfname=? and bookshelfowner=?"); - $sth->execute($name, $owner); - if ($sth->rows) { - ($self->{ID})=$sth->fetchrow; - $sth=$dbh->prepare("select attribute,value from bookshelfattributes where bookshelfid=?"); - $sth->execute($self->{ID}); - while (my ($attribute,$value) = $sth->fetchrow) { - $self->{ATTRIBUTES}->{$attribute}=$value; - } - } else { - $sth=$dbh->prepare("insert into bookshelves (bookshelfname, bookshelfowner) values (?, ?)"); - $sth->execute($name,$owner); - $sth=$dbh->prepare("select bookshelfid from bookshelves where bookshelfname=? and bookshelfowner=?"); - $sth->execute($name,$owner); - ($self->{ID})=$sth->fetchrow(); - foreach my $attribute (keys %$attributes) { - my $value=$attributes->{$attribute}; - $self->attribute($attribute,$value); - } - } - } - } - bless($self); - return $self; -} - - -=head2 C - -retrieve a slice of itemnumbers from a shelf. - - my $arrayref = $shelf->itemcontents(-orderby=>'title', - -startat=>50, - -number=>10 ); - -=cut - -sub itemcontents { - my $self=shift; - my ($orderby,$startat,$number); - if ($_[0]=~/^\-/) { - my %params=@_; - $orderby=$params{'-orderby'}; - $startat=$params{'-startat'}; - $number=$params{'-number'}; - } else { - ($orderby,$startat,$number)=@_; - } - $number--; - unless ($self->{ITEMCONTENTS}->{orderby}->{$orderby}) { - $self->loadcontents(-orderby=>$orderby, -startat=>$startat, -number=>$number); - } - my $endat=$startat+$number; - my @return; - foreach (@{$self->{ITEMCONTENTS}->{orderby}->{$orderby}}[$startat..$endat]) { - push @return,$_; - } - return \@return; -} - -=head2 C - -retrieve a slice of biblioitemnumbers from a shelf. - - my $arrayref = $shelf->biblioitemcontents(-orderby=>'title', - -startat=>50, - -number=>10 ); - -=cut - -sub biblioitemcontents { - my $self=shift; - my ($orderby,$startat,$number); - if ($_[0]=~/^\-/) { - my %params=@_; - $orderby=$params{'-orderby'}; - $startat=$params{'-startat'}; - $number=$params{'-number'}; - } else { - ($orderby,$startat,$number)=@_; - } - unless ($self->{BIBLIOITEMCONTENTS}->{orderby}->{$orderby}) { - $self->loadcontents(-orderby=>$orderby, -startat=>$startat, -number=>$number); - } - my $endat=$startat+$number; - my @return; - foreach (@{$self->{BIBLIOITEMCONTENTS}->{orderby}->{$orderby}}[$startat..$endat]) { - push @return,$_; - } - return \@return; -} - -=head2 C - -retrieve a slice of biblionumbers from a shelf. - - my $arrayref = $shelf->bibliocontents(-orderby=>'title', - -startat=>50, - -number=>10 ); - -=cut - -sub bibliocontents { - my $self=shift; - my ($orderby,$startat,$number); - if ($_[0]=~/^\-/) { - my %params=@_; - $orderby=$params{'-orderby'}; - $startat=$params{'-startat'}; - $number=$params{'-number'}; - } else { - ($orderby,$startat,$number)=@_; - } - unless ($self->{BIBLIOCONTENTS}->{orderby}->{$orderby}) { - $self->loadcontents(-orderby=>$orderby, -startat=>$startat, -number=>$number); - } - my $endat=$startat+$number; - my @return; - foreach (@{$self->{BIBLIOCONTENTS}->{orderby}->{$orderby}}[$startat..$endat]) { - push @return,$_; - } - return \@return; -} - - -=head2 C - -returns the number of items on the shelf - - my $itemcount=$shelf->itemcounter(); - -=cut -sub itemcounter { - my $self=shift; - unless ($self->{ITEMCONTENTS}->{orderby}->{'natural'}) { - $self->loadcontents(); - } - my @temparray=@{$self->{ITEMCONTENTS}->{orderby}->{'natural'}}; - return $#temparray+1; -} - -sub shelfcontents { - my $self=shift; -} - - -=head2 C - -Removes all contents from the shelf. - - $shelf->clearcontents(); - -=cut - -sub clearcontents { - my $self=shift; - my $dbh=C4::Context->dbh(); - my $sth=$dbh->prepare("delete from bookshelfcontents where bookshelfid=?"); - $sth->execute($self->{ID}); - foreach my $level ('ITEM', 'BIBLIOITEM', 'BIBLIO') { - delete $self->{$level."CONTENTS"}; - $self->{$level."CONTENTS"}={}; - } - $self->clearcache(); - -} - - - -=head2 C - -adds an array of items to a shelf. If any modifications are actually made to -the shelf then the per process caches and the FileCache for that shelf are -cleared. - - $shelf->addtoshelf(-add => [[ 45, 54, 67], [69, 87, 143]]); - -=cut - -sub addtoshelf { - my $self=shift; - my $add; - if ($_[0]=~/^\-/) { - my %params=@_; - $add=$params{'-add'}; - } else { - ($add)=@_; - } - my $dbh=C4::Context->dbh(); - my $sth; - my $bookshelfid=$self->{ID}; - my $clearcache=0; - foreach (@$add) { - my ($biblionumber,$biblioitemnumber,$itemnumber) = @$_; - $sth=$dbh->prepare("select count(*) from bookshelfcontents where bookshelfid=? and itemnumber=? and biblioitemnumber=? and biblionumber=?"); - $sth->execute($bookshelfid,$itemnumber,$biblioitemnumber,$biblionumber); - my $rows=$sth->fetchrow(); - if ($rows==0) { - $sth=$dbh->prepare("insert into bookshelfcontents (bookshelfid,biblionumber,biblioitemnumber,itemnumber) values (?,?,?,?)"); - $sth->execute($bookshelfid,$biblionumber,$biblioitemnumber,$itemnumber); - $clearcache=1; - } - } - ($clearcache) && ($self->clearcache()); -} - - -sub removefromshelf { - my $self=shift; -} - -=head2 C - -Returns or sets the value of a given attribute for the shelf. - - my $loanlength=$shelf->attribute('loanlength'); - $shelf->attribute('loanlength', '21 days'); - - -=cut - -sub attribute { - my $self=shift; - my ($attribute, $value); - $attribute=shift; - $value=shift; - if ($value) { - $self->{ATTRIBUTES}->{$attribute}=$value; - my $dbh=C4::Context->dbh(); - my $sth=$dbh->prepare("select value from bookshelfattributes where bookshelfid=? and attribute=?"); - $sth->execute($self->{ID}, $attribute); - if ($sth->rows) { - my $sti=$dbh->prepare("update bookshelfattributes set value=? where bookshelfid=? and attribute=?"); - $sti->execute($value, $self->{ID}, $attribute); - } else { - my $sti=$dbh->prepare("insert into bookshelfattributes (bookshelfid, attribute, value) values (?, ?, ?)"); - $sti->execute($self->{ID}, $attribute, $value); - } - } - return $self->{ATTRIBUTES}->{$attribute}; -} - - -=head2 C - -Returns a hash reference of the shelf attributes - - my $attributes=$shelf->attributes(); - my $loanlength=$attributes->{loanlength}; - -=cut - -sub attributes { - my $self=shift; - return $self->{ATTRIBUTES}; -} - -=head2 C - -Clears the per process in-memory cache and the FileCache if any changes are -made to a shelf. - - $shelf->clearshelf(); - -=cut - -sub clearcache { - my $self=shift; - foreach my $level ('ITEM','BIBLIOITEM','BIBLIO') { - delete $self->{$level."CONTENTS"}; - foreach my $sorttype (('author', 'title')) { - $self->{CACHE}->remove($self->{ID}."_".$level."CONTENTS_".$sorttype); - } - } -} - - -=head2 C - -loads the contents of a particular shelf and loads into a per process memory -cache as well as a shared Cache::FileCache. - -This subroutine is normally only used internally (called by itemcontents, -biblioitemcontents, or bibliocontents). - - $shelf->loadcontents(-orderby => 'author', -startat => 30, -number => 10); - - -=cut - -sub loadcontents { - my $self=shift; - my ($orderby,$startat,$number); - if ($_[0]=~/^\-/) { - my %params=@_; - $orderby=$params{'-orderby'}; - $startat=$params{'-startat'}; - $number=$params{'-number'}; - } else { - ($orderby,$startat,$number)=@_; - } - my $bookshelfid=$self->{ID}; - ($orderby) || ($orderby='natural'); - $self->{ITEMCONTENTS}->{orderby}->{$orderby}=$self->{CACHE}->get( "$bookshelfid\_ITEMCONTENTS_$orderby" ); - $self->{BIBLIOITEMCONTENTS}->{orderby}->{$orderby}=$self->{CACHE}->get( "$bookshelfid\_BIBLIOITEMCONTENTS_$orderby" ); - $self->{BIBLIOCONTENTS}->{orderby}->{$orderby}=$self->{CACHE}->get( "$bookshelfid\_BIBLIOCONTENTS_$orderby" ); - if ( defined $self->{ITEMCONTENTS}->{orderby}->{$orderby}) { - return; - } - my $dbh=C4::Context->dbh(); - my $sth; - my $limit=''; - if ($startat && $number) { - $limit="limit $startat,$number"; - } - $limit=''; - my $biblionumbers; - my $biblioitemnumbers; - if ($orderby eq 'author') { - $sth=$dbh->prepare("select itemnumber,BSC.biblionumber,BSC.biblioitemnumber from bookshelfcontents BSC, biblio B where BSC.biblionumber=B.biblionumber and bookshelfid=? order by B.author $limit"); - } elsif ($orderby eq 'title') { - $sth=$dbh->prepare("select itemnumber,BSC.biblionumber,BSC.biblioitemnumber from bookshelfcontents BSC, biblio B where BSC.biblionumber=B.biblionumber and bookshelfid=? order by B.title $limit"); - } else { - $sth=$dbh->prepare("select itemnumber,biblionumber,biblioitemnumber from bookshelfcontents where bookshelfid=? $limit"); - } - $sth->execute($bookshelfid); - my @results; - my @biblioresults; - my @biblioitemresults; - while (my ($itemnumber,$biblionumber,$biblioitemnumber) = $sth->fetchrow) { - unless ($biblionumbers->{$biblionumber}) { - $biblionumbers->{$biblionumber}=1; - push @biblioresults, $biblionumber; - } - unless ($biblioitemnumbers->{$biblioitemnumber}) { - $biblioitemnumbers->{$biblioitemnumber}=1; - push @biblioitemresults, $biblioitemnumber; - } - push @results, $itemnumber; - } - $self->{CACHE}->set("$bookshelfid\_ITEMCONTENTS_$orderby", \@results, "3 hours"); - $self->{CACHE}->set("$bookshelfid\_BIBLIOITEMCONTENTS_$orderby", \@results, "3 hours"); - $self->{CACHE}->set("$bookshelfid\_BIBLIOCONTENTS_$orderby", \@results, "3 hours"); - $self->{ITEMCONTENTS}->{orderby}->{$orderby}=\@results; - $self->{BIBLIOOCONTENTS}->{orderby}->{$orderby}=\@biblioresults; - $self->{BIBLIOITEMCONTENTS}->{orderby}->{$orderby}=\@biblioitemresults; -} - - - -1; diff --git a/C4/Stats.pm b/C4/Stats.pm index 838dae0479..f9b7b2dca4 100644 --- a/C4/Stats.pm +++ b/C4/Stats.pm @@ -1,7 +1,7 @@ package C4::Stats; # $Id$ - +# Modified by TG # Copyright 2000-2002 Katipo Communications # # This file is part of Koha. @@ -21,14 +21,12 @@ package C4::Stats; use strict; require Exporter; -use DBI; + use C4::Context; use vars qw($VERSION @ISA @EXPORT); # set the version for version checking -$VERSION = $VERSION = do { my @v = '$Revision$' =~ /\d+/g; - shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); -}; +$VERSION = 0.01; =head1 NAME @@ -49,10 +47,9 @@ the Koha database, which acts as an activity log. =cut -@ISA = qw(Exporter); +@ISA = qw(Exporter); @EXPORT = qw(&UpdateStats &statsreport &TotalOwing - &TotalPaid &getcharges &Getpaidbranch &unfilledreserves &getcredits - getrefunds); +&TotalPaid &getcharges &Getpaidbranch &unfilledreserves &getcredits &getinvoices); =item UpdateStats @@ -72,217 +69,165 @@ C<$env-E{branchcode}>. C<$env-E{usercode}> specifies the value of the C field. =cut - #' sub UpdateStats { - - #module to insert stats data into stats table - my ( - $env, $branch, $type, - $amount, $other, $itemnum, - $itemtype, $borrowernumber, $accountno - ) - = @_; - my $dbh = C4::Context->dbh; - if ( $branch eq '' ) { - $branch = $env->{'branchcode'}; - } - my $user = $env->{'usercode'}; - my $organisation = $env->{'organisation'}; - print $borrowernumber; - - # FIXME - Use $dbh->do() instead - my $sth = $dbh->prepare( - "Insert into statistics (datetime,branch,type,usercode,value, - other,itemnumber,itemtype,borrowernumber,proccode,associatedborrower) values (now(),?,?,?,?,?,?,?,?,?,?)" - ); - $sth->execute( - $branch, $type, $user, $amount, - $other, $itemnum, $itemtype, $borrowernumber, - $accountno, $organisation - ); - $sth->finish; + #module to insert stats data into stats table + my ($env,$branch,$type,$amount,$other,$itemnum,$itemtype,$borrowernumber,$accountno)=@_; + my $dbh = C4::Context->dbh; + if ($branch eq ''){ + $branch=$env->{'branchcode'}; + } + my $user = $env->{'usercode'}; + print $borrowernumber; + # FIXME - Use $dbh->do() instead + my $sth=$dbh->prepare("Insert into statistics (datetime,branch,type,usercode,value, + other,itemnumber,itemtype,borrowernumber,proccode) values (now(),?,?,?,?,?,?,?,?,?)"); + $sth->execute($branch,$type,$user,$amount,$other,$itemnum,$itemtype,$borrowernumber,$accountno); + $sth->finish; } # Otherwise, it'd need a POD. sub TotalPaid { - my ( $time, $time2, $spreadsheet ) = @_; - $time2 = $time unless $time2; - my $dbh = C4::Context->dbh; - my $query = "SELECT * FROM statistics,borrowers - WHERE statistics.borrowernumber= borrowers.borrowernumber - AND (statistics.type='payment' OR statistics.type='writeoff') "; - if ( $time eq 'today' ) { - $query = $query . " AND datetime = now()"; - } - else { - $query .= " AND datetime > '$time'"; - } - if ( $time2 ne '' ) { - $query .= " AND datetime < '$time2'"; - } - if ($spreadsheet) { - $query .= " ORDER BY branch, type"; - } - my $sth = $dbh->prepare($query); - $sth->execute(); - my @results; - while ( my $data = $sth->fetchrow_hashref ) { - push @results, $data; - } - $sth->finish; - return (@results); + my ($time,$time2)=@_; + $time2=$time unless $time2; + my $dbh = C4::Context->dbh; + + + my $query="Select * from accountlines,borrowers where (accounttype = 'Pay' or accounttype='W') + and accountlines.borrowernumber = borrowers.borrowernumber"; + my @bind = (); + if ($time eq 'today'){ + $query .= " and date = now()"; + } else { + $query.=" and date>=? and date<=?"; + @bind = ($time,$time2); + } + + + + + $query.=" order by timestamp"; + + # print $query; + + my $sth=$dbh->prepare($query); + + # $sth->execute(); + $sth->execute(@bind); + my @results; + my $i=0; + while (my $data=$sth->fetchrow_hashref){ + $results[$i]=$data; + $i++; + } + $sth->finish; + # print $query; + return(@results); } # Otherwise, it needs a POD. -sub getcharges { - my ( $borrowerno, $timestamp, $accountno ) = @_; - my $dbh = C4::Context->dbh; - my $timestamp2 = $timestamp - 1; - my $query = ""; - my $sth; - - # getcharges is now taking accountno. as an argument - if ($accountno) { - $sth = $dbh->prepare( - "Select * from accountlines where borrowernumber=? - and accountno = ?" - ); - $sth->execute( $borrowerno, $accountno ); +sub getcharges{ + my($borrowerno,$offset,$accountno)=@_; + my $dbh = C4::Context->dbh; + my $query=""; + my $sth; + + # getcharges is now taking accountno. as an argument + if ($offset){ + $sth=$dbh->prepare("Select * from accountlines where borrowernumber=? + and accountno = ? and amount>0"); + $sth->execute($borrowerno,$offset); # this bit left in for old 2 arg usage of getcharges - } - else { - $sth = $dbh->prepare( - "Select * from accountlines where borrowernumber=? - and timestamp = ? and accounttype <> 'Pay' and - accounttype <> 'W'" - ); - $sth->execute( $borrowerno, $timestamp ); - } - - # print $query,"
"; - my $i = 0; - my @results; - while ( my $data = $sth->fetchrow_hashref ) { - + } else { + $sth=$dbh->prepare("Select * from accountlines where borrowernumber=? + and accountno = ?"); + $sth->execute($borrowerno,$accountno); + } + + # print $query,"
"; + my $i=0; + my @results; + while (my $data=$sth->fetchrow_hashref){ # if ($data->{'timestamp'} == $timestamp){ - $results[$i] = $data; - $i++; - + $results[$i]=$data; + $i++; # } - } - return (@results); + } + return(@results); } # Otherwise, it needs a POD. -sub getcredits { - my ( $date, $date2 ) = @_; - my $dbh = C4::Context->dbh; - - #takes date converts to timestamps - my $padding = "000000"; - ( my $a, my $b, my $c ) = unpack( "A4 x1 A2 x1 A2", $date ); - ( my $x, my $y, my $z ) = unpack( "A4 x1 A2 x1 A2", $date2 ); - my $timestamp = $a . $b . $c . $padding; - my $timestamp2 = $x . $y . $z . $padding; - - my $sth = $dbh->prepare( -"Select * from accountlines,borrowers where (((accounttype = 'LR') or (accounttype <> 'Pay')) +sub getcredits{ + my ($date,$date2)=@_; + my $dbh = C4::Context->dbh; + + + + my $sth=$dbh->prepare("Select * from accountlines,borrowers where (( (accounttype <> 'Pay')) and amount < 0 and accountlines.borrowernumber = borrowers.borrowernumber - and timestamp >=? and timestamp execute( $timestamp, $timestamp2 ); - - my $i = 0; - my @results; - while ( my $data = $sth->fetchrow_hashref ) { - $results[$i] = $data; - $i++; - } - return (@results); + and date >=? and date <=?)"); + $sth->execute($date, $date2); + + my $i=0; + my @results; + while (my $data=$sth->fetchrow_hashref){ + $results[$i]=$data; + $i++; + } + return(@results); } -sub getrefunds { - my ( $date, $date2 ) = @_; - my $dbh = C4::Context->dbh; - - #takes date converts to timestamps - my $padding = "000000"; - ( my $a, my $b, my $c ) = unpack( "A4 x1 A2 x1 A2", $date ); - ( my $x, my $y, my $z ) = unpack( "A4 x1 A2 x1 A2", $date2 ); - my $timestamp = $a . $b . $c . $padding; - my $timestamp2 = $x . $y . $z . $padding; - - my $sth = $dbh->prepare( -"Select * from accountlines,borrowers where (accounttype = 'REF' - and accountlines.borrowernumber = borrowers.borrowernumber - and timestamp >=? and timestamp execute( $timestamp, $timestamp2 ); - - my @results; - while ( my $data = $sth->fetchrow_hashref ) { - push @results, $data; - } - return (@results); +sub getinvoices{ + my ($date,$date2)=@_; + my $dbh = C4::Context->dbh; + my $sth=$dbh->prepare("Select * from accountlines,borrowers where amount>0 and amountoutstanding > 0 and accountlines.borrowernumber = borrowers.borrowernumber + and (date >=? and date <=?)"); + $sth->execute($date, $date2); + + my $i=0; + my @results; + while (my $data=$sth->fetchrow_hashref){ + $results[$i]=$data; + $i++; + } + return(@results); } + # Otherwise, this needs a POD. -sub Getpaidbranch { - my ( $date, $borrno ) = @_; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( -"select * from statistics where type='payment' and datetime >? and borrowernumber=?" - ); - $sth->execute( $date, $borrno ); - - # print $query; - my $data = $sth->fetchrow_hashref; - $sth->finish; - return ( $data->{'branch'} ); +sub Getpaidbranch{ + my($date,$borrno)=@_; + my $dbh = C4::Context->dbh; + my $sth=$dbh->prepare("select * from statistics where type='payment' and datetime >? and borrowernumber=?"); + $sth->execute($date,$borrno); + # print $query; + my $data=$sth->fetchrow_hashref; + $sth->finish; + return($data->{'branch'}); } # FIXME - This is only used in reservereport.pl and reservereport.xls, # neither of which is used. # Otherwise, it needs a POD. sub unfilledreserves { - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( -"select *,biblio.title from reserves,reserveconstraints,biblio,borrowers,biblioitems where (found <> 'F' or - found is NULL) and cancellationdate - is NULL and biblio.biblionumber=reserves.biblionumber and - reserves.constrainttype='o' - and (reserves.biblionumber=reserveconstraints.biblionumber - and reserves.borrowernumber=reserveconstraints.borrowernumber) - and - reserves.borrowernumber=borrowers.borrowernumber and - biblioitems.biblioitemnumber=reserveconstraints.biblioitemnumber order by - biblio.title,reserves.reservedate" - ); - $sth->execute; - my $i = 0; - my @results; - while ( my $data = $sth->fetchrow_hashref ) { - $results[$i] = $data; - $i++; - } - $sth->finish; - $sth = $dbh->prepare( -"select *,biblio.title from reserves,biblio,borrowers where (found <> 'F' or found is NULL) and cancellationdate - is NULL and biblio.biblionumber=reserves.biblionumber and reserves.constrainttype='a' and + my $dbh = C4::Context->dbh; + + my $i=0; + my @results; + + my $sth=$dbh->prepare("select *,biblio.title from reserves,biblio,borrowers where (found <> '1' or found is NULL) and cancellationdate + is NULL and biblio.biblionumber=reserves.biblionumber and reserves.borrowernumber=borrowers.borrowernumber order by - biblio.title,reserves.reservedate" - ); - $sth->execute; - while ( my $data = $sth->fetchrow_hashref ) { - $results[$i] = $data; - $i++; - } - $sth->finish; - return ( $i, \@results ); + reserves.reservedate,biblio.title"); + $sth->execute; + while (my $data=$sth->fetchrow_hashref){ + $results[$i]=$data; + $i++; + } + $sth->finish; + return($i,\@results); } 1; diff --git a/C4/Stock.pm b/C4/Stock.pm deleted file mode 100644 index 76e0a5531a..0000000000 --- a/C4/Stock.pm +++ /dev/null @@ -1,50 +0,0 @@ -package C4::Stock; - - -# Copyright 2000-2002 Katipo Communications -# -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. -# -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA - -use strict; -require Exporter; - -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); -use C4::Context; - -# set the version for version checking -$VERSION = 0.01; - -@ISA = qw(Exporter); -@EXPORT = qw(&stockreport); - -# FIXME - This function is only used in reports.pl, which in turn is -# never used. This function (and therefore this module) is probably -# obsolete. -sub stockreport { - my $dbh = C4::Context->dbh; - my @results; - my $sth=$dbh->prepare("Select count(*) from items where homebranch='C'"); - $sth->execute; - my $count=$sth->fetchrow_hashref; - $results[0]->{'value'}="$count->{'count'}\t Levin"; - $sth->finish; - $sth=$dbh->prepare("Select count(*) from items where homebranch='F'"); - $sth->execute; - $count=$sth->fetchrow_hashref; - $results[1]->{'value'}="$count->{'count'}\t Foxton"; - $sth->finish; - return(@results); -} diff --git a/C4/Suggestions.pm b/C4/Suggestions.pm index bf05e4e4c0..351119cd91 100644 --- a/C4/Suggestions.pm +++ b/C4/Suggestions.pm @@ -21,7 +21,6 @@ package C4::Suggestions; use strict; require Exporter; -use DBI; use C4::Context; use C4::Output; use Mail::Sendmail; @@ -382,6 +381,7 @@ sub ModStatus { $sth = $dbh->prepare($queryMail); $sth->execute($suggestionid); my $emailinfo = $sth->fetchrow_hashref; +if ($emailinfo->{byemail}){ my $template = gettemplate("suggestion/mail_suggestion_$status.tmpl","intranet"); $template->param( @@ -403,6 +403,7 @@ sub ModStatus { ); sendmail(%mail); } +} =head2 ConnectSuggestionAndBiblio diff --git a/C4/UTF8DBI.pm b/C4/UTF8DBI.pm new file mode 100644 index 0000000000..f061d0e12e --- /dev/null +++ b/C4/UTF8DBI.pm @@ -0,0 +1,25 @@ +# UTF8DBI.pm re-implementation by Pavel Kudinov http://search.cpan.org/~kudinov/ +# originally from: http://dysphoria.net/code/perl-utf8/ + +package UTF8DBI ; use base DBI ; +package UTF8DBI::db; use base DBI::db; +package UTF8DBI::st; use base DBI::st; + +sub _utf8_() { + use Encode; + if (ref $_ eq 'ARRAY'){ _utf8_() foreach @$_ } + elsif (ref $_ eq 'HASH' ){ _utf8_() foreach values %$_ } + else { Encode::_utf8_on($_) }; + $_; +}; + +sub fetch { return _utf8_ for shift->SUPER::fetch (@_) }; +sub fetchrow_arrayref { return _utf8_ for shift->SUPER::fetchrow_arrayref(@_) }; +sub fetchrow_hashref { return _utf8_ for shift->SUPER::fetchrow_hashref (@_) }; +sub fetchall_arrayref { return _utf8_ for shift->SUPER::fetchall_arrayref(@_) }; +sub fetchall_hashref { return _utf8_ for shift->SUPER::fetchall_hashref (@_) }; +sub fetchcol_arrayref { return _utf8_ for shift->SUPER::fetchcol_arrayref(@_) }; + +sub fetchrow_array { @{shift-> fetchrow_arrayref(@_)} }; + +1; diff --git a/C4/Z3950.pm b/C4/Z3950.pm index f6f2948080..a1b11312f2 100755 --- a/C4/Z3950.pm +++ b/C4/Z3950.pm @@ -29,10 +29,9 @@ package C4::Z3950; use strict; # standard or CPAN modules used -use DBI; # Koha modules used -use C4::Database; +use C4::Context; use C4::Input; use C4::Biblio; @@ -306,6 +305,17 @@ Koha Developement team #-------------------------------------- # $Log$ +# Revision 1.11 2006/08/25 21:07:08 tgarip1957 +# New set of routines for HEAD. +# Uses a complete new ZEBRA Indexing. +# ZEBRA is now XML and comprises of a KOHA meta record. Explanatory notes will be on koha-devel +# Fixes UTF8 problems +# Fixes bug with authorities +# SQL database major changes. +# Separate biblioograaphic and holdings records. Biblioitems table depreceated +# etc. etc. +# Wait for explanatory document on koha-devel +# # Revision 1.10 2003/10/01 15:08:14 tipaul # fix fog bug #622 : processz3950queue fails # diff --git a/C4/tests/Record_test.pl b/C4/tests/Record_test.pl deleted file mode 100755 index 7b76fc6b02..0000000000 --- a/C4/tests/Record_test.pl +++ /dev/null @@ -1,142 +0,0 @@ -#!/usr/bin/perl -# -# Copyright 2006 (C) LibLime -# Joshua Ferraro -# -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. -# -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA -# -# $Id$ -# -use strict; use warnings; #FIXME: turn off warnings before release - -# specify the number of tests -use Test::More tests => 23; -#use C4::Context; -use C4::Record; - -=head1 NAME - -Record_test.pl - test suite for Record.pm - -=head1 SYNOPSIS - -$ export KOHA_CONF=/path/to/koha.conf -$ ./Record_test.pl - -=cut - -## FIXME: Preliminarily grab the modules dir so we can run this in context - -ok (1, 'module compiled'); - -# open some files for testing -open MARC21MARC8,"testrecords/marc21_marc8.dat" or die $!; -my $marc21_marc8; # = scalar (MARC21MARC8); -foreach my $line () { - $marc21_marc8 .= $line; -} -$marc21_marc8 =~ s/\n$//; -close MARC21MARC8; - -open (MARC21UTF8,"<:utf8","testrecords/marc21_utf8.dat") or die $!; -my $marc21_utf8; -foreach my $line () { - $marc21_utf8 .= $line; -} -$marc21_utf8 =~ s/\n$//; -close MARC21UTF8; - -open MARC21MARC8COMBCHARS,"testrecords/marc21_marc8_combining_chars.dat" or die $!; -my $marc21_marc8_combining_chars; -foreach my $line() { - $marc21_marc8_combining_chars.=$line; -} -$marc21_marc8_combining_chars =~ s/\n$//; #FIXME: why is a newline ending up here? -close MARC21MARC8COMBCHARS; - -open (MARC21UTF8COMBCHARS,"<:utf8","testrecords/marc21_utf8_combining_chars.dat") or die $!; -my $marc21_utf8_combining_chars; -foreach my $line() { - $marc21_utf8_combining_chars.=$line; -} -close MARC21UTF8COMBCHARS; - -open (MARCXMLUTF8,"<:utf8","testrecords/marcxml_utf8.xml") or die $!; -my $marcxml_utf8; -foreach my $line () { - $marcxml_utf8 .= $line; -} -close MARCXMLUTF8; - -$marcxml_utf8 =~ s/\n//g; - -## The Tests: -my $error; my $marc; my $marcxml; my $dcxml; # some scalars to store values -## MARC to MARCXML -print "\n1. Checking conversion of simple ISO-2709 (MARC21) records to MARCXML\n"; -ok (($error,$marcxml) = marc2marcxml($marc21_marc8,'UTF-8','MARC21'), 'marc2marcxml - from MARC-8 to UTF-8 (MARC21)'); -ok (!$error, 'no errors in conversion'); - $marcxml =~ s/\n//g; - $marcxml =~ s/v\/ s/v\/s/g; # FIXME: bug in new_from_xml_record!! -is ($marcxml,$marcxml_utf8, 'record matches antitype'); - -ok (($error,$marcxml) = marc2marcxml($marc21_utf8,'UTF-8','MARC21'), 'marc2marcxml - from UTF-8 to UTF-8 (MARC21)'); -ok (!$error, 'no errors in conversion'); - $marcxml =~ s/\n//g; - $marcxml =~ s/v\/ s/v\/s/g; -is ($marcxml,$marcxml_utf8, 'record matches antitype'); - -print "\n2. checking binary MARC21 records with combining characters to MARCXML\n"; -ok (($error,$marcxml) = marc2marcxml($marc21_marc8_combining_chars,'MARC-8','MARC21'), 'marc2marcxml - from MARC-8 to MARC-8 with combining characters(MARC21)'); -ok (!$error, 'no errors in conversion'); - -ok (($error,$marcxml) = marc2marcxml($marc21_marc8_combining_chars,'UTF-8','MARC21'), 'marc2marcxml - from MARC-8 to UTF-8 with combining characters (MARC21)'); -ok (!$error, 'no errors in conversion'); - -ok (($error,$marcxml) = marc2marcxml($marc21_utf8_combining_chars,'UTF-8','MARC21'), 'marc2marcxml - from UTF-8 to UTF-8 with combining characters (MARC21)'); -ok (!$error, 'no errors in conversion'); - -ok (($error,$dcxml) = marc2dcxml($marc21_utf8), 'marc2dcxml - from ISO-2709 to Dublin Core'); -ok (!$error, 'no errors in conversion'); - -print "\n3. checking ability to alter encoding\n"; -ok (($error,$marc) = changeEncoding($marc21_marc8,'MARC','MARC21','UTF-8'), 'changeEncoding - MARC21 from MARC-8 to UTF-8'); -ok (!$error, 'no errors in conversion'); - -ok (($error,$marc) = changeEncoding($marc21_utf8,'MARC','MARC21','MARC-8'), 'changeEncoding - MARC21 from UTF-8 to MARC-8'); -ok (!$error, 'no errors in conversion'); - -ok (($error,$marc) = changeEncoding($marc21_marc8,'MARC','MARC21','MARC-8'), 'changeEncoding - MARC21 from MARC-8 to MARC-8'); -ok (!$error, 'no errors in conversion'); - -ok (($error,$marc) = changeEncoding($marc21_utf8,'MARC','MARC21','UTF-8'), 'changeEncoding - MARC21 from UTF-8 to UTF-8'); -ok (!$error, 'no errors in conversion'); - -__END__ - -=head1 TODO - -Still lots more to test including UNIMARC support - -=head1 AUTHOR - -Joshua Ferraro - -=head1 MODIFICATIONS - -# $Id$ - -=cut diff --git a/C4/tests/testrecords/marc21_marc8.dat b/C4/tests/testrecords/marc21_marc8.dat deleted file mode 100644 index ac1f8dd851..0000000000 --- a/C4/tests/testrecords/marc21_marc8.dat +++ /dev/null @@ -1 +0,0 @@ -00463 2200169 450000100060000000300050000600500170001100800410002802000150006909000150008410000340009924500510013325000250018465000220020994200250023195200370025684893ACLS19990324000000.0930421s19xx xxu 00010 eng d a0854562702 c1738d17381 aChristie, Agatha,d1890-1976.10aWhy didn't they ask Evans? /cAgatha Christie. aLarge print edition. 0aLarge type books. aONecLPkLP Christie bNPLp31000000010273r12.00u2148 diff --git a/C4/tests/testrecords/marc21_marc8_combining_chars.dat b/C4/tests/testrecords/marc21_marc8_combining_chars.dat deleted file mode 100644 index 0991ec90da..0000000000 --- a/C4/tests/testrecords/marc21_marc8_combining_chars.dat +++ /dev/null @@ -1 +0,0 @@ -01442cam 2200373 a 4500001001300000003000600013005001700019008004100036010001700077040002500094016001900119020004200138029002100180050002800201082002300229084001500252092001700267049000800284245015300292260007900445300002800524440015300552500003000705500002200735650005600757650007000813650005700883650002500940650002100965650002500986700003001011942001501041994001201056ocm11030895 OCoLC20060516100102.0840720s1984 ne b 001 0 eng  a 83048926  aDLCcDLCdMUQdNLGGC aB84431862bccb a0800606035 (Fortress Press) :c$35.951 aNLGGCb84037516600aBM485b.L57 1984 vol. 200a296.1 sa296.1219 a11.372bcl0 a296.1bST66  aWN300aJewish writings of the Second Temple period :bApocrypha, Pseudepigrapha, Qumran, sectarian writings, Philo, Josephus /cedited by Michael E. Stone. aAssen, Netherlands :bVan Gorcum ;aPhiladelphia :bFortress Press,c1984. axxiii, 697 p. ;c25 cm. 0aCompendia rerum Iudaicarum ad Novum Testamentum.nSection 2,pLiterature of the Jewish people in the period of the Second Temple and the Talmud ;v2 aBibliography: p. 603-653. aIncludes indexes. 0aJewish religious literaturexHistory and criticism. 0aJudaismxHistoryyPost-exilic period, 586 B.C.-210 A.D.xSources. 6aLittâerature religieuse juivexHistoire et critique.17aOude Testament.2gtt17aApocriefen.2gtt17aDode-Zeerollen.2gtt1 aStone, Michael E.,d1938- k296.1 ST66 aC0bWN3 diff --git a/C4/tests/testrecords/marc21_marc8_errors.dat b/C4/tests/testrecords/marc21_marc8_errors.dat deleted file mode 100644 index f7ea2aaf0c..0000000000 --- a/C4/tests/testrecords/marc21_marc8_errors.dat +++ /dev/null @@ -1 +0,0 @@ -00462 2200169 450000100060000000300050000600500170001100800410002802000150006909000150008410000340009924500510013325000250018465000220020994200250023195200370025684893ACLS19990324000000.0930421s19xx xxu 00010 eng d a0854562702 c1738d17381 aChristie, Agatha,d1890-1976.10aWhy didn't they ask Evans? /cAgatha Christie. aLarge print edition. 0aLarge type books. aONecLPkLP Christie bNPLp31000000010273r12.00u2148 diff --git a/C4/tests/testrecords/marc21_utf8.dat b/C4/tests/testrecords/marc21_utf8.dat deleted file mode 100644 index 0061c846bc..0000000000 --- a/C4/tests/testrecords/marc21_utf8.dat +++ /dev/null @@ -1 +0,0 @@ -00463 a2200169 450000100060000000300050000600500170001100800410002802000150006909000150008410000340009924500510013325000250018465000220020994200250023195200370025684893ACLS19990324000000.0930421s19xx xxu 00010 eng d a0854562702 c1738d17381 aChristie, Agatha,d1890-1976.10aWhy didn't they ask Evans? /cAgatha Christie. aLarge print edition. 0aLarge type books. aONecLPkLP Christie bNPLp31000000010273r12.00u2148 \ No newline at end of file diff --git a/C4/tests/testrecords/marc21_utf8_combining_chars.dat b/C4/tests/testrecords/marc21_utf8_combining_chars.dat deleted file mode 100644 index 5ae3740f08..0000000000 --- a/C4/tests/testrecords/marc21_utf8_combining_chars.dat +++ /dev/null @@ -1 +0,0 @@ -01442cam a2200373 a 4500001001300000003000600013005001700019008004100036010001700077040002500094016001900119020004200138029002100180050002800201082002300229084001500252092001700267049000800284245015300292260007900445300002800524440015300552500003000705500002200735650005600757650007000813650005700883650002500940650002100965650002500986700003001011942001501041994001201056ocm11030895 OCoLC20060516100102.0840720s1984 ne b 001 0 eng  a 83048926  aDLCcDLCdMUQdNLGGC aB84431862bccb a0800606035 (Fortress Press) :c$35.951 aNLGGCb84037516600aBM485b.L57 1984 vol. 200a296.1 sa296.1219 a11.372bcl0 a296.1bST66  aWN300aJewish writings of the Second Temple period :bApocrypha, Pseudepigrapha, Qumran, sectarian writings, Philo, Josephus /cedited by Michael E. Stone. aAssen, Netherlands :bVan Gorcum ;aPhiladelphia :bFortress Press,c1984. axxiii, 697 p. ;c25 cm. 0aCompendia rerum Iudaicarum ad Novum Testamentum.nSection 2,pLiterature of the Jewish people in the period of the Second Temple and the Talmud ;v2 aBibliography: p. 603-653. aIncludes indexes. 0aJewish religious literaturexHistory and criticism. 0aJudaismxHistoryyPost-exilic period, 586 B.C.-210 A.D.xSources. 6aLittérature religieuse juivexHistoire et critique.17aOude Testament.2gtt17aApocriefen.2gtt17aDode-Zeerollen.2gtt1 aStone, Michael E.,d1938- k296.1 ST66 aC0bWN3 \ No newline at end of file diff --git a/C4/tests/testrecords/marcxml_utf8.xml b/C4/tests/testrecords/marcxml_utf8.xml deleted file mode 100644 index 7e30aaadd4..0000000000 --- a/C4/tests/testrecords/marcxml_utf8.xml +++ /dev/null @@ -1,44 +0,0 @@ - - - - 00463 a2200169 4500 - 84893 - ACLS - 19990324000000.0 - 930421s19xx xxu 00010 eng d - - 0854562702 - - - 1738 - 1738 - - - Christie, Agatha, - 1890-1976. - - - Why didn't they ask Evans? / - Agatha Christie. - - - Large print edition. - - - Large type books. - - - ONe - LP - LP Christie - - - NPL - 31000000010273 - 12.00 - 2148 - - diff --git a/C4/tests/testrecords/marcxml_utf8_entityencoded.xml b/C4/tests/testrecords/marcxml_utf8_entityencoded.xml deleted file mode 100644 index 53766f357b..0000000000 --- a/C4/tests/testrecords/marcxml_utf8_entityencoded.xml +++ /dev/null @@ -1,46 +0,0 @@ - - - - - 00463 a2200169 4500 - 84893 - ACLS - 19990324000000.0 - 930421s19xx xxu 00010 eng d - - 0854562702 - - - 1738 - 1738 - - - Christie, Agatha, - 1890-1976. - - - Why didn't they ask Evans? / - Agatha Christie. - - - Large print edition. - - - Large type books. - - - ONe - LP - LP Christie - - - NPL - 31000000010273 - 12.00 - 2148 - - - -- 2.39.5