circ2.pm

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

selected fields from the issues, items, biblio, and biblioitems tables
of the Koha database.

=cut
#'
sub getissues {
# New subroutine for Circ2.pm
    my ($borrower) = @_;
    my $dbh=&C4Connect;
    my $borrowernumber = $borrower->{'borrowernumber'};
    my %currentissues;
    my $select = "SELECT issues.timestamp      AS timestamp, 
                         issues.date_due       AS date_due, 
                         items.biblionumber    AS biblionumber,
                         items.itemnumber    AS itemnumber,
                         items.barcode         AS barcode, 
                         biblio.title          AS title, 
                         biblio.author         AS author, 
                         biblioitems.dewey     AS dewey, 
                         itemtypes.description AS itemtype,
                         itemtypes.publictype  AS publictype,
                         biblioitems.subclass  AS subclass
                    FROM issues,items,biblioitems,biblio, itemtypes
                   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";
#    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;
	}
	$currentissues{$counter} = $data;
	$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;
    $dbh->disconnect;
    return(\%currentissues);
}

# Not exported
sub checkwaiting {
#Stolen from Main.pm
  # check for reserves waiting
  my ($env,$dbh,$bornum)=@_;
  my @itemswaiting;
  my $query = "select * from reserves
    where (borrowernumber = '$bornum')
    and (reserves.found='W') and cancellationdate is NULL";
  my $sth = $dbh->prepare($query);
  $sth->execute();
  my $cnt=0;
  if (my $data=$sth->fetchrow_hashref) {
    $itemswaiting[$cnt] =$data;
    $cnt ++
  }
  $sth->finish;
  return ($cnt,\@itemswaiting);
}

# Not exported
# FIXME - This is nearly-identical to &C4::Accounts::checkaccount
sub checkaccount  {
# Stolen from Accounts.pm
  #take borrower number
  #check accounts and list amounts owing
  my ($env,$bornumber,$dbh,$date)=@_;
  my $select="SELECT SUM(amountoutstanding) AS total
                FROM accountlines 
               WHERE borrowernumber = $bornumber 
                 AND amountoutstanding<>0";
  if ($date ne ''){
    $select.=" AND date < '$date'";
  }
#  print $select;
  my $sth=$dbh->prepare($select);
  $sth->execute;
  my $data=$sth->fetchrow_hashref;
  my $total = $data->{'total'};
  $sth->finish;
  # output(1,2,"borrower owes $total");
  #if ($total > 0){
  #  # output(1,2,"borrower owes $total");
  #  if ($total > 5){
  #    reconcileaccount($env,$dbh,$bornumber,$total);
  #  }
  #}
  #  pause();
  return($total);
}

# FIXME - This is identical to &C4::Circulation::Renewals::renewstatus.
# Pick one and stick with it.
sub renewstatus {
# Stolen from Renewals.pm
  # check renewal status
  my ($env,$dbh,$bornum,$itemno)=@_;
  my $renews = 1;
  my $renewokay = 0;
  my $q1 = "select * from issues
    where (borrowernumber = '$bornum')
    and (itemnumber = '$itemno')
    and returndate is null";
  my $sth1 = $dbh->prepare($q1);
  $sth1->execute;
  if (my $data1 = $sth1->fetchrow_hashref) {
    my $q2 = "select renewalsallowed from items,biblioitems,itemtypes
       where (items.itemnumber = '$itemno')
       and (items.biblioitemnumber = biblioitems.biblioitemnumber)
       and (biblioitems.itemtype = itemtypes.itemtype)";
    my $sth2 = $dbh->prepare($q2);
    $sth2->execute;
    if (my $data2=$sth2->fetchrow_hashref) {
      $renews = $data2->{'renewalsallowed'};
    }
    if ($renews > $data1->{'renewals'}) {
      $renewokay = 1;
    }
    $sth2->finish;
  }
  $sth1->finish;
  return($renewokay);
}

sub renewbook {
# Stolen from Renewals.pm
  # mark book as renewed
  my ($env,$dbh,$bornum,$itemno,$datedue)=@_;
  if (!defined($dbh)){
      $dbh=C4Connect();
  }
  $datedue=$env->{'datedue'};
  if ($datedue eq "" ) {
    my $loanlength=21;
    my $query= "Select * from biblioitems,items,itemtypes
       where (items.itemnumber = '$itemno')
       and (biblioitems.biblioitemnumber = items.biblioitemnumber)
       and (biblioitems.itemtype = itemtypes.itemtype)";
    my $sth=$dbh->prepare($query);
    $sth->execute;
    if (my $data=$sth->fetchrow_hashref) {
      $loanlength = $data->{'loanlength'}
    }
    $sth->finish;
    my $ti = time;
    my $datedu = time + ($loanlength * 86400);
    my @datearr = localtime($datedu);
    $datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
  }
  my @date = split("-",$datedue);
  my $odatedue = ($date[2]+0)."-".($date[1]+0)."-".$date[0];
  my $issquery = "select * from issues where borrowernumber='$bornum' and
    itemnumber='$itemno' and returndate is null";
  my $sth=$dbh->prepare($issquery);
  $sth->execute;
  my $issuedata=$sth->fetchrow_hashref;
  $sth->finish;
  my $renews = $issuedata->{'renewals'} +1;
  my $updquery = "update issues
    set date_due = '$datedue', renewals = '$renews'
    where borrowernumber='$bornum' and
    itemnumber='$itemno' and returndate is null";
  $sth=$dbh->prepare($updquery);

  $sth->execute;
  $sth->finish;
  return($odatedue);
}

