Use C4::Debug to conditionalize warn.
[koha.git] / opac / opac-reserve.pl
1 #!/usr/bin/perl
2
3 # This file is part of Koha.
4 #
5 # Koha is free software; you can redistribute it and/or modify it under the
6 # terms of the GNU General Public License as published by the Free Software
7 # Foundation; either version 2 of the License, or (at your option) any later
8 # version.
9 #
10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13 #
14 # You should have received a copy of the GNU General Public License along with
15 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
16 # Suite 330, Boston, MA  02111-1307 USA
17
18 use strict;
19 use CGI;
20 use C4::Biblio;
21 use C4::Items;
22 use C4::Auth;    # checkauth, getborrowernumber.
23 use C4::Koha;
24 use C4::Circulation;
25 use C4::Reserves;
26 use C4::Output;
27 use C4::Dates qw/format_date/;
28 use C4::Context;
29 use C4::Members;
30 use C4::Branch; # GetBranches
31 use C4::Debug;
32 # use Data::Dumper;
33
34 my $MAXIMUM_NUMBER_OF_RESERVES = C4::Context->preference("maxreserves");
35
36 my $query = new CGI;
37 my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
38     {
39         template_name   => "opac-reserve.tmpl",
40         query           => $query,
41         type            => "opac",
42         authnotrequired => 0,
43         flagsrequired   => { borrow => 1 },
44         debug           => 1,
45     }
46 );
47
48 sub get_out ($$$) {
49         output_html_with_http_headers(shift,shift,shift); # $query, $cookie, $template->output;
50         exit;
51 }
52
53 # get borrower information ....
54 my ( $borr, $flags ) = GetMemberDetails( $borrowernumber );
55
56 # get branches and itemtypes
57 my $branches = GetBranches();
58 my $itemtypes = GetItemTypes();
59
60 # get biblionumber.....
61 my $biblionumber = $query->param('biblionumber');
62 if (! $biblionumber) {
63         $template->param(message=>1,no_biblionumber=>1);
64         &get_out($query, $cookie, $template->output);
65 }
66 $template->param( biblionumber => $biblionumber );
67
68 my $bibdata = GetBiblioData($biblionumber);
69 if (! $bibdata) {
70         $template->param(message=>1,bad_biblionumber=>$biblionumber);
71         &get_out($query, $cookie, $template->output);
72 }
73 $template->param($bibdata);             # FIXME: bad form.
74
75 # get the rank number....
76 my ( $rank, $reserves ) = GetReservesFromBiblionumber( $biblionumber);
77 $template->param( reservecount => $rank );
78
79 foreach my $res (@$reserves) {
80     if ( $res->{'found'} eq 'W' ) {
81         $rank--;
82     }
83 }
84
85 $rank++;
86 $template->param( rank => $rank );
87
88 # pass the pickup branch along....
89 my $branch = $query->param('branch');
90 $template->param( branch => $branch );
91
92 # make sure it's a real branch
93 if ( !$branches->{$branch} ) {
94     $branch = '';
95 }
96 $template->param( branchname => $branches->{$branch}->{'branchname'} );
97
98 # make branch selection options...
99 my @branches;
100 my @select_branch;
101 my %select_branches;
102
103 my @CGIbranchlooparray;
104
105 foreach my $branch ( keys %$branches ) {
106     if ($branch) {
107         my %line;
108         $line{branch} = $branches->{$branch}->{'branchname'};
109         $line{value}  = $branch;
110         if ($line{value} eq C4::Context->userenv->{'branch'}) {
111             $line{selected} = 1;
112         }
113         push @CGIbranchlooparray, \%line;
114     }
115 }
116 @CGIbranchlooparray =
117   sort { $a->{branch} cmp $b->{branch} } @CGIbranchlooparray;
118 my $CGIbranchloop = \@CGIbranchlooparray;
119 $template->param( CGIbranch => $CGIbranchloop );
120
121 #### THIS IS A BIT OF A HACK BECAUSE THE BIBLIOITEMS DATA IS A LITTLE MESSED UP!
122 # get the itemtype data....
123 my @items = GetItemsInfo($biblionumber);
124 #######################################################
125 # old version, add so that old templates still work
126 my %types_old;
127 foreach my $itm (@items) {
128     my $ity = $itm->{'itemtype'};
129     unless ( $types_old{$ity} ) {
130         $types_old{$ity}->{'itemtype'} = $ity;
131         $types_old{$ity}->{'branchinfo'}->{ $itm->{'branchcode'} } = 1;
132         $types_old{$ity}->{'description'} = $itm->{'description'};
133     }
134     else {
135         $types_old{$ity}->{'branchinfo'}->{ $itm->{'branchcode'} }++;
136     }
137 }
138
139 foreach my $type ( values %types_old ) {
140     my $copies = "";
141     foreach my $bc ( keys %{ $type->{'branchinfo'} } ) {
142         $copies .=
143             $branches->{$bc}->{'branchname'} . "("
144           . $type->{'branchinfo'}->{$bc} . ")";
145     }
146     $type->{'copies'} = $copies;
147 }
148
149 my @types_old = values %types_old;
150
151 # end old version
152 ################################
153
154 my @temp;
155 foreach my $itm (@items) {
156     push @temp, $itm if $itm->{'itemtype'};
157 }
158 @items = @temp;
159 my $itemcount = @items;
160 $template->param( itemcount => $itemcount );
161
162 my %types;
163 my %itemtypes;
164 my @duedates;
165 #die @items;
166 my %itemhash;
167 my $forloan;
168 foreach my $itm (@items) {
169     push @duedates, { date_due => format_date( $itm->{'date_due'} ) }
170       if defined $itm->{'date_due'};
171     $itm->{ $itm->{'publictype'} } = 1;
172         $debug and warn $itm->{'notforloan'};
173     my $fee = GetReserveFee( undef, $borrowernumber, $itm->{'biblionumber'},
174         'a', ( $itm->{'biblioitemnumber'} ) );
175     $fee = sprintf "%.02f", $fee;
176     $itm->{'reservefee'} = $fee;
177     my $pty = $itm->{'publictype'};
178     $itemtypes{ $itm->{'itemtype'} } = $itm;
179     unless ( $types{$pty} ) {
180         $types{$pty}->{'count'} = 1;
181         $types{$pty}->{ $itm->{'itemtype'} } = 1;
182         push @{ $types{$pty}->{'items'} }, $itm;
183     }
184     else {
185         unless ( $types{$pty}->{ $itm->{'itemtype'} } ) {
186             $types{$pty}->{'count'}++;
187             $types{$pty}->{ $itm->{'itemtype'} } = 1;
188             push @{ $types{$pty}->{'items'} }, $itm;
189         }
190     }
191         $itemhash{$itm->{'itemnumber'}}=$itm;
192         if (!$itm->{'notforloan'} && !$itm->{'itemnotforloan'}){
193                 $forloan=1;
194         }
195 }
196
197 $template->param( ITEMS => \@duedates );
198
199 my $width = keys %types;
200 my @publictypes = sort { $b->{'count'} <=> $a->{'count'} } values %types;
201 my $typecount;
202 foreach my $pt (@publictypes) {
203     $typecount += $pt->{'count'};
204 }
205 $template->param( onlyone => 1 ) if $typecount == 1;
206
207 my @typerows;
208 for ( my $rownum = 0 ; $rownum < $publictypes[0]->{'count'} ; $rownum++ ) {
209     my @row;
210     foreach my $pty (@publictypes) {
211         my @items = @{ $pty->{'items'} };
212         push @row, $items[$rownum] if defined $items[$rownum];
213     }
214     my $last = @row;
215     $row[ $last - 1 ]->{'last'} = 1 if $last == $width;
216     my $fill = ( $width - $last ) * 2;
217     $fill-- if $fill;
218     push @typerows, { ROW => \@row, fill => $fill };
219 }
220 $template->param( TYPE_ROWS => \@typerows );
221 $width = 2 * $width - 1;
222 $template->param( totalwidth => 2 * $width - 1, );
223
224 if ( $query->param('place_reserve') ) {
225     my @bibitems=$query->param('biblioitem');
226     my $notes=$query->param('notes');
227     my $checkitem=$query->param('checkitem');
228     my $found;
229     
230     #if we have an item selectionned, and the pickup branch is the same as the holdingbranch of the document, we force the value $rank and $found.
231     if ($checkitem ne ''){
232         $rank = '0' unless C4::Context->preference('ReservesNeedReturns');
233         my $item = $checkitem;
234         $item = GetItem($item);
235         if ( $item->{'holdingbranch'} eq $branch ){
236             $found = 'W' unless C4::Context->preference('ReservesNeedReturns');
237         }
238     }
239         
240         my $count=@bibitems;
241     @bibitems=sort @bibitems;
242     my $i2=1;
243     my @realbi;
244     $realbi[0]=$bibitems[0];
245     for (my $i=1;$i<$count;$i++) {
246         my $i3=$i2-1;
247         if ($realbi[$i3] ne $bibitems[$i]) {
248             $realbi[$i2]=$bibitems[$i];
249             $i2++;
250         }
251     }
252     # here we actually do the reserveration. Stage 3.
253     if ($query->param('request') eq 'any'){
254         # place a request on 1st available
255         AddReserve($branch,$borrowernumber,$biblionumber,'a',\@realbi,$rank,$notes,$bibdata->{'title'},$checkitem,$found);
256     } else {
257         AddReserve($branch,$borrowernumber,$biblionumber,'a',\@realbi,$rank,$notes,$bibdata->{'title'},$checkitem, $found);
258     }
259     print $query->redirect("/cgi-bin/koha/opac-user.pl#opac-user-holds");
260 }
261 else {
262
263     # Here we check that the borrower can actually make reserves Stage 1.
264     my $noreserves     = 0;
265     my $maxoutstanding = C4::Context->preference("maxoutstanding");
266     $template->param( noreserve => 1 ) unless $maxoutstanding;
267     if ( $borr->{'amountoutstanding'} > $maxoutstanding ) {
268         my $amount = sprintf "\$%.02f", $borr->{'amountoutstanding'};
269         $template->param( message => 1 );
270         $noreserves = 1;
271         $template->param( too_much_oweing => $amount );
272     }
273     if ( $borr->{gonenoaddress} eq 1 ) {
274         $noreserves = 1;
275         $template->param(
276             message => 1,
277             GNA     => 1
278         );
279     }
280     if ( $borr->{lost} eq 1 ) {
281         $noreserves = 1;
282         $template->param(
283             message => 1,
284             lost    => 1
285         );
286     }
287     if ( $borr->{debarred} eq 1 ) {
288         $noreserves = 1;
289         $template->param(
290             message  => 1,
291             debarred => 1
292         );
293     }
294     my @reserves = GetReservesFromBorrowernumber( $borrowernumber );
295     $template->param( RESERVES => \@reserves );
296     if ( scalar(@reserves) >= $MAXIMUM_NUMBER_OF_RESERVES ) {
297         $template->param( message => 1 );
298         $noreserves = 1;
299         $template->param( too_many_reserves => scalar(@reserves));
300     }
301     foreach my $res (@reserves) {
302         if ( $res->{'biblionumber'} == $biblionumber && $res->{'borrowernumber'} == $borrowernumber) {
303             $template->param( message => 1 );
304             $noreserves = 1;
305             $template->param( already_reserved => 1 );
306         }
307     }
308     unless ($noreserves) {
309         $template->param( TYPES             => \@types_old );
310         $template->param( select_item_types => 1 );
311     }
312 }
313
314
315 my %itemnumbers_of_biblioitem;
316 my @itemnumbers  = @{ get_itemnumbers_of($biblionumber)->{$biblionumber} };
317 my $iteminfos_of = GetItemInfosOf(@itemnumbers);
318
319 foreach my $itemnumber (@itemnumbers) {
320     my $biblioitemnumber = $iteminfos_of->{$itemnumber}->{biblioitemnumber};
321     push( @{ $itemnumbers_of_biblioitem{$biblioitemnumber} }, $itemnumber );
322 }
323
324 my @biblioitemnumbers = keys %itemnumbers_of_biblioitem;
325
326 my $notforloan_label_of = get_notforloan_label_of();
327 my $biblioiteminfos_of  = GetBiblioItemInfosOf(@biblioitemnumbers);
328
329 my @itemtypes;
330 foreach my $biblioitemnumber (@biblioitemnumbers) {
331     push @itemtypes, $biblioiteminfos_of->{$biblioitemnumber}{itemtype};
332 }
333
334 my @bibitemloop;
335
336 foreach my $biblioitemnumber (@biblioitemnumbers) {
337     my $biblioitem = $biblioiteminfos_of->{$biblioitemnumber};
338
339     $biblioitem->{description} =
340       $itemtypes->{ $biblioitem->{itemtype} }{description};
341
342     foreach
343       my $itemnumber ( @{ $itemnumbers_of_biblioitem{$biblioitemnumber} } )
344     {
345                 my $item = $itemhash{$itemnumber};
346
347         $item->{homebranchname} =
348           $branches->{ $item->{homebranch} }{branchname};
349
350         # if the holdingbranch is different than the homebranch, we show the
351         # holdingbranch of the document too
352         if ( $item->{homebranch} ne $item->{holdingbranch} ) {
353             $item->{holdingbranchname} =
354               $branches->{ $item->{holdingbranch} }{branchname};
355         }
356         
357 #       add information
358         $item->{itemcallnumber} = $item->{itemcallnumber};
359         
360         # if the item is currently on loan, we display its return date and
361         # change the background color
362         my $issues= GetItemIssue($itemnumber);
363         if ( $issues->{'date_due'} ) {
364             $item->{date_due} = format_date($issues->{'date_due'});
365             $item->{backgroundcolor} = 'onloan';
366         }
367
368         # checking reserve
369         my ($reservedate,$reservedfor,$expectedAt) = GetReservesFromItemnumber($itemnumber);
370         my $ItemBorrowerReserveInfo = GetMemberDetails( $reservedfor, 0);
371
372         if ( defined $reservedate ) {
373             $item->{backgroundcolor} = 'reserved';
374             $item->{reservedate}     = format_date($reservedate);
375             $item->{ReservedForBorrowernumber}     = $reservedfor;
376             $item->{ReservedForSurname}     = $ItemBorrowerReserveInfo->{'surname'};
377             $item->{ReservedForFirstname}     = $ItemBorrowerReserveInfo->{'firstname'};
378             $item->{ExpectedAtLibrary}     = $expectedAt;
379             
380         }
381
382         # Management of the notforloan document
383         if ( $item->{notforloan} || $item->{itemnotforloan}) {
384             $item->{backgroundcolor} = 'other';
385             $item->{notforloanvalue} =
386               $notforloan_label_of->{ $item->{notforloan} };
387         }
388
389         # Management of lost or long overdue items
390         if ( $item->{itemlost} ) {
391
392             # FIXME localized strings should never be in Perl code
393             $item->{message} =
394                 $item->{itemlost} == 1 ? "(lost)"
395               : $item->{itemlost} == 2 ? "(long overdue)"
396               : "";
397             $item->{backgroundcolor} = 'other';
398         }
399
400         # Check of the transfered documents
401         my ( $transfertwhen, $transfertfrom, $transfertto ) =
402           GetTransfers($itemnumber);
403
404         if ( $transfertwhen ne '' ) {
405             $item->{transfertwhen} = format_date($transfertwhen);
406             $item->{transfertfrom} =
407               $branches->{$transfertfrom}{branchname};
408             $item->{transfertto} = $branches->{$transfertto}{branchname};
409                 $item->{nocancel} = 1;
410         }
411
412         # If there is no loan, return and transfer, we show a checkbox.
413         $item->{notforloan} = $item->{notforloan} || 0;
414
415         if (IsAvailableForItemLevelRequest($itemnumber)) {
416             $item->{available} = 1;
417         }
418
419         # FIXME: move this to a pm
420         my $dbh = C4::Context->dbh;
421         my $sth2 = $dbh->prepare("SELECT * FROM reserves WHERE borrowernumber=? AND itemnumber=? AND found='W'");
422         $sth2->execute($item->{ReservedForBorrowernumber},$item->{itemnumber});
423         while (my $wait_hashref = $sth2->fetchrow_hashref) {
424             $item->{waitingdate} = format_date($wait_hashref->{waitingdate});
425         }
426         $item->{imageurl} = getitemtypeimagesrc() . "/".$itemtypes->{ $item->{itype} }{imageurl};
427         push @{ $biblioitem->{itemloop} }, $item;
428     }
429
430     push @bibitemloop, $biblioitem;
431 }
432
433 # display infos
434 $template->param(
435         forloan           => $forloan,
436     bibitemloop       => \@bibitemloop,
437 );
438 output_html_with_http_headers $query, $cookie, $template->output;
439
440 # Local Variables:
441 # tab-width: 8
442 # End: