From ab45e7aaab0a7bc6abe88179682cc57aee06073c Mon Sep 17 00:00:00 2001 From: tgarip1957 Date: Mon, 6 Nov 2006 21:01:43 +0000 Subject: [PATCH] Bug fixing and complete removal of Date::Manip --- C4/Auth.pm | 4 +++ C4/Biblio.pm | 14 ++++++++-- C4/BookShelves.pm | 8 ++++-- C4/Breeding.pm | 6 ++--- C4/Calendar/Calendar.pm | 4 +-- C4/Circulation/Circ2.pm | 60 +++++++++++++---------------------------- C4/Context.pm | 10 ++++--- C4/Koha.pm | 1 + C4/Members.pm | 33 ++++++++++------------- C4/Serials.pm | 1 - 10 files changed, 67 insertions(+), 74 deletions(-) diff --git a/C4/Auth.pm b/C4/Auth.pm index 4b89ee5066..1268e9ea96 100644 --- a/C4/Auth.pm +++ b/C4/Auth.pm @@ -36,7 +36,11 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # set the version for version checking $VERSION = 0.01; +@ISA = qw(Exporter); +@EXPORT = qw( +&checkpw +); =head1 NAME C4::Auth - Authenticates Koha users diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 22ddb90571..9452aa148d 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -21,7 +21,6 @@ require Exporter; use C4::Context; use XML::Simple; use Encode; -use utf8; use vars qw($VERSION @ISA @EXPORT); @@ -1204,9 +1203,20 @@ sub ZEBRAop { my ($dbh,$biblionumber,$op,$server)=@_; if (!$biblionumber){ warn "Zebra received no biblionumber"; +}elsif (C4::Context->preference('onlineZEBRA')){ +my $marcxml; + if ($server eq "biblioserver"){ + ($marcxml) =ZEBRA_readyXML($dbh,$biblionumber); + }elsif($server eq "authorityserver"){ + $marcxml =C4::AuthoritiesMarc::XMLgetauthority($dbh,$biblionumber); + } +ZEBRAopserver($marcxml,$op,$server,$biblionumber); +ZEBRAopcommit($server); }else{ my $sth=$dbh->prepare("insert into zebraqueue (biblio_auth_number ,server,operation) values(?,?,?)"); $sth->execute($biblionumber,$server,$op); +$sth->finish; + } } @@ -1265,7 +1275,7 @@ return 0; sub ZEBRAopcommit { my $server=shift; - +return unless C4::Context->config($server."shadow"); my $Zconnbiblio=C4::Context->Zconnauth($server); my $Zpackage = $Zconnbiblio->package(); diff --git a/C4/BookShelves.pm b/C4/BookShelves.pm index ea2a02a464..e052051006 100755 --- a/C4/BookShelves.pm +++ b/C4/BookShelves.pm @@ -465,9 +465,10 @@ sub GetShelfContentsExt { my $even = 0; while (my ($biblionumber) = $sth->fetchrow) { my $biblio=ZEBRA_readyXML_noheader($dbh,$biblionumber); - push @biblios,$biblio; + my $xmlrecord=XML_xml2hash($biblio); + push @biblios,$xmlrecord; } -my (@results)=parsefields($dbh,"opac",@biblios); +my ($facets,@results)=parsefields($dbh,"opac",@biblios); return (\@results); } @@ -605,6 +606,9 @@ END { } # module clean-up code here (global destructor) # # $Log$ +# Revision 1.19 2006/11/06 21:01:43 tgarip1957 +# Bug fixing and complete removal of Date::Manip +# # Revision 1.18 2006/09/06 16:21:03 tgarip1957 # Clean up before final commits # diff --git a/C4/Breeding.pm b/C4/Breeding.pm index cccbdeab42..0575b9c5e0 100644 --- a/C4/Breeding.pm +++ b/C4/Breeding.pm @@ -67,8 +67,6 @@ 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; @@ -136,8 +134,8 @@ my $findbreedingid = $dbh->prepare("select max(id) from marc_breeding"); $replacesql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded->as_usmarc,$encoding,$z3950random,$oldbiblio->{classification},$oldbiblio->{subclass},$breedingid); } else { $insertsql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded->as_usmarc,$encoding,$z3950random,$oldbiblio->{classification},$oldbiblio->{subclass}); - $findbreedingid->execute; - $breedingid=$findbreedingid->fetchrow; + + $breedingid=$dbh->{'mysql_insertid'}; } $imported++; } diff --git a/C4/Calendar/Calendar.pm b/C4/Calendar/Calendar.pm index 32c34162b4..355065da68 100644 --- a/C4/Calendar/Calendar.pm +++ b/C4/Calendar/Calendar.pm @@ -548,14 +548,14 @@ sub daysBetween { sub Date_DayOfWeek{ my ($month, $day, $year)=@_; -my $date=Date_obj($year."-".$month."-".$day); +my $date=DATE_obj($year."-".$month."-".$day); return $date->day_of_week; } sub Add_Delta_Days{ my ($year, $month, $day, $offset)=@_; -my $date=Date_obj($year."-".$month."-".$day); +my $date=DATE_obj($year."-".$month."-".$day); my $duration=get_duration($offset." days"); $date->add_duration($duration); diff --git a/C4/Circulation/Circ2.pm b/C4/Circulation/Circ2.pm index 0baeb13c86..9d86c10f32 100755 --- a/C4/Circulation/Circ2.pm +++ b/C4/Circulation/Circ2.pm @@ -1145,17 +1145,19 @@ sub returnbook { die '$branch not defined' unless defined $branch; # just in case (bug 170) # get information on item my $itemrecord=XMLgetitemhash($dbh,"",$barcode); - my $iteminformation=XMLmarc2koha_onerecord($dbh,$itemrecord,"holdings"); - $iteminformation->{'itemtype'}=MARCfind_itemtype($dbh,$iteminformation->{biblionumber}); - if (not $iteminformation) { + if (not $itemrecord) { $messages->{'BadBarcode'} = $barcode; $doreturn = 0; + return ($doreturn, $messages, "", ""); } + my $iteminformation=XMLmarc2koha_onerecord($dbh,$itemrecord,"holdings"); + $iteminformation->{'itemtype'}=MARCfind_itemtype($dbh,$iteminformation->{biblionumber}); + # find the borrower my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'}); if ((not $currentborrower) && $doreturn) { $messages->{'NotIssued'} = $barcode; - # $doreturn = 0; + $doreturn = 0; } # check if the book is in a permanent collection.... my $hbr = $iteminformation->{'homebranch'}; @@ -1166,7 +1168,7 @@ sub returnbook { # check that the book has been cancelled if ($iteminformation->{'wthdrawn'}) { $messages->{'wthdrawn'} = 1; - # $doreturn = 0; + $doreturn = 0; } # update issues, thereby returning book (should push this out into another subroutine my ($borrower) = getpatroninformation(\%env, $currentborrower, 0); @@ -1717,13 +1719,7 @@ sub renewstatus { # Look in the issues table for this item, lent to this borrower, # and not yet returned. my $borrower=C4::Members::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; - return $renewokay; - } - } + # FIXME - I think this function could be redone to use only one SQL call. my $sth1 = $dbh->prepare("select * from issues,items,biblio where (borrowernumber = ?) @@ -1734,7 +1730,13 @@ my $borrower=C4::Members::getpatroninformation($dbh,$bornum,undef); $sth1->execute($bornum,$itemnumber); if (my $data1 = $sth1->fetchrow_hashref) { # Found a matching item - + if (C4::Context->preference("LibraryName") eq "NEU Grand Library"){ + ##privileged get renewal whatever the case may be + if ($borrower->{'categorycode'} eq 'P'){ + $renewokay = 1; + return $renewokay; + } + } # See if this item may be renewed. my $sth2 = $dbh->prepare("select renewalsallowed from itemtypes where itemtypes.itemtype=?"); $sth2->execute($data1->{itemtype}); @@ -1820,45 +1822,22 @@ sub renewbook { my $loanlength; my $dbh=C4::Context->dbh; +my $sth; 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); + my $borrower = C4::Members::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 $datedue=get_today(); 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); - } - - - - # Update the issues record to have the new due date, and a new count # of how many times it has been renewed. @@ -1868,7 +1847,6 @@ if ($datedue eq "" ) { $sth->finish; ## Update items and marc record with new date -T.G - my $iteminformation = getiteminformation($env, $itemnumber,0); &XMLmoditemonefield($dbh,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'},'date_due',$datedue); # Log the renewal @@ -1884,8 +1862,8 @@ if ($datedue eq "" ) { $sth->finish; # print $account; }# end of rental charge - - + + return format_date($datedue); } diff --git a/C4/Context.pm b/C4/Context.pm index a610df4e07..1bb4b1dac8 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -487,9 +487,10 @@ sub _new_dbh my $dbh= DBI->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->{mysql_auto_reconnect} = 1 ; + ###DBD::Mysql 3.0.7 has an intermittent bug for dbh->do so change to dbh->prepare + my $sth=$dbh->prepare("set NAMES 'utf8'"); + $sth->execute(); + $sth->finish; return $dbh; } @@ -834,6 +835,9 @@ Andrew Arensburger =cut # $Log$ +# Revision 1.50 2006/11/06 21:01:43 tgarip1957 +# Bug fixing and complete removal of Date::Manip +# # Revision 1.49 2006/10/20 01:20:56 tgarip1957 # A new Date.pm to use for all date calculations. Mysql date calculations removed from Circ2.pm, all modules free of DateManip, a new get_today function to call in allscripts, and some bug cleaning in authorities.pm # diff --git a/C4/Koha.pm b/C4/Koha.pm index 7da1e9e034..ac29ce9238 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -942,6 +942,7 @@ my (@tags,@subfield); } + 1; __END__ diff --git a/C4/Members.pm b/C4/Members.pm index c0448278e0..ddb6591bc0 100644 --- a/C4/Members.pm +++ b/C4/Members.pm @@ -691,12 +691,7 @@ sub modmember { $data{'expiry'}=format_date_in_iso($data{'expiry'}); }else{ - my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?"); - $sth->execute($data{'categorycode'}); - my ($enrolmentperiod) = $sth->fetchrow; - $enrolmentperiod = 1 unless ($enrolmentperiod);#enrolmentperiod in years - my $duration=get_duration($enrolmentperiod." years"); - $data{'expiry'} = &DATE_Add_Duration($data{'joining'},$duration ); + $data{'expiry'} = calcexpirydate($data{'categorycode'},$data{'joining'} ); } @@ -760,12 +755,8 @@ sub newmember { if ($data{'expiry'}) { $data{'expiry'}=format_date_in_iso($data{'expiry'}); }else{ - my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?"); - $sth->execute($data{'categorycode'}); - my ($enrolmentperiod) = $sth->fetchrow; - $enrolmentperiod = 1 unless ($enrolmentperiod);#enrolmentperiod in years - my $duration=get_duration($enrolmentperiod." years"); - $data{'expiry'} = &DATE_Add_Duration($data{'joining'},$duration); + + $data{'expiry'} = calcexpirydate($data{'categorycode'},$data{'joining'}); } my $query= "INSERT INTO borrowers ( @@ -846,9 +837,10 @@ sub calcexpirydate { "select enrolmentperiod from categories where categorycode=?"); $sth->execute($categorycode); my ($enrolmentperiod) = $sth->fetchrow; - $enrolmentperiod = 12 unless ($enrolmentperiod); - return format_date_in_iso( - &DateCalc( $dateenrolled, "$enrolmentperiod months" ) ); +$enrolmentperiod = 1 unless ($enrolmentperiod);#enrolmentperiod in years + my $duration=get_duration($enrolmentperiod." years"); + return DATE_Add_Duration($dateenrolled,$duration); + } =head2 checkuserpassword (OUEST-PROVENCE) @@ -991,7 +983,7 @@ sub fixupneu_cardnumber{ # Defaults to "0", which is interpreted as "no". my $dbh = C4::Context->dbh; my $sth; - if (! $cardnumber && $autonumber_members && $categorycode) { + if (!$cardnumber && $autonumber_members && $categorycode) { if ($categorycode eq "A" || $categorycode eq "W" ){ $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '5%' "); }elsif ($categorycode eq "L"){ @@ -1022,6 +1014,7 @@ my $sth; elsif ($categorycode eq "L"){ $cardnumber = 1000000;} elsif ($categorycode eq "F"){ $cardnumber = 3000000;} elsif ($categorycode eq "C"){ $cardnumber = 8000000;} + elsif ($categorycode eq "N"){ $cardnumber = 4000000;} else{$cardnumber = 6000000;} # start at 1000000 or 3000000 or 5000000 } else { @@ -1218,12 +1211,15 @@ sub change_user_pass { if ( ($uid ne '') && ($sth->fetchrow) ) { return 0; - } else { + } else { #Everything is good so we can update the information. $sth=$dbh->prepare("update borrowers set userid=?, password=? where borrowernumber=?"); $sth->execute($uid, $digest, $member); return 1; } + +} + =head2 checkuniquemember (OUEST-PROVENCE) $result = &checkuniquemember($collectivity,$surname,$categorycode,$firstname,$dateofbirth); @@ -1238,7 +1234,6 @@ C<&firstname> is the firstname (only if collectivity=0) C<&dateofbirth> is the date of birth (only if collectivity=0) =cut - sub checkuniquemember { my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_; my $dbh = C4::Context->dbh; @@ -1345,7 +1340,7 @@ sub getcategorytype { my ( $category_type, $description ) = $sth->fetchrow; return $category_type, $description; } -} + diff --git a/C4/Serials.pm b/C4/Serials.pm index 4ee405376b..6634141b67 100644 --- a/C4/Serials.pm +++ b/C4/Serials.pm @@ -21,7 +21,6 @@ package C4::Serials; #assumes C4/Serials.pm use strict; use C4::Date; -use C4::Date; use C4::Suggestions; use C4::Biblio; use C4::Search; -- 2.39.5