# FIXME - This is almost, but not quite, identical to
# &C4::Circulation::Issues::calc_charges and
# &C4::Circulation::Renewals2::calc_charges.
# Pick one and stick with it.
sub calc_charges {
# Stolen from Issues.pm
# calculate charges due
    my ($env, $dbh, $itemno, $bornum)=@_;

    $dbh=C4Connect() unless $dbh;

    my $charge=0;
#    open (FILE,">>/tmp/charges");
    my $item_type;
    my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
    where (items.itemnumber ='$itemno')
    and (biblioitems.biblioitemnumber = items.biblioitemnumber)
    and (biblioitems.itemtype = itemtypes.itemtype)";

    my $sth1= $dbh->prepare($q1);
#    print FILE "$q1\n";
    $sth1->execute;
    if (my $data1=$sth1->fetchrow_hashref) {
	$item_type = $data1->{'itemtype'};
	$charge = $data1->{'rentalcharge'};
	print FILE "charge is $charge\n";
	my $q2 = "select rentaldiscount from borrowers,categoryitem
	where (borrowers.borrowernumber = '$bornum')
	and (borrowers.categorycode = categoryitem.categorycode)
	and (categoryitem.itemtype = '$item_type')";
	my $sth2=$dbh->prepare($q2);
#	warn $q2;
	$sth2->execute;
	if (my $data2=$sth2->fetchrow_hashref) {
	    my $discount = $data2->{'rentaldiscount'};

	    if ($discount eq 'NULL') {
	      $discount=0;
	    }
#	    	    print FILE "discount is $discount\n";
	    $charge = ($charge *(100 - $discount)) / 100;
	}
	$sth2->finish;
    }
    $sth1->finish;
 #   print FILE "charge is now $charge\n itemtype = $item_type";
 #   close FILE;
    return ($charge, $item_type);
}

# 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 $nextaccntno = getnextacctno($env,$bornum,$dbh);
    my $sth = $dbh->prepare(<<EOT);
	INSERT INTO	accountlines
			(borrowernumber, itemnumber, accountno,
			 date, amount, description, accounttype,
			 amountoutstanding)
	VALUES		(?, ?, ?,
			 now(), ?, 'Rental', 'Rent',
			 ?)
EOT
    $sth->execute($bornum, $itemno, $nextaccntno, $charge, $charge);
    $sth->finish;
}


sub getnextacctno {
# Stolen from Accounts.pm
    my ($env,$bornumber,$dbh)=@_;
    my $nextaccntno = 1;
    my $query = "select * from accountlines where (borrowernumber = '$bornumber') order by accountno desc";
    my $sth = $dbh->prepare($query);
    $sth->execute;
    if (my $accdata=$sth->fetchrow_hashref){
	$nextaccntno = $accdata->{'accountno'} + 1;
    }
    $sth->finish;
    return($nextaccntno);
}

=item find_reserves

  ($status, $record) = &find_reserves($itemnumber);

Looks up an item in the reserves.

C<$itemnumber> is the itemnumber to look up.

C<$status> is true iff the search was successful.

C<$record> is a reference-to-hash describing the reserve. Its keys are
the fields from the reserves table of the Koha database.

=cut
#'
# 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 $dbh=&C4Connect;
    my ($itemdata) = getiteminformation(\%env, $itemno,0);
    my $bibno = $dbh->quote($itemdata->{'biblionumber'});
    my $bibitm = $dbh->quote($itemdata->{'biblioitemnumber'});
    my $query = "select * from reserves where ((found = 'W') or (found is null))
                       and biblionumber = $bibno and cancellationdate is NULL
                       order by priority, reservedate ";
    my $sth = $dbh->prepare($query);
    $sth->execute;
    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.)
	$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) {
		$resfound = 1;
	    }
        } else {
	    # FIXME - Use 'elsif' to avoid unnecessary indentation.
	    if ($resrec->{'constrainttype'} eq "a") {
		$resfound = 1;
	    } else {
                my $conquery = "select * from reserveconstraints where borrowernumber = $brn
                     and reservedate = $rdate and biblionumber = $bibno and biblioitemnumber = $bibitm";
		my $consth = $dbh->prepare($conquery);
		$consth->execute;
		if (my $conrec = $consth->fetchrow_hashref) {
		    if ($resrec->{'constrainttype'} eq "o") {
			$resfound = 1;
		    }
		}
		$consth->finish;
	    }
	}
	if ($resfound) {
            my $updquery = "update reserves set found = 'W', itemnumber = '$itemno'
                  where borrowernumber = $brn and reservedate = $rdate and biblionumber = $bibno";
	    my $updsth = $dbh->prepare($updquery);
	    $updsth->execute;
	    $updsth->finish;
	    # FIXME - "last;" here to break out of the loop early.
	}
    }
    $sth->finish;
    return ($resfound,$lastrec);
}

1;
__END__

=back

=head1 AUTHOR

Koha Developement team <[e-mail]>

=cut