circ2.pm

来自「开源图书馆管理软件」· PM 代码 · 共 1,870 行 · 第 1/5 页

	    $msth->execute;
      # offset transactions
	    my $newamtos;
	    my $accdata;
	    while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
		if ($accdata->{'amountoutstanding'} < $amountleft) {
		    $newamtos = 0;
		    $amountleft -= $accdata->{'amountoutstanding'};
		}  else {
		    $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
		    $amountleft = 0;
		}
		my $thisacct = $accdata->{'accountno'};
		my $updquery = "update accountlines set amountoutstanding= '$newamtos'
		                 where (borrowernumber = '$data->{'borrowernumber'}')
                                   and (accountno='$thisacct')";
		my $usth = $dbh->prepare($updquery);
		$usth->execute;
		$usth->finish;
		$updquery = "insert into accountoffsets
		          (borrowernumber, accountno, offsetaccount,  offsetamount)
		          values
		          ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')";
		$usth = $dbh->prepare($updquery);
		$usth->execute;
		$usth->finish;
	    }
	    $msth->finish;
	}
	if ($amountleft > 0){
	    $amountleft*=-1;
	}
	my $desc="Book Returned ".$iteminfo->{'barcode'};
	$uquery = "insert into accountlines
		  (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
		  values ('$data->{'borrowernumber'}','$nextaccntno',now(),0-$amount,'$desc',
		  'CR',$amountleft)";
	$usth = $dbh->prepare($uquery);
	$usth->execute;
	$usth->finish;
	$uquery = "insert into accountoffsets
		  (borrowernumber, accountno, offsetaccount,  offsetamount)
		  values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
	$usth = $dbh->prepare($uquery);
	$usth->execute;
	$usth->finish;
	$uquery = "update items set paidfor='' where itemnumber=$itm";
	$usth = $dbh->prepare($uquery);
	$usth->execute;
	$usth->finish;
    }
    $sth->finish;
    return;
}

# Not exported
sub fixoverduesonreturn {
    my ($brn, $itm) = @_;
    my $dbh=&C4Connect;
    $itm = $dbh->quote($itm);
    $brn = $dbh->quote($brn);
# check for overdue fine
    my $query = "select * from accountlines where (borrowernumber=$brn)
                           and (itemnumber = $itm) and (accounttype='FU' or accounttype='O')";
    my $sth = $dbh->prepare($query);
    $sth->execute;
# alter fine to show that the book has been returned
    if (my $data = $sth->fetchrow_hashref) {
	my $query = "update accountlines set accounttype='F' where (borrowernumber = $brn)
                           and (itemnumber = $itm) and (acccountno='$data->{'accountno'}')";
	my $usth=$dbh->prepare($query);
	$usth->execute();
	$usth->finish();
    }
    $sth->finish;
    return;
}

