Koha/circ/branchtransfers.pl

285 lines
7.8 KiB
Perl
Executable file

#!/usr/bin/perl
# WARNING: This file uses 4-character tabs!
#written 11/3/2002 by Finlay
#script to execute branch transfers of books
# 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 CGI;
use C4::Circulation::Circ2;
use C4::Output;
use C4::Reserves2;
use C4::Auth;
use C4::Interface::CGI::Output;
use HTML::Template;
use C4::Koha;
###############################################
# constants
my %env;
my $linecolor1='#ffffcc';
my $linecolor2='white';
my $branches = getbranches();
my $printers = getprinters(\%env);
###############################################
# Getting state
my $query=new CGI;
my $branch = getbranch($query, $branches);
my $printer = getprinter($query, $printers);
my $genbrname = $branches->{$branch}->{'branchname'} ;
my $genprname = $printers->{$printer}->{'printername'};
my $messages;
my $found;
my $reserved;
my $waiting;
my $reqmessage;
my $cancelled;
my $setwaiting;
my $reqbrchname;
my $request=$query->param('request');
my $borrnum = $query->param('borrowernumber');
my $tobranchcd=$query->param('tobranchcd');
my $frbranchcd='';
############
# Deal with the requests....
if ($request eq "KillWaiting") {
my $item = $query->param('itemnumber');
CancelReserve(0, $item, $borrnum);
$cancelled = 1;
$reqmessage =1;
}
my $ignoreRs = 0;
if ($request eq "SetWaiting") {
my $item = $query->param('itemnumber');
$tobranchcd = ReserveWaiting($item, $borrnum);
$reqbrchname = $branches->{$tobranchcd}->{'branchname'};
$ignoreRs = 1;
$setwaiting = 1;
$reqmessage =1;
}
if ($request eq 'KillReserved'){
my $biblio = $query->param('biblionumber');
CancelReserve($biblio, 0, $borrnum);
$cancelled = 1;
$reqmessage =1;
}
# set up the branchselect options....
my @branchoptionloop;
foreach my $br (keys %$branches) {
#(next) unless $branches->{$br}->{'CU'}; #FIXME disabled to fix bug 202
my %branch;
$branch{selected}=($br eq $tobranchcd);
$branch{code}=$br;
$branch{name}=$branches->{$br}->{'branchname'};
push (@branchoptionloop, \%branch);
}
# collect the stack of books already transfered so they can printed...
my @trsfitemloop;
my %transfereditems;
my %frbranchcds;
my %tobranchcds;
my $color=$linecolor2;
my $barcode = $query->param('barcode');
if ($barcode) {
my $transfered;
my $iteminformation;
($transfered, $messages, $iteminformation)
= transferbook($tobranchcd, $barcode, $ignoreRs);
$found = $messages->{'ResFound'};
if ($transfered) {
my %item;
my $frbranchcd = $iteminformation->{'holdingbranch'};
if (not ($found)) {
($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
$item{'color'}=$color;
$item{'biblionumber'}=$iteminformation->{'biblionumber'};
$item{'title'}=$iteminformation->{'title'};
$item{'author'}=$iteminformation->{'author'};
$item{'itemtype'}=$iteminformation->{'itemtype'};
$item{'frbrname'}=$branches->{$frbranchcd}->{'branchname'};
$item{'tobrname'}=$branches->{$tobranchcd}->{'branchname'};
}
$item{counter}=0;
$item{barcode}=$barcode;
$item{frombrcd}=$frbranchcd;
$item{tobrcd}=$tobranchcd;
##########
#Are these lines still useful ???
$transfereditems{0}=$barcode;
$frbranchcds{0}=$frbranchcd;
$tobranchcds{0}=$tobranchcd;
##########
push (@trsfitemloop, \%item);
}
}
foreach ($query->param){
(next) unless (/bc-(\d*)/);
my $counter=$1;
my %item;
my $bc=$query->param("bc-$counter");
my $frbcd=$query->param("fb-$counter");
my $tobcd=$query->param("tb-$counter");
$counter++;
$item{counter}=$counter;
$item{barcode}=$bc;
$item{frombrcd}=$frbcd;
$item{tobrcd}=$tobcd;
my ($iteminformation) = getiteminformation(\%env, 0, $bc);
($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
$item{'color'}=$color;
$item{'biblionumber'}=$iteminformation->{'biblionumber'};
$item{'title'}=$iteminformation->{'title'};
$item{'author'}=$iteminformation->{'author'};
$item{'itemtype'}=$iteminformation->{'itemtype'};
$item{'frbrname'}=$branches->{$frbcd}->{'branchname'};
$item{'tobrname'}=$branches->{$tobcd}->{'branchname'};
##########
#Are these lines still useful ???
$transfereditems{$counter}=$bc;
$frbranchcds{$counter}=$frbcd;
$tobranchcds{$counter}=$tobcd;
#########
push (@trsfitemloop, \%item);
}
my $name;
my $bornum;
my $borcnum;
my $itemnumber;
my $biblionum;
my $branchname;
#####################
if ($found) {
my $res = $messages->{'ResFound'};
$branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
my ($borr) = getpatroninformation(\%env, $res->{'borrowernumber'}, 0);
$name = name($borr);
$bornum = $borr->{'borrowernumber'}; #Hopefully, borr->{borrowernumber}=res->{borrowernumber}
$borcnum = $borr->{'cardnumber'};
$itemnumber = $res->{'itemnumber'};
if ($res->{'ResFound'} eq "Waiting") {
$waiting = 1;
}
if ($res->{'ResFound'} eq "Reserved") {
$reserved = 1;
$biblionum = $res->{'biblionumber'};
}
}
#####################
my @errmsgloop;
foreach my $code (keys %$messages) {
my %err;
$err{errbadcode} = ($code eq 'BadBarcode');
if ($code eq 'BadBarcode') {
$err{msg}=$messages->{'BadBarcode'};
}
$err{errispermanent} = ($code eq 'IsPermanent');
if ($code eq 'IsPermanent'){
$err{msg} = $branches->{$messages->{'IsPermanent'}}->{'branchname'};
# Here, msg contains the branchname
# Not so satisfied with this... But should work
}
$err{errdesteqholding} = ($code eq 'DestinationEqualsHolding');
$err{errwasreturned} = ($code eq 'WasReturned');
if ($code eq 'WasReturned') {
my ($borrowerinfo) = getpatroninformation(\%env, $messages->{'WasReturned'}, 0);
$name =name($borrowerinfo);
$bornum =$borrowerinfo->{'borrowernumber'};
$borcnum =$borrowerinfo->{'cardnumber'};
}
if ($code eq 'WasTransfered'){
# Put code here if you want to notify the user that item was transfered...
}
push (@errmsgloop, \%err);
}
#######################################################################################
# Make the page .....
my ($template, $borrowernumber, $cookie)
= get_template_and_user({template_name => "circ/branchtransfers.tmpl",
query => $query,
type => "intranet",
authnotrequired => 0,
flagsrequired => {circulate => 1},
});
$template->param( genbrname => $genbrname,
genprname => $genprname,
branch => $branch,
printer => $printer,
found => $found,
reserved => $reserved,
waiting => $waiting,
name => $name,
bornum => $bornum,
borcnum => $borcnum,
branchname => $branchname,
itemnumber => $itemnumber,
barcode => $barcode,
biblionumber => $biblionum,
tobranchcd => $tobranchcd,
reqmessage => $reqmessage,
cancelled => $cancelled,
setwaiting => $setwaiting,
trsfitemloop => \@trsfitemloop,
branchoptionloop => \@branchoptionloop,
errmsgloop => \@errmsgloop
);
output_html_with_http_headers $query, $cookie, $template->output;
sub name {
my ($borinfo) = @_;
return $borinfo->{'surname'}." ".$borinfo->{'title'}." ".$borinfo->{'firstname'};
}
# Local Variables:
# tab-width: 4
# End: