circ2.pm

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

package C4::Circulation::Circ2;

# $Id: Circ2.pm,v 1.21.2.16 2002/11/27 23:48:22 finlayt Exp $

#package to deal with Returns
#written 3/11/99 by [e-mail]


# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA  02111-1307 USA

use strict;
# use warnings;
require Exporter;
use DBI;
use C4::Database;
#use C4::Accounts;
#use C4::InterfaceCDK;
#use C4::Circulation::Main;
#use C4::Circulation::Renewals;
#use C4::Scan;
use C4::Stats;
use C4::Reserves2;
#use C4::Search;
#use C4::Print;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

# set the version for version checking
$VERSION = 0.01;

=head1 NAME

C4::Circulation::Circ2 - Koha circulation module

=head1 SYNOPSIS

  use C4::Circulation::Circ2;

=head1 DESCRIPTION

The functions in this module deal with circulation, issues, and
returns, as well as general information about the library.

=head1 FUNCTIONS

=over 2

=cut

@ISA = qw(Exporter);
@EXPORT = qw(&getbranches &getprinters &getpatroninformation
	&currentissues &getissues &getiteminformation &findborrower
	&issuebook &returnbook &find_reserves &transferbook &decode
	&calc_charges);

=item getbranches

  $branches = &getbranches();
  @branch_codes = keys %$branches;
  %main_branch_info = %{$branches->{"MAIN"}};

Returns information about existing library branches.

C<$branches> is a reference-to-hash. Its keys are the branch codes for
all of the existing library branches, and its values are
references-to-hash describing that particular branch.

In each branch description (C<%main_branch_info>, above), there is a
key for each field in the branches table of the Koha database. In
addition, there is a key for each branch category code to which the
branch belongs (the category codes are taken from the branchrelations
table).

=cut
#'
# FIXME - This function doesn't feel as if it belongs here. It should
# go in some generic or administrative module, not in circulation.
sub getbranches {
# returns a reference to a hash of references to branches...
    my %branches;
    my $dbh=&C4Connect;  
    my $sth=$dbh->prepare("select * from branches");
    $sth->execute;
    while (my $branch=$sth->fetchrow_hashref) {
	my $tmp = $branch->{'branchcode'}; my $brc = $dbh->quote($tmp);
		# FIXME - my $brc = $dbh->quote($branch->{"branchcode"});
	my $query = "select categorycode from branchrelations where branchcode = $brc";
	my $nsth = $dbh->prepare($query);
	$nsth->execute;
	while (my ($cat) = $nsth->fetchrow_array) {
	    # FIXME - This seems wrong. It ought to be
	    # $branch->{categorycodes}{$cat} = 1;
	    # otherwise, there's a namespace collision if there's a
	    # category with the same name as a field in the 'branches'
	    # table (i.e., don't create a category called "issuing").
	    # In addition, the current structure doesn't really allow
	    # you to list the categories that a branch belongs to:
	    # you'd have to list keys %$branch, and remove those keys
	    # that aren't fields in the "branches" table.
	    $branch->{$cat} = 1;
	}
	$nsth->finish;
	$branches{$branch->{'branchcode'}}=$branch;
    }
    $dbh->disconnect;
    return (\%branches);
}

=item getprinters

  $printers = &getprinters($env);
  @queues = keys %$printers;

Returns information about existing printer queues.

C<$env> is ignored.

C<$printers> is a reference-to-hash whose keys are the print queues
defined in the printers table of the Koha database. The values are
references-to-hash, whose keys are the fields in the printers table.

=cut
#'
# FIXME - Perhaps this really belongs in C4::Print?
sub getprinters {
    my ($env) = @_;
    my %printers;
    my $dbh=&C4Connect;  
    my $sth=$dbh->prepare("select * from printers");
    $sth->execute;
    while (my $printer=$sth->fetchrow_hashref) {
	$printers{$printer->{'printqueue'}}=$printer;
    }
    $dbh->disconnect;
    return (\%printers);
}

=item getpatroninformation

  ($borrower, $flags) = &getpatroninformation($env, $borrowernumber,
					$cardnumber);

Looks up a patron and returns information about him or her. If
C<$borrowernumber> is true (nonzero), C<&getpatroninformation> looks
up the borrower by number; otherwise, it looks up the borrower by card
number.

C<$env> is effectively ignored, but should be a reference-to-hash.

C<$borrower> is a reference-to-hash whose keys are the fields of the
borrowers table in the Koha database. In addition,
C<$borrower-E<gt>{flags}> is the same as C<$flags>.

C<$flags> is a reference-to-hash giving more detailed information
about the patron. Its keys act as flags: if they are set, then the key
is a reference-to-hash that gives further details:

  if (exists($flags->{LOST}))
  {
	  # Patron's card was reported lost
	  print $flags->{LOST}{message}, "\n";
  }

Each flag has a C<message> key, giving a human-readable explanation of
the flag. If the state of a flag means that the patron should not be
allowed to borrow any more books, then it will have a C<noissues> key
with a true value.

The possible flags are:

=over 4

=item CHARGES

Shows the patron's credit or debt, if any.

=item GNA

(Gone, no address.) Set if the patron has left without giving a
forwarding address.

