reserve/request.pl

   1 #!/usr/bin/perl
   2
   3 # $Id$
   4
   5 #script to place reserves/requests
   6 #writen 2/1/00 by chris@katipo.oc.nz
   7
   8
   9 # Copyright 2000-2002 Katipo Communications
  10 #
  11 # This file is part of Koha.
  12 #
  13 # Koha is free software; you can redistribute it and/or modify it under the
  14 # terms of the GNU General Public License as published by the Free Software
  15 # Foundation; either version 2 of the License, or (at your option) any later
  16 # version.
  17 #
  18 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  19 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  20 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  21 #
  22 # You should have received a copy of the GNU General Public License along with
  23 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  24 # Suite 330, Boston, MA  02111-1307 USA
  25
  26 use strict;
  27 use HTML::Template;
  28 use CGI;
  29 use Date::Manip;
  30 use List::MoreUtils qw/uniq/;
  31 use Data::Dumper;
  32 use Date::Calc qw/Today/;
  33
  34 use C4::Search;
  35 use C4::Output;
  36 use C4::Interface::CGI::Output;
  37 use C4::Auth;
  38 use C4::Reserves2;
  39 use C4::Biblio;
  40 use C4::Koha;
  41 use C4::Circulation::Circ2;
  42 # FIXME Is there utility to use Acquisition.pm ????
  43 # use C4::Acquisition;
  44 use C4::Date;
  45 use C4::Members;
  46
  47 my $dbh = C4::Context->dbh;
  48 my $sth;
  49 my $input = new CGI;
  50 my ($template, $borrowernumber, $cookie)
  51     = get_template_and_user({
  52         template_name => "reserve/request.tmpl",
  53         query => $input,
  54         type => "intranet",
  55         authnotrequired => 0,
  56         flagsrequired => {reserveforothers => 1},
  57     });
  58
  59 # get biblio information....
  60 my $bib = $input->param('bib');
  61 my $dat = bibdata($bib);
  62
  63 # Select borrowers infos
  64 my $findborrower = $input->param('findborrower');
  65 $findborrower =~ s|,| |g;
  66 my $cardnumber = $input->param('cardnumber');
  67 my %env;
  68 my $borrowerslist;
  69 my $messageborrower;
  70
  71 # my $date = today();
  72 my $date= sprintf('%04d-%02d-%02d', Today());
  73
  74 if ($findborrower) {
  75     my ($count,$borrowers) =  BornameSearch(\%env, $findborrower, 'cardnumber', 'web');
  76
  77     my @borrowers = @$borrowers;
  78
  79     if ($#borrowers == -1) {
  80         $input->param('findborrower', '');
  81         $messageborrower =  "'$findborrower'";
  82     }
  83     elsif ($#borrowers == 0) {
  84         $input->param('cardnumber', $borrowers[0]->{'cardnumber'});
  85         $cardnumber = $borrowers[0]->{'cardnumber'};
  86     }
  87     else {
  88         $borrowerslist = \@borrowers;
  89     }
  90 }
  91
  92 if ($cardnumber) {
  93         my $borrowerinfo = getpatroninformation (\%env,0,$cardnumber);
  94         my $expiry;
  95         my $diffbranch;
  96         my @getreservloop;
  97         my $count_reserv = 0;
  98         my $maxreserves;
  99
 100 #       we check the reserves of the borrower, and if he can reserv a document
 101 # FIXME At this time we have a simple count of reservs, but, later, we could improve the infos "title" ...
 102
 103         my $number_reserves =
 104             GetNumberReservesFromBorrower($borrowerinfo->{'borrowernumber'});
 105
 106         if ($number_reserves > C4::Context->preference('maxreserves')) {
 107             $maxreserves = 1;
 108         }
 109
 110 # we check the date expiricy of the borrower
 111         my $warning=Date_Cmp(ParseDate("today"),format_date($borrowerinfo->{'dateexpiry'}));
 112         if ( $warning > 0) {
 113                         $expiry = 1;
 114         }
 115
 116 # check if the borrower make the reserv in a different branch
 117         if ($borrowerinfo->{'branchcode'} ne C4::Context->userenv->{'branch'}) {
 118                 $diffbranch = 1;
 119         }
 120
 121         $template->param(
 122                 borrowersurname => $borrowerinfo->{'surname'},
 123                 borrowerfirstname => $borrowerinfo->{'firstname'},
 124                 borrowerreservs => $count_reserv,
 125                 maxreserves => $maxreserves,
 126                 expiry => $expiry,
 127                 diffbranch => $diffbranch
 128         );
 129 }
 130
 131 $template->param(
 132     messageborrower => $messageborrower
 133 );
 134
 135 my $CGIselectborrower;
 136 if ($borrowerslist) {
 137     my @values;
 138     my %labels;
 139
 140     foreach my $borrower (
 141         sort {$a->{surname}.$a->{firstname} cmp $b->{surname}.$b->{firstname}}
 142             @{$borrowerslist}
 143     ) {
 144         push @values, $borrower->{cardnumber};
 145
 146         $labels{ $borrower->{cardnumber} } = sprintf(
 147             '%s, %s ... (%s - %s) ... %s',
 148             $borrower->{surname},
 149             $borrower->{firstname},
 150             $borrower->{cardnumber},
 151             $borrower->{categorycode},
 152             $borrower->{streetaddress},
 153         );
 154     }
 155
 156     $CGIselectborrower = CGI::scrolling_list(
 157         -name     => 'cardnumber',
 158         -values   => \@values,
 159         -labels   => \%labels,
 160         -size     => 7,
 161         -multiple => 0,
 162     );
 163 }
 164
 165 # get existing reserves .....
 166 my ($count, $reserves) = FindReserves($bib, undef);
 167 my $totalcount = $count;
 168 my $alreadyreserved;
 169
 170 # FIXME launch another time getpatroninformation perhaps until
 171 my $borrowerinfo = getpatroninformation (\%env,0,$cardnumber);
 172
 173 foreach my $res (@$reserves) {
 174     if (($res->{found} eq 'W') or ($res->{priority} == 0)) {
 175         $count--;
 176     }
 177
 178     if ($borrowerinfo->{borrowernumber} eq $res->{borrowernumber}) {
 179         $alreadyreserved = 1;
 180     }
 181 }
 182 $template->param(alreadyreserved => $alreadyreserved);
 183
 184 # make priorities options
 185 my @optionloop;
 186 for (1 .. $count + 1) {
 187     push(
 188         @optionloop,
 189         {
 190             num => $_,
 191             selected => ($_ == $count + 1),
 192         }
 193     );
 194 }
 195
 196 my @branchcodes;
 197 my %itemnumbers_of_biblioitem;
 198 my @itemnumbers = @{get_itemnumbers_of($bib)->{$bib}};
 199 my $iteminfos_of = get_iteminfos_of(@itemnumbers);
 200
 201 foreach my $itemnumber (@itemnumbers) {
 202     push(
 203         @branchcodes,
 204         $iteminfos_of->{$itemnumber}->{homebranch},
 205         $iteminfos_of->{$itemnumber}->{holdingbranch}
 206     );
 207
 208     my $biblioitemnumber = $iteminfos_of->{$itemnumber}->{biblioitemnumber};
 209     push(
 210         @{ $itemnumbers_of_biblioitem{$biblioitemnumber} },
 211         $itemnumber
 212     );
 213 }
 214
 215 @branchcodes = uniq @branchcodes;
 216
 217 my @biblioitemnumbers = keys %itemnumbers_of_biblioitem;
 218
 219 my $branchinfos_of = get_branchinfos_of(@branchcodes);
 220 my $notforloan_label_of = get_notforloan_label_of();
 221 my $biblioiteminfos_of = get_biblioiteminfos_of(@biblioitemnumbers);
 222
 223 my @itemtypes;
 224 foreach my $biblioitemnumber (@biblioitemnumbers) {
 225     push @itemtypes, $biblioiteminfos_of->{$biblioitemnumber}{itemtype};
 226 }
 227
 228 my $itemtypeinfos_of = get_itemtypeinfos_of(@itemtypes);
 229
 230 my $return_date_of = get_current_return_date_of(@itemnumbers);
 231
 232 my @bibitemloop;
 233
 234 foreach my $biblioitemnumber (@biblioitemnumbers) {
 235     my $biblioitem = $biblioiteminfos_of->{$biblioitemnumber};
 236
 237     $biblioitem->{description} =
 238         $itemtypeinfos_of->{ $biblioitem->{itemtype} }{description};
 239
 240     foreach my $itemnumber (@{$itemnumbers_of_biblioitem{$biblioitemnumber}}) {
 241         my $item = $iteminfos_of->{$itemnumber};
 242
 243         $item->{homebranchname} =
 244             $branchinfos_of->{ $item->{homebranch} }{branchname};
 245
 246         # if the holdingbranch is different than the homebranch, we show the
 247         # holdingbranch of the document too
 248         if ($item->{homebranch} ne $item->{holdingbranch}) {
 249             $item->{holdingbranchname} =
 250                 $branchinfos_of->{ $item->{holdingbranch} }{branchname};
 251         }
 252
 253         # if the item is currently on loan, we display its return date and
 254         # change the background color
 255         my $date_due;
 256
 257         if (defined $return_date_of->{$itemnumber}) {
 258             $date_due = format_date($return_date_of->{$itemnumber});
 259             $item->{date_due} = $date_due;
 260             $item->{backgroundcolor} = 'onloan';
 261         }
 262
 263         # checking reserve
 264         my $reservedate = GetFirstReserveDateFromItem($itemnumber);
 265
 266         if (defined $reservedate) {
 267             $item->{backgroundcolor} = 'reserved';
 268             $item->{reservedate} = format_date($reservedate);
 269         }
 270
 271         # Management of the notforloan document
 272         if ($item->{notforloan}) {
 273             $item->{backgroundcolor} = 'other';
 274             $item->{notforloanvalue} =
 275                 $notforloan_label_of->{ $item->{notforloan} };
 276         }
 277
 278         # Management of lost or long overdue items
 279         if ($item->{itemlost}) {
 280
 281             # FIXME localized strings should never be in Perl code
 282             $item->{message} = $item->{itemlost} == 1
 283                 ? "(lost)"
 284                 : $item->{itemlost} == 2
 285                     ? "(long overdue)"
 286                     : "";
 287             $item->{backgroundcolor} = 'other';
 288         }
 289
 290         # Check of the transfered documents
 291         my ($transfertwhen,$transfertfrom,$transfertto) =
 292             get_transfert_infos($itemnumber);
 293
 294         if ($transfertwhen ne '') {
 295             $item->{transfertwhen} = format_date($transfertwhen);
 296             $item->{transfertfrom} =
 297                 $branchinfos_of->{$transfertfrom}{branchname};
 298             $item->{transfertto} =
 299                 $branchinfos_of->{$transfertto}{branchname};
 300         }
 301
 302         # If there is no loan, return and transfer, we show a checkbox.
 303         $item->{notforloan} = $item->{notforloan} || 0;
 304
 305         # An item is available only if:
 306         if (not defined $reservedate      # not reserved yet
 307             and $date_due eq ''           # not currently on loan
 308             and not $item->{itemlost}     # not lost
 309             and not $item->{notforloan}   # not forbidden to loan
 310             and $transfertwhen eq ''      # not currently on transfert
 311         ) {
 312             $item->{available} = 1;
 313         }
 314
 315         push @{$biblioitem->{itemloop}}, $item;
 316     }
 317
 318     push @bibitemloop, $biblioitem;
 319 }
 320
 321
 322 # existingreserves building
 323 my @reserveloop;
 324 my $branches = GetBranches('RE');
 325 foreach my $res (sort {$a->{found} cmp $b->{found}} @$reserves){
 326     my %reserve;
 327     my @optionloop;
 328     for (my $i=1; $i <= $totalcount; $i++) {
 329         push(
 330             @optionloop,
 331             {
 332                 num => $i,
 333                 selected => ($i == $res->{priority}),
 334             }
 335         );
 336     }
 337     my @branchloop;
 338     foreach my $br (keys %$branches) {
 339         my %abranch;
 340         $abranch{'selected'}=($br eq $res->{'branchcode'});
 341         $abranch{'branch'}=$br;
 342         $abranch{'branchname'}=$branches->{$br}->{'branchname'};
 343         push(@branchloop,\%abranch);
 344     }
 345
 346     if (($res->{'found'} eq 'W') or ($res->{'priority'} eq '0')) {
 347         my %env;
 348         my $item = $res->{'itemnumber'};
 349         $item = getiteminformation(\%env,$item);
 350         $reserve{'holdingbranch'}=$item->{'holdingbranch'};
 351         $reserve{'barcode'}=$item->{'barcode'};
 352         $reserve{'biblionumber'}=$item->{'biblionumber'};
 353         $reserve{'wbrcode'} = $res->{'branchcode'};
 354         $reserve{'wbrname'} = $branches->{$res->{'branchcode'}}->{'branchname'};
 355         if($reserve{'holdingbranch'} eq $reserve{'wbrcode'}){
 356             $reserve{'atdestination'} = 1;
 357         }
 358     }
 359
 360     $reserve{'date'} = format_date($res->{'reservedate'});
 361     $reserve{'borrowernumber'}=$res->{'borrowernumber'};
 362     $reserve{'biblionumber'}=$res->{'biblionumber'};
 363     $reserve{'bornum'}=$res->{'borrowernumber'};
 364     $reserve{'firstname'}=$res->{'firstname'};
 365     $reserve{'surname'}=$res->{'surname'};
 366     $reserve{'bornum'}=$res->{'borrowernumber'};
 367     $reserve{'notes'}=$res->{'reservenotes'};
 368     $reserve{'wait'}=(($res->{'found'} eq 'W') or ($res->{'priority'} eq '0'));
 369     $reserve{'constrainttypea'}=($res->{'constrainttype'} eq 'a');
 370     $reserve{'constrainttypeo'}=($res->{'constrainttype'} eq 'o');
 371     $reserve{'voldesc'}=$res->{'volumeddesc'};
 372     $reserve{'itemtype'}=$res->{'itemtype'};
 373     $reserve{'branchloop'}=\@branchloop;
 374     $reserve{'optionloop'}=\@optionloop;
 375
 376     push(@reserveloop,\%reserve);
 377 }
 378
 379 my $default = C4::Context->userenv->{branch};
 380 my @values;
 381 my %label_of;
 382
 383 foreach my $branchcode (keys %{$branches}) {
 384     push @values, $branchcode;
 385     $label_of{$branchcode} = $branches->{$branchcode}->{branchname};
 386 }
 387 my $CGIbranch = CGI::scrolling_list(
 388     -name     => 'pickup',
 389     -values   => \@values,
 390     -default  => $default,
 391     -labels   => \%label_of,
 392     -size     => 1,
 393     -multiple => 0,
 394 );
 395
 396 # get the time for the form name...
 397 my $time = time();
 398
 399 $template->param(
 400     CGIbranch => $CGIbranch,
 401     reserveloop => \@reserveloop,
 402     time => $time,
 403 );
 404
 405 # setup colors
 406 $template->param(
 407     optionloop =>\@optionloop,
 408     bibitemloop => \@bibitemloop,
 409     date => $date,
 410     bib => $bib,
 411     findborrower => $findborrower,
 412     cardnumber => $cardnumber,
 413     CGIselectborrower => $CGIselectborrower,
 414     title =>$dat->{title},
 415 );
 416
 417 # printout the page
 418 print $input->header(
 419         -type => C4::Interface::CGI::Output::guesstype($template->output),
 420         -expires=>'now'
 421 ), $template->output;