Bug fixing and complete removal of Date::Manip
This commit is contained in:
tgarip1957
parent
0d080fd644
commit
ab45e7aaab
|
|
@ -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
|
||||
|
|
|
|||
14
C4/Biblio.pm
14
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();
|
||||
|
|
|
|||
|
|
@ -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
|
||||
#
|
||||
|
|
|
|||
|
|
@ -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++;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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 <arensb at ooblick dot com>
|
|||
|
||||
=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
|
||||
#
|
||||
|
|
|
|||
|
|
@ -942,6 +942,7 @@ my (@tags,@subfield);
|
|||
}
|
||||
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Reference in New Issue