circ/branchtransfers.pl

   1 #!/usr/bin/perl
   2
   3 #written 11/3/2002 by Finlay
   4 #script to execute branch transfers of books
   5
   6 use strict;
   7 use CGI;
   8 use C4::Circulation::Circ2;
   9 use C4::Search;
  10 use C4::Output;
  11
  12
  13 my %env;
  14 my $headerbackgroundcolor='#99cc33';
  15 my $circbackgroundcolor='#ffffcc';
  16 my $circbackgroundcolor='white';
  17 my $linecolor1='#ffffcc';
  18 my $linecolor2='white';
  19 my $backgroundimage="/images/background-mem.gif";
  20
  21 my $query=new CGI;
  22 my $branches=getbranches(\%env);
  23
  24 my $tobranchcd=$query->param('tobranchcd');
  25 my $frbranchcd='';
  26
  27 $env{'tobranchcd'}=$tobranchcd;
  28
  29
  30 my $tobranchoptions;
  31 foreach (keys %$branches) {
  32         (next) unless ($_);
  33         (next) if (/^TR$/);
  34         my $selected='';
  35         ($selected='selected') if ($_ eq $tobranchcd);
  36         $tobranchoptions.="<option value=$_ $selected>$branches->{$_}->{'branchname'}\n";
  37 }
  38
  39 # collect the stack of books already transfered so they can printed...
  40 my %transfereditems;
  41 my $ritext = '';
  42 my %frbranchcds;
  43 my %tobranchcds;
  44 foreach ($query->param){
  45     (next) unless (/bc-(\d*)/);
  46     my $counter=$1;
  47     (next) if ($counter>20);
  48     my $barcode=$query->param("bc-$counter");
  49     my $frbcd=$query->param("fb-$counter");
  50     my $tobcd=$query->param("tb-$counter");
  51     $counter++;
  52     $transfereditems{$counter}=$barcode;
  53     $frbranchcds{$counter}=$frbcd;
  54     $tobranchcds{$counter}=$tobcd;
  55     $ritext.="<input type=hidden name=bc-$counter value=$barcode>\n";
  56     $ritext.="<input type=hidden name=fb-$counter value=$frbcd>\n";
  57     $ritext.="<input type=hidden name=tb-$counter value=$tobcd>\n";
  58     }
  59
  60 #if the barcode has been entered action that and write a message and onto the top of the stack...
  61 my $iteminformation;
  62 my @messages;
  63 my $todaysdate;
  64 if (my $barcode=$query->param('barcode')) {
  65     my $iteminformation = getiteminformation(\%env,0, $barcode);
  66     my $fail=0;
  67     if (not $iteminformation) {
  68         $fail=1;
  69         @messages = ("There is no book with barcode: $barcode ", @messages);
  70     }
  71     $frbranchcd = $iteminformation->{'holdingbranch'};
  72     %env->{'frbranchcd'} = $frbranchcd;
  73     if ($frbranchcd eq $tobranchcd) {
  74         $fail=1;
  75         @messages = ("You can't transfer the book to the branch it is already at!", @messages);
  76     }
  77 # should add some more tests ... like is the book already out, maybe it cant be moved....
  78     if (not $fail) {
  79         my ($transfered, $message) = transferbook(\%env, $iteminformation, $barcode);
  80         if (not $transfered) {@messages = ($message, @messages);}
  81         else {
  82             $ritext.="<input type=hidden name=bc-0 value=$barcode>\n";
  83             $ritext.="<input type=hidden name=fb-0 value=$frbranchcd>\n";
  84             $ritext.="<input type=hidden name=tb-0 value=$tobranchcd>\n";
  85             $transfereditems{0}=$barcode;
  86             $frbranchcds{0}=$frbranchcd;
  87             $tobranchcds{0}=$tobranchcd;
  88             @messages = ("Book: $barcode has been transfered", @messages);
  89         }
  90     }
  91 }
  92
  93 my $entrytext= << "EOF";
  94 <form method=post action=/cgi-bin/koha/circ/branchtransfers.pl>
  95 <table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd >
  96 <tr><td colspan=2 bgcolor=$headerbackgroundcolor align=center background=$backgroundimage>
  97 <font color=black><b>Select Branch</b></font></td></tr>
  98 <tr><td>Destination Branch:</td><td>
  99  <select name=tobranchcd> $tobranchoptions </select>
 100 </td></tr>
 101
 102 </table><table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd >
 103 <tr><td colspan=2 bgcolor=$headerbackgroundcolor align=center background=$backgroundimage>
 104 <font color=black><b>Enter Book Barcode</b></font></td></tr>
 105 <tr><td>Item Barcode:</td><td><input name=barcode size=10></td></tr>
 106 </table>
 107
 108 <input type=hidden name=tobranchcd value=$tobranchcd>
 109 $ritext
 110 EOF
 111
 112 my $messagetable;
 113 if (@messages) {
 114     my $messagetext='';
 115     foreach (@messages) {
 116         $messagetext.="$_<p>\n";
 117     }
 118     $messagetable = << "EOF";
 119 <table border=0 cellpadding=5 cellspacing=0 bgcolor='#dddddd'>
 120 <tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black>Messages</font></th></tr>
 121 <tr><td> $messagetext </td></tr></table>
 122 EOF
 123 }
 124
 125
 126
 127 print $query->header;
 128 print startpage;
 129 print startmenu('circulation');
 130 print "<h3>Branch Transfers</h3>";
 131
 132
 133 print $messagetable if (@messages);
 134
 135
 136 print $entrytext;
 137
 138 if (%transfereditems) {
 139     print << "EOF";
 140 <p>
 141 <table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd>
 142 <tr><th colspan=6 bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black>Transfered Items</font></th></tr>
 143 <tr><th>Bar Code</th><th>Title</th><th>Author</th><th>Type</th><th>From</th><th>To</th></tr>
 144 EOF
 145     my $color='';
 146     foreach (keys %transfereditems) {
 147         ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
 148         my $barcode=$transfereditems{$_};
 149         my $frbcd=$frbranchcds{$_};
 150         my $tobcd=$tobranchcds{$_};
 151         my ($iteminformation) = getiteminformation(\%env, 0, $barcode);
 152         print << "EOF";
 153 <tr><td bgcolor=$color align=center>
 154 <a href=/cgi-bin/koha/detail.pl?bib=$iteminformation->{'biblionumber'}
 155 &type=intra onClick=\"openWindow(this, 'Item', 480, 640)\">$barcode</a></td>
 156 <td bgcolor=$color>$iteminformation->{'title'}</td>
 157 <td bgcolor=$color>$iteminformation->{'author'}</td>
 158 <td bgcolor=$color align=center>$iteminformation->{'itemtype'}</td>
 159 <td bgcolor=$color align=center>$branches->{$frbcd}->{'branchname'}</td>
 160 <td bgcolor=$color align=center>$branches->{$tobcd}->{'branchname'}</td>
 161 </tr>\n
 162 EOF
 163 }
 164     print "</table>\n";
 165 }
 166
 167 print endmenu('circulation');
 168 print endpage;
 169
 170
 171 ############################################################################
 172 #
 173 # this is the database query that will go into C4::Circuation::Circ2
 174 #
 175
 176 use DBI;
 177 use C4::Database;
 178
 179 sub transferbook {
 180     my ($env, $iteminformation, $barcode) = @_;
 181     my $messages;
 182     my $dbh=&C4Connect;
 183     #new entry in branchtransfers....
 184     my $sth = $dbh->prepare("insert into branchtransfers (itemnumber, frombranch, datearrived, tobranch) values($iteminformation->{'itemnumber'}, '$env->{'frbranchcd'}', now(), '$env->{'tobranchcd'}')");
 185     $sth->execute || return (0,"database error: $sth->errstr");
 186     $sth->finish;
 187     #update holdingbranch in items .....
 188     $sth = $dbh->prepare("update items set holdingbranch='$env->{'tobranchcd'}' where items.itemnumber=$iteminformation->{'itemnumber'}");
 189     $sth->execute || return (0,"database error: $sth->errstr");
 190     $sth->execute;
 191     $sth->finish;
 192     $dbh->disconnect;
 193     return (1, $messages);
 194 }
 195
 196