# Not exported
#
# NOTE!: If you change this function, be sure to update the POD for
# &getpatroninformation.
#
# $flags = &patronflags($env, $patron, $dbh);
#
# $flags->{CHARGES}
#		{message}	Message showing patron's credit or debt
#		{noissues}	Set if patron owes >$5.00
#         {GNA}			Set if patron gone w/o address
#		{message}	"Borrower has no valid address"
#		{noissues}	Set.
#         {LOST}		Set if patron's card reported lost
#		{message}	Message to this effect
#		{noissues}	Set.
#         {DBARRED}		Set is patron is debarred
#		{message}	Message to this effect
#		{noissues}	Set.
#         {NOTES}		Set if patron has notes
#		{message}	Notes about patron
#         {ODUES}		Set if patron has overdue books
#		{message}	"Yes"
#		{itemlist}	ref-to-array: list of overdue books
#		{itemlisttext}	Text list of overdue items
#         {WAITING}		Set if there are items available that the
#				patron reserved
#		{message}	Message to this effect
#		{itemlist}	ref-to-array: list of available items
sub patronflags {
# Original subroutine for Circ2.pm
    my %flags;
    my ($env, $patroninformation, $dbh) = @_;
    my $amount = $patroninformation->{'amountoutstanding'};
    if ($amount > 0) { 
	my %flaginfo;
	$flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
	if ($amount > 5) {
	    $flaginfo{'noissues'} = 1;
	}
	$flags{'CHARGES'} = \%flaginfo;
    } elsif ($amount < 0){
       my %flaginfo;
       $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
       	$flags{'CHARGES'} = \%flaginfo;
    }
    if ($patroninformation->{'gonenoaddress'} == 1) {
	my %flaginfo;
	$flaginfo{'message'} = 'Borrower has no valid address.';
	$flaginfo{'noissues'} = 1;
	$flags{'GNA'} = \%flaginfo;
    }
    if ($patroninformation->{'lost'} == 1) {
	my %flaginfo;
	$flaginfo{'message'} = 'Borrower\'s card reported lost.';
	$flaginfo{'noissues'} = 1;
	$flags{'LOST'} = \%flaginfo;
    }
    if ($patroninformation->{'debarred'} == 1) {
	my %flaginfo;
	$flaginfo{'message'} = 'Borrower is Debarred.';
	$flaginfo{'noissues'} = 1;
	$flags{'DBARRED'} = \%flaginfo;
    }
    if ($patroninformation->{'borrowernotes'}) {
	my %flaginfo;
	$flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
	$flags{'NOTES'} = \%flaginfo;
    }
    my ($odues, $itemsoverdue)
                  = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
    if ($odues > 0) {
	my %flaginfo;
	$flaginfo{'message'} = "Yes";
	$flaginfo{'itemlist'} = $itemsoverdue;
	foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
	    $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
	}
	$flags{'ODUES'} = \%flaginfo;
    }
    my ($nowaiting, $itemswaiting)
                  = CheckWaiting($patroninformation->{'borrowernumber'});
    if ($nowaiting > 0) {
	my %flaginfo;
	$flaginfo{'message'} = "Reserved items available";
	$flaginfo{'itemlist'} = $itemswaiting;
	$flags{'WAITING'} = \%flaginfo;
    }
    return(\%flags);
}


# Not exported
sub checkoverdues {
# From Main.pm, modified to return a list of overdueitems, in addition to a count
  #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 @overdueitems;
  my $count = 0;
  my $query = "SELECT * FROM issues,biblio,biblioitems,items
                       WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
                         AND items.biblionumber     = biblio.biblionumber
                         AND issues.itemnumber      = items.itemnumber
                         AND issues.borrowernumber  = $bornum
                         AND issues.returndate is NULL
                         AND issues.date_due < '$today'";
  my $sth = $dbh->prepare($query);
  $sth->execute;
  while (my $data = $sth->fetchrow_hashref) {
      push (@overdueitems, $data);
      $count++;
  }
  $sth->finish;
  return ($count, \@overdueitems);
}