=item LOST

Set if the patron's card has been reported as lost.

=item DBARRED

Set if the patron has been debarred.

=item NOTES

Any additional notes about the patron.

=item ODUES

Set if the patron has overdue items. This flag has several keys:

C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
overdue items. Its elements are references-to-hash, each describing an
overdue item. The keys are selected fields from the issues, biblio,
biblioitems, and items tables of the Koha database.

C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
the overdue items, one per line.

=item WAITING

Set if any items that the patron has reserved are available.

C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
available items. Each element is a reference-to-hash whose keys are
fields from the reserves table of the Koha database.

=back

=cut
#'
sub getpatroninformation {
# returns
    my ($env, $borrowernumber,$cardnumber) = @_;
    my $dbh=&C4Connect;  
    my $query;
    my $sth;
    if ($borrowernumber) {
	$query = "select * from borrowers where borrowernumber=$borrowernumber";
    } elsif ($cardnumber) {
	$query = "select * from borrowers where cardnumber=$cardnumber";
    } else {
	$env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine";
	return();
    }
    $env->{'mess'} = $query;
    $sth = $dbh->prepare($query);
    $sth->execute;
    my $borrower = $sth->fetchrow_hashref;
    my $amount = checkaccount($env, $borrowernumber, $dbh);
    $borrower->{'amountoutstanding'} = $amount;
    my $flags = patronflags($env, $borrower, $dbh);
    my $accessflagshash;

    $sth=$dbh->prepare("select bit,flag from userflags");
    $sth->execute;
    while (my ($bit, $flag) = $sth->fetchrow) {
	if ($borrower->{'flags'} & 2**$bit) {
	    $accessflagshash->{$flag}=1;
	}
    }
    $sth->finish;
    $dbh->disconnect;
    $borrower->{'flags'}=$flags;
    return ($borrower, $flags, $accessflagshash);
}

=item decode

  $str = &decode($chunk);

Decodes a segment of a string emitted by a CueCat barcode scanner and
returns it.

=cut
#'
# FIXME - At least, I'm pretty sure this is for decoding CueCat stuff.
sub decode {
    my ($encoded) = @_;
    my $seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
    my @s = map { index($seq,$_); } split(//,$encoded);
    my $l = ($#s+1) % 4;
    if ($l)
    {
	if ($l == 1)
	{
	    print "Error!";
	    return;
	}
	$l = 4-$l;
	$#s += $l;
    }
    my $r = '';
    while ($#s >= 0)
    {
	my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3];
	$r .=chr(($n >> 16) ^ 67) .
	     chr(($n >> 8 & 255) ^ 67) .
	     chr(($n & 255) ^ 67);
	@s = @s[4..$#s];
    }
    $r = substr($r,0,length($r)-$l);
    return $r;
}

=item getiteminformation

  $item = &getiteminformation($env, $itemnumber, $barcode);

Looks up information about an item, given either its item number or
its barcode. If C<$itemnumber> is a nonzero value, it is used;
otherwise, C<$barcode> is used.

C<$env> is effectively ignored, but should be a reference-to-hash.

C<$item> is a reference-to-hash whose keys are fields from the biblio,
items, and biblioitems tables of the Koha database. It may also
contain the following keys:

=over 4

=item C<date_due>

The due date on this item, if it has been borrowed and not returned
yet. The date is in YYYY-MM-DD format.

=item C<loanlength>

The length of time for which the item can be borrowed, in days.

=item C<notforloan>

True if the item may not be borrowed.

=back

=cut
#'
sub getiteminformation {
# returns a hash of item information given either the itemnumber or the barcode
    my ($env, $itemnumber, $barcode) = @_;
    my $dbh=&C4Connect;
    my $sth;
    if ($itemnumber) {
	$sth=$dbh->prepare("select * from biblio,items,biblioitems where items.itemnumber=$itemnumber and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
    } elsif ($barcode) {
	my $q_barcode=$dbh->quote($barcode);
	$sth=$dbh->prepare("select * from biblio,items,biblioitems where items.barcode=$q_barcode and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
    } else {
	$env->{'apierror'}="getiteminformation() subroutine must be called with either an itemnumber or a barcode";
	# Error condition.
	return();
    }
    $sth->execute;
    my $iteminformation=$sth->fetchrow_hashref;
    $sth->finish;
    # FIXME - Style: instead of putting the entire rest of the
    # function in a block, just say
    #	return undef unless $iteminformation;
    # That way, the rest of the function needn't be indented as much.
    if ($iteminformation) {
	$sth=$dbh->prepare("select date_due from issues where itemnumber=$iteminformation->{'itemnumber'} and isnull(returndate)");
	$sth->execute;
	my ($date_due) = $sth->fetchrow;
	$iteminformation->{'date_due'}=$date_due;
	$sth->finish;
	# FIXME - The Dewey code is a string, not a number. Besides,
	# "000" is a perfectly valid Dewey code.
	#$iteminformation->{'dewey'}=~s/0*$//;
	($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}='');
	# FIXME - fetchrow_hashref is documented as being inefficient.
	# Perhaps this should be rewritten as
	#	$sth = $dbh->prepare("select loanlength, notforloan ...");