Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 168 lines (143 sloc) 5.396 kb
#written 11/3/2002 by Finlay
#script to execute branch transfers of books
use strict;
use CGI;
use C4::Circulation::Circ2;
use C4::Search;
use C4::Output;
my %env;
my $headerbackgroundcolor='#99cc33';
my $circbackgroundcolor='#ffffcc';
my $circbackgroundcolor='white';
my $linecolor1='#ffffcc';
my $linecolor2='white';
my $backgroundimage="/images/background-mem.gif";
my $query=new CGI;
my $branches=getbranches(\%env);
my $tobranchcd=$query->param('tobranchcd');
my $frbranchcd='';
my $tobranchoptions;
foreach (keys %$branches) {
(next) unless ($_);
(next) if (/^TR$/);
my $selected='';
($selected='selected') if ($_ eq $tobranchcd);
$tobranchoptions.="<option value=$_ $selected>$branches->{$_}->{'branchname'}\n";
# collect the stack of books already transfered so they can printed...
my @messages;
my %transfereditems;
my $ritext = '';
my %frbranchcds;
my %tobranchcds;
foreach ($query->param){
(next) unless (/bc-(\d*)/);
my $counter=$1;
my $barcode=$query->param("bc-$counter");
my $frbcd=$query->param("fb-$counter");
my $tobcd=$query->param("tb-$counter");
$ritext.="<input type=hidden name=bc-$counter value=$barcode>\n";
$ritext.="<input type=hidden name=fb-$counter value=$frbcd>\n";
$ritext.="<input type=hidden name=tb-$counter value=$tobcd>\n";
#if the barcode has been entered action that and write a message and onto the top of the stack...
my $iteminformation;
my $todaysdate;
if (my $barcode=$query->param('barcode')) {
my $iteminformation = getiteminformation(\%env,0, $barcode);
my $fail=0;
if (not $iteminformation) {
@messages = ("There is no book with barcode: $barcode ", @messages);
$frbranchcd = $iteminformation->{'holdingbranch'};
%env->{'frbranchcd'} = $frbranchcd;
if ($frbranchcd eq $tobranchcd) {
@messages = ("You can't transfer the book to the branch it is already at!", @messages);
# should add some more tests ... like is the book already out, maybe it cant be moved....
if (not $fail) {
my ($transfered, $message) = transferbook(\%env, $iteminformation, $barcode);
if (not $transfered) {@messages = ($message, @messages);}
else {
$ritext.="<input type=hidden name=bc-0 value=$barcode>\n";
$ritext.="<input type=hidden name=fb-0 value=$frbranchcd>\n";
$ritext.="<input type=hidden name=tb-0 value=$tobranchcd>\n";
@messages = ("Book: $barcode has been transfered", @messages);
my $entrytext= << "EOF";
<form method=post action=/cgi-bin/koha/circ/>
<table border=0 cellpadding=5 cellspacing=0 bgcolor='#dddddd' >
<tr><td colspan=2 bgcolor=$headerbackgroundcolor align=center background=$backgroundimage>
<font color=black><b>Select Branch</b></font></td></tr>
<tr><td>Destination Branch:</td>
<td><select name=tobranchcd> $tobranchoptions </select></td></tr></table>
<table border=0 cellpadding=5 cellspacing=0 bgcolor='#dddddd' ><tr>
<td colspan=2 bgcolor=$headerbackgroundcolor align=center background=$backgroundimage>
<font color=black><b>Enter Book Barcode</b></font></td></tr>
<tr><td>Item Barcode:</td><td><input name=barcode size=10></td></tr>
<input type=hidden name=tobranchcd value=$tobranchcd>
my $messagetable;
if (@messages) {
my $messagetext='';
foreach (@messages) {
$messagetable = << "EOF";
<table border=0 cellpadding=5 cellspacing=0 bgcolor='#dddddd'>
<tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black>Messages</font></th></tr>
<tr><td> $messagetext </td></tr></table>
print $query->header;
print startpage;
print startmenu('circulation');
print "<h3>Branch Transfers</h3>";
print $messagetable if (@messages);
print $entrytext;
if (%transfereditems) {
print << "EOF";
<table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd>
<tr><th colspan=6 bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black>Transfered Items</font></th></tr>
<tr><th>Bar Code</th><th>Title</th><th>Author</th><th>Type</th><th>From</th><th>To</th></tr>
my $color='';
foreach (keys %transfereditems) {
($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
my $barcode=$transfereditems{$_};
my $frbcd=$frbranchcds{$_};
my $tobcd=$tobranchcds{$_};
my ($iteminformation) = getiteminformation(\%env, 0, $barcode);
print << "EOF";
<tr><td bgcolor=$color align=center>
<a href=/cgi-bin/koha/$iteminformation->{'biblionumber'}
&type=intra onClick=\"openWindow(this, 'Item', 480, 640)\">$barcode</a></td>
<td bgcolor=$color>$iteminformation->{'title'}</td>
<td bgcolor=$color>$iteminformation->{'author'}</td>
<td bgcolor=$color align=center>$iteminformation->{'itemtype'}</td>
<td bgcolor=$color align=center>$branches->{$frbcd}->{'branchname'}</td>
<td bgcolor=$color align=center>$branches->{$tobcd}->{'branchname'}</td>
print "</table>\n";
print endmenu('circulation');
print endpage;
Jump to Line
Something went wrong with that request. Please try again.