# Not exported
sub currentborrower {
# Original subroutine for Circ2.pm
    my ($itemnumber) = @_;
    my $dbh = &C4Connect;
    my $q_itemnumber = $dbh->quote($itemnumber);
    my $sth=$dbh->prepare("select borrowers.borrowernumber from
    issues,borrowers where issues.itemnumber=$q_itemnumber and
    issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
    NULL");
    $sth->execute;
    my ($borrower) = $sth->fetchrow;
    return($borrower);
}

# FIXME - Not exported, but used in 'updateitem.pl' anyway.
sub checkreserve {
# Stolen from Main.pm
  # Check for reserves for biblio
  my ($env,$dbh,$itemnum)=@_;
  my $resbor = "";
  my $query = "select * from reserves,items
    where (items.itemnumber = '$itemnum')
    and (reserves.cancellationdate is NULL)
    and (items.biblionumber = reserves.biblionumber)
    and ((reserves.found = 'W')
    or (reserves.found is null))
    order by priority";
  my $sth = $dbh->prepare($query);
  $sth->execute();
  my $resrec;
  my $data=$sth->fetchrow_hashref;
  while ($data && $resbor eq '') {
    $resrec=$data;
    my $const = $data->{'constrainttype'};
    if ($const eq "a") {
      $resbor = $data->{'borrowernumber'};
    } else {
      my $found = 0;
      my $cquery = "select * from reserveconstraints,items
         where (borrowernumber='$data->{'borrowernumber'}')
         and reservedate='$data->{'reservedate'}'
         and reserveconstraints.biblionumber='$data->{'biblionumber'}'
         and (items.itemnumber=$itemnum and
         items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
      my $csth = $dbh->prepare($cquery);
      $csth->execute;
      if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
      if ($const eq 'o') {
        if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
      } else {
        if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
      }
      $csth->finish();
    }
    $data=$sth->fetchrow_hashref;
  }
  $sth->finish;
  return ($resbor,$resrec);
}

=item currentissues

  $issues = &currentissues($env, $borrower);

Returns a list of books currently on loan to a patron.

If C<$env-E<gt>{todaysissues}> is set and true, C<&currentissues> only
returns information about books issued today. If
C<$env-E<gt>{nottodaysissues}> is set and true, C<&currentissues> only
returns information about books issued before today. If both are
specified, C<$env-E<gt>{todaysissues}> is ignored. If neither is
specified, C<&currentissues> returns all of the patron's issues.

C<$borrower->{borrowernumber}> is the borrower number of the patron
whose issues we want to list.

C<&currentissues> returns a PHP-style array: C<$issues> is a
reference-to-hash whose keys are integers in the range 1...I<n>, where
I<n> is the number of items on issue (either today or before today).
C<$issues-E<gt>{I<n>}> is a reference-to-hash whose keys are all of
the fields of the biblio, biblioitems, items, and issues fields of the
Koha database for that particular item.

=cut
#'
sub currentissues {
# New subroutine for Circ2.pm
    my ($env, $borrower) = @_;
    my $dbh=&C4Connect;
    my %currentissues;
    my $counter=1;
    my $borrowernumber = $borrower->{'borrowernumber'};
    my $crit='';

    # Figure out whether to get the books issued today, or earlier.
    # FIXME - $env->{todaysissues} and $env->{nottodaysissues} can
    # both be specified, but are mutually-exclusive. This is bogus.
    # Make this a flag. Or better yet, return everything in (reverse)
    # chronological order and let the caller figure out which books
    # were issued today.
    if ($env->{'todaysissues'}) {
	# FIXME - Could use
	#	$today = POSIX::strftime("%Y%m%d", localtime);
	# 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];
	$today=sprintf "%4d%02d%02d", (1900+$datearr[5]), ($datearr[4]+1), $datearr[3];
	$crit=" and issues.timestamp like '$today%' ";
    }
    if ($env->{'nottodaysissues'}) {
	# FIXME - Could use
	#	$today = POSIX::strftime("%Y%m%d", localtime);
	# 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];
	$today=sprintf "%4d%02d%02d", (1900+$datearr[5]), ($datearr[4]+1), $datearr[3];
	$crit=" and !(issues.timestamp like '$today%') ";
    }

    # FIXME - Does the caller really need every single field from all
    # four tables?
    my $select="select * from issues,items,biblioitems,biblio where
       borrowernumber='$borrowernumber' and issues.itemnumber=items.itemnumber and
       items.biblionumber=biblio.biblionumber and
       items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
       $crit order by issues.date_due";
#    warn $select;
    my $sth=$dbh->prepare($select);
    $sth->execute;
    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 $datedue=$data->{'date_due'};
	$datedue=~s/-//g;
	if ($datedue < $todaysdate) {
	    $data->{'overdue'}=1;
	}
	my $itemnumber=$data->{'itemnumber'};
	# FIXME - Consecutive integers as hash keys? You have GOT to
	# be kidding me! Use an array, fercrissakes!
	$currentissues{$counter}=$data;
	$counter++;
    }
    $sth->finish;
    $dbh->disconnect;
    return(\%currentissues);
}

=item getissues

  $issues = &getissues($borrowernumber);

Returns the set of books currently on loan to a patron.

C<$borrowernumber> is the patron's borrower number.

C<&getissues> returns a PHP-style array: C<$issues> is a
reference-to-hash whose keys are integers in the range 0..I<n>-1,
where I<n> is the number of books the patron currently has on loan.

The values of C<$issues> are references-to-hash whose keys are