[Koha-cvs] koha/C4 Auth.pm Biblio.pm Context.pm Koha.pm Re... [dev_week]
Joshua Ferraro
jmf at kados.org
Thu Aug 10 04:10:21 CEST 2006
CVSROOT: /sources/koha
Module name: koha
Branch: dev_week
Changes by: Joshua Ferraro <kados> 06/08/10 02:10:21
Modified files:
C4 : Auth.pm Biblio.pm Context.pm Koha.pm
Reserves2.pm Search.pm
C4/Circulation : Circ2.pm
Log message:
Turned warnings on, and running a search turned up lots of warnings.
Cleaned up those ...
removed getitemtypes from Koha.pm (one in Search.pm looks newer)
removed itemcount from Biblio.pm
made some local subs local with a _ prefix (as they were redefined
elsewhere)
Add two new search subs to Search.pm the start of a new search API
that's a bit more scalable
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Auth.pm?cvsroot=koha&only_with_tag=dev_week&r1=1.36.2.18.2.5&r2=1.36.2.18.2.6
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Biblio.pm?cvsroot=koha&only_with_tag=dev_week&r1=1.115.2.51.2.14&r2=1.115.2.51.2.15
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Context.pm?cvsroot=koha&only_with_tag=dev_week&r1=1.18.2.5.2.12&r2=1.18.2.5.2.13
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Koha.pm?cvsroot=koha&only_with_tag=dev_week&r1=1.22.2.4&r2=1.22.2.4.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Reserves2.pm?cvsroot=koha&only_with_tag=dev_week&r1=1.38.4.1&r2=1.38.4.2
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Search.pm?cvsroot=koha&only_with_tag=dev_week&r1=1.99.2.11.2.21&r2=1.99.2.11.2.22
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation/Circ2.pm?cvsroot=koha&only_with_tag=dev_week&r1=1.87.2.14.2.4&r2=1.87.2.14.2.5
Patches:
Index: Auth.pm
===================================================================
RCS file: /sources/koha/koha/C4/Auth.pm,v
retrieving revision 1.36.2.18.2.5
retrieving revision 1.36.2.18.2.6
diff -u -b -r1.36.2.18.2.5 -r1.36.2.18.2.6
--- Auth.pm 3 Aug 2006 05:25:41 -0000 1.36.2.18.2.5
+++ Auth.pm 10 Aug 2006 02:10:20 -0000 1.36.2.18.2.6
@@ -543,7 +543,7 @@
return 1,$cardnumber;
}
}
- my $sth=$dbh->prepare("select password from borrowers where cardnumber=?");
+ $sth=$dbh->prepare("select password from borrowers where cardnumber=?");
$sth->execute($userid);
if ($sth->rows) {
my ($md5password) = $sth->fetchrow;
@@ -551,6 +551,7 @@
return 1,$userid;
}
}
+ if (($userid) && ($password)) {
if ($userid eq C4::Context->config('user') && $password eq C4::Context->config('pass')) {
# Koha superuser account
return 2;
@@ -560,6 +561,7 @@
# some features won't be effective : modify systempref, modify MARC structure,
return 2;
}
+ }
return 0;
}
Index: Biblio.pm
===================================================================
RCS file: /sources/koha/koha/C4/Biblio.pm,v
retrieving revision 1.115.2.51.2.14
retrieving revision 1.115.2.51.2.15
diff -u -b -r1.115.2.51.2.14 -r1.115.2.51.2.15
--- Biblio.pm 15 Jul 2006 19:22:46 -0000 1.115.2.51.2.14
+++ Biblio.pm 10 Aug 2006 02:10:20 -0000 1.115.2.51.2.15
@@ -38,7 +38,7 @@
#
@EXPORT = qw(
&updateBiblio &updateBiblioItem &updateItem
- &itemcount &newbiblio &newbiblioitem
+ &newbiblio &newbiblioitem
&modnote &newsubject &newsubtitle
&modbiblio &checkitems
&newitems &modbibitem
@@ -340,8 +340,8 @@
$sth->finish;
-my $encoding = C4::Context->preference("marcflavour");
- my $sth =$dbh->prepare("update biblioitems set marc=? where biblionumber=?" );
+ my $encoding = C4::Context->preference("marcflavour");
+ $sth =$dbh->prepare("update biblioitems set marc=? where biblionumber=?" );
$sth->execute( $record->as_usmarc() , $biblionumber);
$sth->finish;
@@ -1317,8 +1317,9 @@
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 ($tagfield,$tagsubfield,$tagsubfieldsub);
+($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.classification",$frameworkcode);
+($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);
@@ -1412,25 +1413,24 @@
$dbh->prepare(
"select biblioitemnumber,itemtype from biblioitems where biblionumber=?");
$sth->execute( $item->{'biblionumber'} );
-my $itemtype;
+ my $itemtype;
( $item->{'biblioitemnumber'}, $itemtype ) = $sth->fetchrow;
-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(!$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);
-
-}
+ $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(!$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);
+ }
my ( $itemnumber, $error ) = &OLDnewitems( $dbh, $item, $item->{barcode} );
# add itemnumber to MARC::Record before adding the item.
$sth =
@@ -1438,36 +1438,36 @@
"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
);
&MARCkoha2marcOnefield( $sth, $record, "items.itemnumber", $itemnumber,$frameworkcode );
-##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);
-}
+
+ ##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 ($dbh,$record,$itemfield,$newvalue)=@_;
my ($tagfield, $tagsubfield)=MARCfind_marc_from_kohafield($dbh,$itemfield,"");
- if ( $tagfield, $tagsubfield ) {
+ if (($tagfield) && ($tagsubfield)) {
my $tag = $record->field($tagfield);
-
if ( $tag) {
- $tag->update($tagsubfield =>$newvalue);
+ $tag->update($tagsubfield => $newvalue);
$record->delete_field($tag);
$record->add_fields($tag);
}
-
}
}
+
sub NEWmoditem {
my ( $dbh, $record, $bibid, $itemnumber, $delete ) = @_;
@@ -2859,7 +2859,10 @@
}#while
my $other=length($lc1);
-if(!$lc1){$other==0;}
+if (!$lc1) {
+ $other=0;
+}
+
my $extras;
if ($other<4){
for (1..(4-$other)){
@@ -2914,8 +2917,21 @@
=cut
-# $Id: Biblio.pm,v 1.115.2.51.2.14 2006/07/15 19:22:46 kados Exp $
+# $Id: Biblio.pm,v 1.115.2.51.2.15 2006/08/10 02:10:20 kados Exp $
# $Log: Biblio.pm,v $
+# Revision 1.115.2.51.2.15 2006/08/10 02:10:20 kados
+# Turned warnings on, and running a search turned up lots of warnings.
+# Cleaned up those ...
+#
+# removed getitemtypes from Koha.pm (one in Search.pm looks newer)
+# removed itemcount from Biblio.pm
+#
+# made some local subs local with a _ prefix (as they were redefined
+# elsewhere)
+#
+# Add two new search subs to Search.pm the start of a new search API
+# that's a bit more scalable
+#
# Revision 1.115.2.51.2.14 2006/07/15 19:22:46 kados
# comment out warns
#
Index: Context.pm
===================================================================
RCS file: /sources/koha/koha/C4/Context.pm,v
retrieving revision 1.18.2.5.2.12
retrieving revision 1.18.2.5.2.13
diff -u -b -r1.18.2.5.2.12 -r1.18.2.5.2.13
--- Context.pm 4 Aug 2006 15:38:17 -0000 1.18.2.5.2.12
+++ Context.pm 10 Aug 2006 02:10:21 -0000 1.18.2.5.2.13
@@ -15,7 +15,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Context.pm,v 1.18.2.5.2.12 2006/08/04 15:38:17 tipaul Exp $
+# $Id: Context.pm,v 1.18.2.5.2.13 2006/08/10 02:10:21 kados Exp $
package C4::Context;
use strict;
use DBI;
@@ -25,7 +25,7 @@
qw($context),
qw(@context_stack);
-$VERSION = do { my @v = '$Revision: 1.18.2.5.2.12 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.18.2.5.2.13 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -427,7 +427,7 @@
sub new_Zconn {
use ZOOM;
my $server=shift;
-my $tried==0;
+my $tried=0;
my $Zconn;
my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
retry:
@@ -435,8 +435,8 @@
$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");
+ $Zconn->option(cqlfile=> $context->{"config"}->{"intranetdir"}."/etc/cql.properties");
+ $Zconn->option(cclfile=> $context->{"config"}->{"intranetdir"}."/etc/ccl.properties");
};
if ($@){
###Uncomment the lines below if you want to automatically restart your zebra if its stop
@@ -458,7 +458,7 @@
sub new_Zconnauth {
use ZOOM;
my $server=shift;
- my $tried==0;
+ my $tried=0;
my $Zconnauth;
my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
my $o = new ZOOM::Options();
@@ -814,16 +814,18 @@
=cut
# $Log: Context.pm,v $
-# Revision 1.18.2.5.2.12 2006/08/04 15:38:17 tipaul
-# adding zebradir parameter & documenting koha.xml
+# Revision 1.18.2.5.2.13 2006/08/10 02:10:21 kados
+# Turned warnings on, and running a search turned up lots of warnings.
+# Cleaned up those ...
#
-# Revision 1.18.2.5.2.11 2006/08/04 15:24:06 tipaul
-# 1st commit on dev_week :
+# removed getitemtypes from Koha.pm (one in Search.pm looks newer)
+# removed itemcount from Biblio.pm
#
-# the cql.properties & ccl.properties are in $KOHA/zebraplugin/etc directories.
-# zebraplugin was missing.
+# made some local subs local with a _ prefix (as they were redefined
+# elsewhere)
#
-# it would probably be better if the directory were in a koha conf preference.
+# Add two new search subs to Search.pm the start of a new search API
+# that's a bit more scalable
#
# Revision 1.18.2.5.2.10 2006/07/21 17:50:51 kados
# moving the *.properties files to intranetdir/etc dir
Index: Koha.pm
===================================================================
RCS file: /sources/koha/koha/C4/Koha.pm,v
retrieving revision 1.22.2.4
retrieving revision 1.22.2.4.2.1
diff -u -b -r1.22.2.4 -r1.22.2.4.2.1
--- Koha.pm 7 Feb 2006 15:33:35 -0000 1.22.2.4
+++ Koha.pm 10 Aug 2006 02:10:21 -0000 1.22.2.4.2.1
@@ -57,7 +57,7 @@
&subfield_is_koha_internal_p
&getbranches &getbranch
&getprinters &getprinter
- &getitemtypes &getitemtypeinfo
+ &getitemtypeinfo
&getframeworks &getframeworkinfo
&getauthtypes &getauthtype
&getallthemes &getalllanguages
@@ -610,7 +610,7 @@
$lang->{$language}=1;
}
}
- my $htdocs=C4::Context->config('opachtdocs');
+ $htdocs=C4::Context->config('opachtdocs');
foreach my $theme (getallthemes('opac')) {
opendir D, "$htdocs/$theme";
foreach my $language (readdir D) {
Index: Reserves2.pm
===================================================================
RCS file: /sources/koha/koha/C4/Reserves2.pm,v
retrieving revision 1.38.4.1
retrieving revision 1.38.4.2
diff -u -b -r1.38.4.1 -r1.38.4.2
--- Reserves2.pm 3 Aug 2006 05:25:41 -0000 1.38.4.1
+++ Reserves2.pm 10 Aug 2006 02:10:21 -0000 1.38.4.2
@@ -3,7 +3,7 @@
package C4::Reserves2;
-# $Id: Reserves2.pm,v 1.38.4.1 2006/08/03 05:25:41 kados Exp $
+# $Id: Reserves2.pm,v 1.38.4.2 2006/08/10 02:10:21 kados Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -315,7 +315,7 @@
$sth->finish;
# update the database, removing the record...
- my $sth = $dbh->prepare("update reserves set cancellationdate = now(),
+ $sth = $dbh->prepare("update reserves set cancellationdate = now(),
found = Null,
priority = 0
where biblionumber = ?
@@ -519,7 +519,7 @@
# updates take place here
if ($fee > 0) {
# print $fee;
- my $nextacctno = &getnextacctno($env,$borrnum,$dbh);
+ my $nextacctno = _getnextacctno($env,$borrnum,$dbh);
my $usth = $dbh->prepare("insert into accountlines
(borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
values
@@ -636,7 +636,7 @@
}
# XXX - Internal use
-sub getnextacctno {
+sub _getnextacctno {
my ($env,$bornumber,$dbh)=@_;
my $nextaccntno = 1;
my $sth = $dbh->prepare("select * from accountlines
Index: Search.pm
===================================================================
RCS file: /sources/koha/koha/C4/Search.pm,v
retrieving revision 1.99.2.11.2.21
retrieving revision 1.99.2.11.2.22
diff -u -b -r1.99.2.11.2.21 -r1.99.2.11.2.22
--- Search.pm 9 Aug 2006 23:59:21 -0000 1.99.2.11.2.21
+++ Search.pm 10 Aug 2006 02:10:21 -0000 1.99.2.11.2.22
@@ -36,7 +36,7 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.99.2.11.2.21 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.99.2.11.2.22 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -76,6 +76,8 @@
&searchZOOM &catalogsearch &catalogsearch3 &CatSearch3 &catalogsearch4 &searchResults
+&getRecords &buildQuery
+
&getMARCnotes &getMARCsubjects &getMARCurls);
# make all your functions, whether exported or not;
@@ -2761,7 +2763,7 @@
my $stackstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.stack"');
$stackstatus->execute;
- my ($authorised_valuecode) = $stackstatus->fetchrow;
+ ($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});
@@ -4284,7 +4286,111 @@
return(undef,$numresults,\@facets_loop, at results);
}
+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;
+
+ # build the query string
+ my $zoom_query;
+ foreach my $query (@zoom_query) {
+ $zoom_query.="$query " if $query;
+ }
+
+ # 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("<td><tr>connection ", $i-1, ": ", ZOOM::event_str($ev), "</tr></td>\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);
+}
+
+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;
+ }
+ }
+ }
+
+ # add limits
+ foreach my $limit (@limits) {
+ push @ccl, ( {limit => $limit} ) if $limit;
+ }
+
+ return (undef, at ccl);
+}
sub searchResults {
my ($searchdesc,$num,$count, at marcresults)=@_;
use C4::Date;
Index: Circulation/Circ2.pm
===================================================================
RCS file: /sources/koha/koha/C4/Circulation/Circ2.pm,v
retrieving revision 1.87.2.14.2.4
retrieving revision 1.87.2.14.2.5
diff -u -b -r1.87.2.14.2.4 -r1.87.2.14.2.5
--- Circulation/Circ2.pm 11 Jul 2006 14:19:43 -0000 1.87.2.14.2.4
+++ Circulation/Circ2.pm 10 Aug 2006 02:10:21 -0000 1.87.2.14.2.5
@@ -3,7 +3,7 @@
package C4::Circulation::Circ2;
-# $Id: Circ2.pm,v 1.87.2.14.2.4 2006/07/11 14:19:43 kados Exp $
+# $Id: Circ2.pm,v 1.87.2.14.2.5 2006/08/10 02:10:21 kados Exp $
#package to deal with Returns
#written 3/11/99 by olwen at katipo.co.nz
@@ -653,7 +653,7 @@
# check for branch=*
$sth->execute($cat_borrower, $type, "");
- my $result = $sth->fetchrow_hashref;
+ $result = $sth->fetchrow_hashref;
if (defined($result)) {
$sth2->execute($borrower->{'borrowernumber'}, "%$type%");
my $alreadyissued = $sth2->fetchrow;
@@ -664,7 +664,7 @@
# check for itemtype=*
$sth->execute($cat_borrower, "*", $branch_borrower);
- my $result = $sth->fetchrow_hashref;
+ $result = $sth->fetchrow_hashref;
if (defined($result)) {
$sth3->execute($borrower->{'borrowernumber'});
my $alreadyissued = $sth3->fetchrow;
@@ -675,7 +675,7 @@
#check for borrowertype=*
$sth->execute("*", $type, $branch_borrower);
- my $result = $sth->fetchrow_hashref;
+ $result = $sth->fetchrow_hashref;
if (defined($result)) {
$sth2->execute($borrower->{'borrowernumber'}, "%$type%");
my $alreadyissued = $sth2->fetchrow;
@@ -686,7 +686,7 @@
#check for borrowertype=*;itemtype=*
$sth->execute("*", "*", $branch_borrower);
- my $result = $sth->fetchrow_hashref;
+ $result = $sth->fetchrow_hashref;
if (defined($result)) {
$sth3->execute($borrower->{'borrowernumber'});
my $alreadyissued = $sth3->fetchrow;
@@ -697,7 +697,7 @@
#check for borrowertype=*;branch=""
$sth->execute("*", $type, "");
- my $result = $sth->fetchrow_hashref;
+ $result = $sth->fetchrow_hashref;
if (defined($result) && $result->{maxissueqty} ge 0) {
$sth2->execute($borrower->{'borrowernumber'}, "%$type%");
my $alreadyissued = $sth2->fetchrow;
@@ -707,7 +707,7 @@
}
$sth->execute($cat_borrower, "*", "");
- my $result = $sth->fetchrow_hashref;
+ $result = $sth->fetchrow_hashref;
if (defined($result)) {
$sth2->execute($borrower->{'borrowernumber'}, "%$type%");
my $alreadyissued = $sth2->fetchrow;
@@ -717,7 +717,7 @@
}
$sth->execute("*", "*", "");
- my $result = $sth->fetchrow_hashref;
+ $result = $sth->fetchrow_hashref;
if (defined($result)) {
$sth3->execute($borrower->{'borrowernumber'});
my $alreadyissued = $sth3->fetchrow;
@@ -754,7 +754,7 @@
}
# check for branch=*
$sth->execute($cat_borrower, $type, "");
- my $result = $sth->fetchrow_hashref;
+ $result = $sth->fetchrow_hashref;
if (defined($result)) {
$sth2->execute($borrower->{'borrowernumber'}, "%$type%");
my $alreadyissued = $sth2->fetchrow;
@@ -762,7 +762,7 @@
}
# check for itemtype=*
$sth->execute($cat_borrower, "*", $branch_borrower);
- my $result = $sth->fetchrow_hashref;
+ $result = $sth->fetchrow_hashref;
if (defined($result)) {
$sth3->execute($borrower->{'borrowernumber'});
my ($alreadyissued) = $sth3->fetchrow;
@@ -771,7 +771,7 @@
}
#check for borrowertype=*
$sth->execute("*", $type, $branch_borrower);
- my $result = $sth->fetchrow_hashref;
+ $result = $sth->fetchrow_hashref;
if (defined($result)) {
$sth2->execute($borrower->{'borrowernumber'}, "%$type%");
my $alreadyissued = $sth2->fetchrow;
@@ -779,7 +779,7 @@
}
$sth->execute("*", "*", $branch_borrower);
- my $result = $sth->fetchrow_hashref;
+ $result = $sth->fetchrow_hashref;
if (defined($result)) {
$sth3->execute($borrower->{'borrowernumber'});
my $alreadyissued = $sth3->fetchrow;
@@ -787,7 +787,7 @@
}
$sth->execute("*", $type, "");
- my $result = $sth->fetchrow_hashref;
+ $result = $sth->fetchrow_hashref;
if (defined($result) && $result->{maxissueqty}>=0) {
$sth2->execute($borrower->{'borrowernumber'}, "%$type%");
my $alreadyissued = $sth2->fetchrow;
@@ -795,7 +795,7 @@
}
$sth->execute($cat_borrower, "*", "");
- my $result = $sth->fetchrow_hashref;
+ $result = $sth->fetchrow_hashref;
if (defined($result)) {
$sth2->execute($borrower->{'borrowernumber'}, "%$type%");
my $alreadyissued = $sth2->fetchrow;
@@ -803,7 +803,7 @@
}
$sth->execute("*", "*", "");
- my $result = $sth->fetchrow_hashref;
+ $result = $sth->fetchrow_hashref;
if (defined($result)) {
$sth3->execute($borrower->{'borrowernumber'});
my $alreadyissued = $sth3->fetchrow;
@@ -1037,11 +1037,9 @@
my @datearr = localtime();
# my $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
my $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'});
- my @datearr;
- my $dateduef;
- my $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'});
+ $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'});
my $datedue=time+($loanlength)*86400;
- my @datearr = localtime($datedue);
+ @datearr = localtime($datedue);
my $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
#warn "issue : ".$borrower->{borrowernumber}." / I : ".$iteminformation->{'itemnumber'};
@@ -1087,31 +1085,31 @@
return $loanlength->{issuelength} if defined($loanlength);
$sth->execute($borrowertype,$itemtype,"");
- my $loanlength = $sth->fetchrow_hashref;
+ $loanlength = $sth->fetchrow_hashref;
return $loanlength->{issuelength} if defined($loanlength);
$sth->execute($borrowertype,"*",$branchcode);
- my $loanlength = $sth->fetchrow_hashref;
+ $loanlength = $sth->fetchrow_hashref;
return $loanlength->{issuelength} if defined($loanlength);
$sth->execute("*",$itemtype,$branchcode);
- my $loanlength = $sth->fetchrow_hashref;
+ $loanlength = $sth->fetchrow_hashref;
return $loanlength->{issuelength} if defined($loanlength);
$sth->execute($borrowertype,"*","");
- my $loanlength = $sth->fetchrow_hashref;
+ $loanlength = $sth->fetchrow_hashref;
return $loanlength->{issuelength} if defined($loanlength);
$sth->execute("*","*",$branchcode);
- my $loanlength = $sth->fetchrow_hashref;
+ $loanlength = $sth->fetchrow_hashref;
return $loanlength->{issuelength} if defined($loanlength);
$sth->execute("*",$itemtype,"");
- my $loanlength = $sth->fetchrow_hashref;
+ $loanlength = $sth->fetchrow_hashref;
return $loanlength->{issuelength} if defined($loanlength);
$sth->execute("*","*","");
- my $loanlength = $sth->fetchrow_hashref;
+ $loanlength = $sth->fetchrow_hashref;
return $loanlength->{issuelength} if defined($loanlength);
# if no rule is set => 21 days (hardcoded)
@@ -1287,7 +1285,7 @@
$usth->execute($data->{'borrowernumber'},$itm,$acctno);
$usth->finish;
#check if any credit is left if so writeoff other accounts
- my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
+ my $nextaccntno = _getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
if ($amountleft < 0){
$amountleft*=-1;
}
@@ -1809,12 +1807,6 @@
if ($resfound) {
$renewokay=4;
}
-
- my ($resfound, $resrec) = CheckReserves($itemno);
- if ($resfound) {
- $renewokay=4;
- }
-
}
$sth1->finish;
## Try to find whether book can be renewed at this date
@@ -1831,12 +1823,12 @@
$sth->finish;
#calculates the date on the we are allowed to renew the item
- my $sth = $dbh->prepare("SELECT (DATE_SUB( ?, INTERVAL ? DAY))");
+ $sth = $dbh->prepare("SELECT (DATE_SUB( ?, INTERVAL ? DAY))");
$sth->execute($issuedata, $allowRenewalsBefore);
my $startdate = $sth->fetchrow;
$sth->finish;
- my $sth = $dbh->prepare("SELECT DATEDIFF(CURRENT_DATE,?)");
+ $sth = $dbh->prepare("SELECT DATEDIFF(CURRENT_DATE,?)");
$sth->execute($startdate);
my $difference = $sth->fetchrow;
$sth->finish;
@@ -1939,7 +1931,7 @@
# Charge a new rental fee, if applicable?
my ($charge,$type)=calc_charges($env, $itemno, $bornum);
if ($charge > 0){
- my $accountno=getnextacctno($env,$bornum,$dbh);
+ 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(),?,?,?,?,?)");
@@ -2002,7 +1994,7 @@
sub createcharge {
#Stolen from Issues.pm
my ($env,$dbh,$itemno,$bornum,$charge) = @_;
- my $nextaccntno = getnextacctno($env,$bornum,$dbh);
+ my $nextaccntno = _getnextacctno($env,$bornum,$dbh);
my $sth = $dbh->prepare(<<EOT);
INSERT INTO accountlines
(borrowernumber, itemnumber, accountno,
@@ -2017,7 +2009,7 @@
}
-sub getnextacctno {
+sub _getnextacctno {
# Stolen from Accounts.pm
my ($env,$bornumber,$dbh)=@_;
my $nextaccntno = 1;
More information about the Koha-cvs
mailing list