circ/branchtransfers.pl

   1 #!/usr/bin/perl
   2 # WARNING: This file uses 4-character tabs!
   3
   4 #written 11/3/2002 by Finlay
   5 #script to execute branch transfers of books
   6
   7
   8 # Copyright 2000-2002 Katipo Communications
   9 #
  10 # This file is part of Koha.
  11 #
  12 # Koha is free software; you can redistribute it and/or modify it under the
  13 # terms of the GNU General Public License as published by the Free Software
  14 # Foundation; either version 2 of the License, or (at your option) any later
  15 # version.
  16 #
  17 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  18 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  19 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  20 #
  21 # You should have received a copy of the GNU General Public License along with
  22 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  23 # Suite 330, Boston, MA  02111-1307 USA
  24
  25 use strict;
  26 use CGI;
  27 use C4::Circulation::Circ2;
  28 use C4::Reserves2;
  29 use C4::Auth;
  30 use C4::Interface::CGI::Output;
  31 use C4::Koha;
  32 use C4::Members;
  33 ###############################################
  34 # constants
  35
  36 my %env;
  37 my $linecolor1='#ffffcc';
  38 my $linecolor2='white';
  39
  40 my $branches = GetBranches();
  41 my $printers = getprinters(\%env);
  42
  43
  44 ###############################################
  45 #  Getting state
  46
  47 my $query=new CGI;
  48
  49
  50 my $branch = getbranch($query, $branches);
  51 my $printer = getprinter($query, $printers);
  52
  53 my $genbrname = $branches->{$branch}->{'branchname'} ;
  54 my $genprname = $printers->{$printer}->{'printername'};
  55
  56 my $messages;
  57 my $found;
  58 my $reserved;
  59 my $waiting;
  60 my $reqmessage;
  61 my $cancelled;
  62 my $setwaiting;
  63 my $reqbrchname;
  64 my $user=$query->param('loggedinuser');
  65 my $request=$query->param('request');
  66 my $borrnum = $query->param('borrowernumber');
  67
  68 my $tobranchcd=$query->param('tobranchcd');
  69 my $frbranchcd='';
  70 my $dbh=C4::Context->dbh;
  71 ############
  72 # Deal with the requests....
  73 if ($request eq "KillWaiting") {
  74     my $item = $query->param('itemnumber');
  75     CancelReserve(0, $item, $borrnum);
  76         $cancelled = 1;
  77         $reqmessage =1;
  78 }
  79
  80 my $ignoreRs = 0;
  81 if ($request eq "SetWaiting") {
  82     my $item = $query->param('itemnumber');
  83     $tobranchcd = ReserveWaiting($item, $borrnum);
  84         $reqbrchname = $branches->{$tobranchcd}->{'branchname'};
  85     $ignoreRs = 1;
  86         $setwaiting = 1;
  87         $reqmessage =1;
  88 }
  89 if ($request eq 'KillReserved'){
  90     my $biblio = $query->param('biblionumber');
  91     CancelReserve($biblio, 0, $borrnum);
  92         $cancelled = 1;
  93         $reqmessage =1;
  94 }
  95
  96
  97
  98 # set up the branchselect options....
  99 my @branchoptionloop;
 100 foreach my $br (keys %$branches) {
 101     #(next) unless $branches->{$br}->{'CU'}; #FIXME disabled to fix bug 202
 102     my %branch;
 103     $branch{selected}=($br eq $tobranchcd);
 104         $branch{code}=$br;
 105         $branch{name}=$branches->{$br}->{'branchname'};
 106         push (@branchoptionloop, \%branch);
 107 }
 108
 109
 110 # collect the stack of books already transfered so they can printed...
 111 my @trsfitemloop;
 112 my %transfereditems;
 113 my %frbranchcds;
 114 my %tobranchcds;
 115 my $color=$linecolor2;
 116
 117 my $barcode = $query->param('barcode');
 118 if ($barcode) {
 119         my $transfered;
 120         my $iteminformation;
 121         ($transfered, $messages, $iteminformation)
 122                         = transferbook($tobranchcd, $barcode, $ignoreRs,$user);
 123         $found = $messages->{'ResFound'};
 124         if ($transfered) {
 125                 my %item;
 126                 my $frbranchcd = $iteminformation->{'holdingbranch'};
 127                 if (not ($found)) {
 128                         ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
 129                         $item{'color'}=$color;
 130                         $item{'biblionumber'}=$iteminformation->{'biblionumber'};
 131                         $item{'title'}=$iteminformation->{'title'};
 132                         $item{'author'}=$iteminformation->{'author'};
 133                         $item{'itemtype'}=$iteminformation->{'itemtype'};
 134                         $item{'frbrname'}=$branches->{$frbranchcd}->{'branchname'};
 135                         $item{'tobrname'}=$branches->{$tobranchcd}->{'branchname'};
 136                 }
 137                 $item{counter}=0;
 138                 $item{barcode}=$barcode;
 139                 $item{frombrcd}=$frbranchcd;
 140                 $item{tobrcd}=$tobranchcd;
 141 ##########
 142 #Are these lines still useful ???
 143                 $transfereditems{0}=$barcode;
 144                 $frbranchcds{0}=$frbranchcd;
 145                 $tobranchcds{0}=$tobranchcd;
 146 ##########
 147                 push (@trsfitemloop, \%item);
 148         }
 149 }
 150
 151 foreach ($query->param){
 152         (next) unless (/bc-(\d*)/);
 153         my $counter=$1;
 154         my %item;
 155         my $bc=$query->param("bc-$counter");
 156         my $frbcd=$query->param("fb-$counter");
 157         my $tobcd=$query->param("tb-$counter");
 158         $counter++;
 159         $item{counter}=$counter;
 160         $item{barcode}=$bc;
 161         $item{frombrcd}=$frbcd;
 162         $item{tobrcd}=$tobcd;
 163         my ($iteminformation) = getiteminformation(\%env, 0, $bc);
 164         ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
 165         $item{'color'}=$color;
 166         $item{'biblionumber'}=$iteminformation->{'biblionumber'};
 167         $item{'title'}=$iteminformation->{'title'};
 168         $item{'author'}=$iteminformation->{'author'};
 169         $item{'itemtype'}=$iteminformation->{'itemtype'};
 170         $item{'frbrname'}=$branches->{$frbcd}->{'branchname'};
 171         $item{'tobrname'}=$branches->{$tobcd}->{'branchname'};
 172 ##########
 173 #Are these lines still useful ???
 174         $transfereditems{$counter}=$bc;
 175         $frbranchcds{$counter}=$frbcd;
 176         $tobranchcds{$counter}=$tobcd;
 177 #########
 178         push (@trsfitemloop, \%item);
 179 }
 180
 181
 182 my $name;
 183 my $bornum;
 184 my $borcnum;
 185 my $itemnumber;
 186 my $biblionum;
 187 my $branchname;
 188
 189
 190 #####################
 191
 192 if ($found) {
 193     my $res = $messages->{'ResFound'};
 194         $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
 195         my ($borr) = getpatroninformation(\%env, $res->{'borrowernumber'}, 0);
 196         $name = name($borr);
 197         $bornum = $borr->{'borrowernumber'}; #Hopefully, borr->{borrowernumber}=res->{borrowernumber}
 198         $borcnum = $borr->{'cardnumber'};
 199         $itemnumber = $res->{'itemnumber'};
 200
 201         if ($res->{'ResFound'} eq "Waiting") {
 202                 $waiting = 1;
 203         }
 204         if ($res->{'ResFound'} eq "Reserved") {
 205                 $reserved = 1;
 206                 $biblionum = $res->{'biblionumber'};
 207         }
 208 }
 209
 210 #####################
 211
 212 my @errmsgloop;
 213 foreach my $code (keys %$messages) {
 214         my %err;
 215     $err{errbadcode} = ($code eq 'BadBarcode');
 216         if ($code eq 'BadBarcode') {
 217                 $err{msg}=$messages->{'BadBarcode'};
 218         }
 219
 220     $err{errispermanent} = ($code eq 'IsPermanent');
 221     if ($code eq 'IsPermanent'){
 222                 $err{msg} = $branches->{$messages->{'IsPermanent'}}->{'branchname'};
 223                 # Here, msg contains the branchname
 224                 # Not so satisfied with this... But should work
 225     }
 226     $err{errdesteqholding} = ($code eq 'DestinationEqualsHolding');
 227
 228         $err{errwasreturned} = ($code eq 'WasReturned');
 229         if ($code eq 'WasReturned') {
 230                 my ($borrowerinfo) = getpatroninformation(\%env, $messages->{'WasReturned'}, 0);
 231                 $name =name($borrowerinfo);
 232                 $bornum =$borrowerinfo->{'borrowernumber'};
 233                 $borcnum =$borrowerinfo->{'cardnumber'};
 234     }
 235     if ($code eq 'WasTransfered'){
 236 # Put code here if you want to notify the user that item was transfered...
 237     }
 238         push (@errmsgloop, \%err);
 239 }
 240
 241
 242 #######################################################################################
 243 # Make the page .....
 244 my ($template, $borrowernumber, $cookie)
 245     = get_template_and_user({template_name => "circ/branchtransfers.tmpl",
 246                                                         query => $query,
 247                             type => "intranet",
 248                             authnotrequired => 0,
 249                             flagsrequired => {editcatalogue => 1},
 250                          });
 251 $template->param(       genbrname => $genbrname,
 252                                                                 genprname => $genprname,
 253                                                                 branch => $branch,
 254                                                                 printer => $printer,
 255                                                                 found => $found,
 256                                                                 reserved => $reserved,
 257                                                                 waiting => $waiting,
 258                                                                 name => $name,
 259                                                                 bornum => $bornum,
 260                                                                 borcnum => $borcnum,
 261                                                                 branchname => $branchname,
 262                                                                 itemnumber => $itemnumber,
 263                                                                 barcode => $barcode,
 264                                                                 biblionumber => $biblionum,
 265                                                                 tobranchcd => $tobranchcd,
 266                                                                 reqmessage => $reqmessage,
 267                                                                 cancelled => $cancelled,
 268                                                                 setwaiting => $setwaiting,
 269                                                                 trsfitemloop => \@trsfitemloop,
 270                                                                 branchoptionloop => \@branchoptionloop,
 271                                                                 errmsgloop => \@errmsgloop
 272                                                         );
 273 output_html_with_http_headers $query, $cookie, $template->output;
 274
 275
 276 sub name {
 277         my ($borinfo) = @_;
 278         return $borinfo->{'surname'}." ".$borinfo->{'title'}." ".$borinfo->{'firstname'};
 279 }
 280
 281 # Local Variables:
 282 # tab-width: 4
 283 # End: