Bugfix 3205 - Fix OAI server resonse to Identify request
[koha_fer] / opac / sco / printer.pl
1 #!/usr/bin/perl
2 #this code has been modified (slightly) by Trendsetters (originally from circulation.pl)
3 # Please use 8-character tabs for this file (indents are every 4 characters)
4
5 #written 8/5/2002 by Finlay
6 #script to execute issuing of books
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 CGI;
28 use C4::Circulation;
29 use C4::Search;
30 use C4::Output;
31 use C4::Print;
32 use DBI;
33 use C4::Authsco;
34 use C4::Output;
35 use C4::Koha;
36 use HTML::Template::Pro;
37 use C4::Dates;
38
39 my $query=new CGI;
40 #my ($loggedinuser, $sessioncookie, $sessionID) = checkauth
41 #       ($query, 0, { circulate => 1 });
42
43 my ($template, $loggedinuser, $cookie) = get_template_and_user
44     ({
45 #Begin code modified by Christina Lee
46         template_name   => 'sco/receipt.tmpl',
47         query           => $query,
48         type            => "opac",
49         authnotrequired => 0,
50         flagsrequired   => { circulate => "circulate_remaining_permissions" },
51 # End Code Modified by Christina Lee
52     });
53
54 #Begin code by Christina Lee--Sets variable $borr equal to loggedinuser's data
55 my ($borr, $flags) = getpatroninformation(undef, $loggedinuser);
56 # End code by Christina Lee
57
58 my %env;
59 my $linecolor1='#339999';
60 my $linecolor2='white';
61
62 my $branches = getbranches();
63 my $printers = getprinters(\%env);
64
65 my $branch = "APL"; #getbranch($query, $branches);
66 my $printer = getprinter($query, $printers);
67
68
69 #set up cookie.....
70 my $branchcookie;
71 my $printercookie;
72 if ($query->param('setcookies')) {
73         $branchcookie  = $query->cookie(-name=>'branch',  -value=>"$branch",  -expires=>'+1y');
74         $printercookie = $query->cookie(-name=>'printer', -value=>"$printer", -expires=>'+1y');
75 }
76
77 $env{'branchcode'}=$branch;
78 $env{'printer'}=$printer;
79 $env{'queue'}=$printer;
80
81 my @datearr = localtime(time());
82 # FIXME - Could just use POSIX::strftime("%Y%m%d", localtime);
83 my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", ($datearr[3]));
84 #warn $todaysdate;
85
86 ################# Start code modified by Christina Lee###########################
87 # get borrower information ....
88 #my ($borr, $flags) = getpatroninformation(undef, $loggedinusername);
89 #my @bordat;
90 #$bordat[0] = $borr;
91
92 #$template->param(BORROWER_INFO => \@bordat);
93
94 ######################End code modified by christina Lee############################
95
96 my $message;
97 my $borrowerslist;
98 # if there is a list of find borrowers....
99 my $findborrower = $query->param('findborrower');
100 if ($findborrower) {
101         my ($count,$borrowers)=BornameSearch(\%env,$findborrower,'web');
102         my @borrowers=@$borrowers;
103         if ($#borrowers == -1) {
104                 $query->param('findborrower', '');
105                 $message =  "'$findborrower'";
106         } elsif ($#borrowers == 0) {
107                 $query->param('borrnumber', $borrowers[0]->{'borrowernumber'});
108                 $query->param('barcode','');
109         } else {
110                 $borrowerslist = \@borrowers;
111         }
112 }
113
114
115 my $borrowernumber = $query->param('borrnumber');
116 my $bornum = $query->param('borrnumber');
117 # check and see if we should print
118 my $print=$query->param('print');
119 my $barcode = $query->param('barcode');
120 if ($barcode eq ''  && $print eq 'maybe'){
121         $print = 'yes';
122 }
123 if ($print eq 'yes' && $borrowernumber ne ''){
124         printslip(\%env,$borrowernumber);
125         $query->param('borrnumber','');
126         $borrowernumber='';
127 }
128
129 # get the borrower information.....
130 my $borrower;
131 my $flags;
132 if ($borrowernumber) {
133     ($borrower, $flags) = getpatroninformation(\%env,$borrowernumber,0);
134 }
135
136 # get the responses to any questions.....
137 my %responses;
138 foreach (sort $query->param) {
139         if ($_ =~ /response-(\d*)/) {
140                 $responses{$1} = $query->param($_);
141         }
142 }
143 if (my $qnumber = $query->param('questionnumber')) {
144         $responses{$qnumber} = $query->param('answer');
145 }
146
147
148 my ($iteminformation, $duedate, $rejected, $question, $questionnumber, $defaultanswer);
149 #Begin code edited by Christina Lee
150 #my $barc = 123456789;
151 my $barc = cuecatbarcodedecode($barcode);
152
153 (my $year, my $month, my $day) = set_duedate($barc);
154 #End code edited by Christina Lee
155
156 # if the barcode is set
157 if ($barcode) {
158         $barcode = cuecatbarcodedecode($barcode);
159  
160 #note: edit code here --Christina Lee
161         my ($datedue, $invalidduedate) = fixdate($year, $month, $day);
162         unless ($invalidduedate) {
163                 $env{'datedue'}=$datedue;
164                 my @time=localtime();
165                 my $date= (1900+$time[5])."-".($time[4]+1)."-".$time[3];
166                 ($iteminformation, $duedate, $rejected, $question, $questionnumber, $defaultanswer, $message)
167                                         = issuebook(\%env, $borr, $barcode, \%responses, $date);
168         }
169 }
170
171 # reload the borrower info for the sake of reseting the flags.....
172 if ($borrowernumber) {
173         ($borrower, $flags) = getpatroninformation(\%env,$borrowernumber,0);
174 }
175
176 ##################################################################################
177 # HTML code....
178
179 my %responseform;
180 my @responsearray;
181 foreach (keys %responses) {
182 #    $responsesform.="<input type=hidden name=response-$_ value=$responses{$_}>\n";
183     $responseform{'name'}=$_;
184     $responseform{'value'}=$responses{$_};
185     push @responsearray,\%responseform;
186 }
187 my $questionform;
188 my $stickyduedate;
189 if ($question) {
190     $stickyduedate=$query->param('stickyduedate');
191 }
192
193
194 # Barcode entry box, with hidden inputs attached....
195
196 # FIXME - How can we move this HTML into the template?  Can we create
197 # arrays of the months, dates, etc and use <TMPL_LOOP> in the template to 
198 # output the data that's getting built here?
199 my $counter = 1;
200 my $dayoptions = '';
201 my $monthoptions = '';
202 my $yearoptions = '';
203 for (my $i=1; $i<32; $i++) {
204     my $selected='';
205     if (($query->param('stickyduedate')) && ($day==$i)) {
206         $selected='selected';
207     }
208     $dayoptions.="<option value=$i $selected>$i";
209 }
210 foreach (('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')) {
211     my $selected='';
212     if (($query->param('stickyduedate')) && ($month==$counter)) {
213                 $selected='selected';
214     }
215     $monthoptions.="<option value=$counter $selected>$_";
216     $counter++;
217 }
218 for (my $i=$datearr[5]+1900; $i<$datearr[5]+1905; $i++) {
219     my $selected='';
220     if (($query->param('stickyduedate')) && ($year==$i)) {
221                 $selected='selected';
222     }
223     $yearoptions.="<option value=$i $selected>$i";
224 }
225 my $selected='';
226 ($query->param('stickyduedate')) && ($selected='checked');
227
228
229 # make the issued books table.....
230 my $todaysissues='';
231 my $previssues='';
232 my @realtodayissues;
233 my @realprevissues;
234 my $allowborrow;
235 my $hash;
236 # Begin code altered by christina Lee
237 if ($borr) {
238     ($borr, $flags,$hash) = getpatroninformation(\%env,$loggedinuser,0);
239 # End code altered by Christina Lee
240     $allowborrow= $hash->{'borrow'};
241     my @todaysissues;
242     my @previousissues;
243 # Begin code altered by Christina Lee
244     my $issueslist = getissues($borr);
245 # End code altered by Christina Lee
246     foreach my $it (keys %$issueslist) {
247         my $issuedate = $issueslist->{$it}->{'timestamp'};
248         $issuedate = substr($issuedate, 0, 8);
249         if ($todaysdate == $issuedate) {
250             push @todaysissues, $issueslist->{$it};
251         } else {
252             push @previousissues, $issueslist->{$it};
253         }
254     }
255         my $tcolor = '';
256         my $pcolor = '';
257         my $od = '';
258         foreach my $book (sort {$b->{'timestamp'} <=> $a->{'timestamp'}} @todaysissues){        
259                 my $dd = $book->{'date_due'};
260                 my $datedue = $book->{'date_due'};
261                 $dd=format_date($dd);
262                 $datedue=~s/-//g;
263                 if ($datedue < $todaysdate) {
264                         $od = 'true';
265                         $dd="$dd\n";
266                 }
267                 $tcolor = ($tcolor eq $linecolor1) ? $linecolor2 : $linecolor1;
268                 $book->{'od'}=$od;
269                 $book->{'dd'}=$dd;
270                 $book->{'tcolor'}=$tcolor;
271                 if ($book->{'author'} eq ''){
272                     $book->{'author'}=' ';
273                 }
274                 push @realtodayissues,$book;
275         }
276     
277
278     # FIXME - For small and private libraries, it'd be nice if this
279     # table included a "Return" link next to each book, so that you
280     # don't have to remember the book's bar code and type it in on the
281     # "Returns" page.
282
283     # This is in the template now, so its possible for a small library to make that link in their
284     # template
285
286     foreach my $book (sort {$a->{'date_due'} cmp $b->{'date_due'}} @previousissues){
287                 my $dd = $book->{'date_due'};
288                 my $datedue = $book->{'date_due'};
289                 $dd=format_date($dd);
290                 my $pcolor = '';
291                 my $od = '';
292                 $datedue=~s/-//g;
293                 if ($datedue < $todaysdate) {
294                         $od = 'true';
295                     $dd="$dd\n";
296                 }
297                 $pcolor = ($pcolor eq $linecolor1) ? $linecolor2 : $linecolor1;
298                 $book->{'dd'}=$dd; 
299                 $book->{'od'}=$od;
300                 $book->{'tcolor'}=$pcolor;
301                 if ($book->{'author'} eq ''){
302                     $book->{'author'}=' ';
303                 }    
304                 push @realprevissues,$book
305         }
306 }
307
308 my @values;
309 my %labels;
310 my $CGIselectborrower;
311 if ($borrowerslist) {
312         foreach (sort {$a->{'surname'}.$a->{'firstname'} cmp $b->{'surname'}.$b->{'firstname'}} @$borrowerslist){
313                 push @values,$_->{'borrowernumber'};
314                 $labels{$_->{'borrowernumber'}} ="$_->{'surname'}, $_->{'firstname'} ($_->{'cardnumber'})";
315         }
316         $CGIselectborrower=CGI::scrolling_list( -name     => 'borrnumber',
317                                 -values   => \@values,
318                                 -labels   => \%labels,
319                                 -size     => 7,
320                                 -multiple => 0 );
321 }
322 #title
323
324 my ($patrontable, $flaginfotable) = patrontable($borrower);
325 my $amountold=$flags->{'CHARGES'}->{'message'};
326 my @temp=split(/\$/,$amountold);
327 $amountold=$temp[1];
328 $template->param(
329                 findborrower => $findborrower,
330                 borrower => $borrower,
331                 borrowernumber => $borrowernumber,
332                 branch => $branch,
333                 printer => $printer,
334                 branchname => $branches->{$branch}->{'branchname'},
335                 printername => $printers->{$printer}->{'printername'},
336                 allowborrow =>$allowborrow,
337                 #question form
338                 question => $question,
339                 title => $iteminformation->{'title'},
340                 author => $iteminformation->{'author'},
341 #Begin code by Christina Lee
342                 firstname => $borr->{'firstname'},
343                 surname => $borr->{'surname'},
344                 categorycode => $borr->{'categorycode'},
345                 streetaddress => $borr->{'streetaddress'},
346                 city => $borr->{'city'},
347                 phone => $borr->{'phone'},
348                 cardnumber => $borr->{'cardnumber'},
349 #End code by Christina Lee
350                 question => $question,
351                 barcode => $barcode,
352                 questionnumber => $questionnumber,
353                 dayoptions => $dayoptions,
354                 monthoptions => $monthoptions,
355                 yearoptions => $yearoptions,
356                 stickyduedate => $stickyduedate,
357                 rejected => $rejected,
358                 message => $message,
359                 CGIselectborrower => $CGIselectborrower,
360                 amountold => $amountold,
361                 todayissues => \@realtodayissues,
362                 previssues => \@realprevissues,
363                 responseloop => \@responsearray,
364                 month=>$month,
365                 day=>$day,
366                 year=>$year
367 );
368
369 if ($branchcookie) {
370     $cookie=[$cookie, $branchcookie, $printercookie];
371 }
372
373 output_html_with_http_headers $query, $cookie, $template->output;
374
375 ####################################################################
376 # Extra subroutines,,,
377
378 sub cuecatbarcodedecode {
379     my ($barcode) = @_;
380     chomp($barcode);
381     my @fields = split(/\./,$barcode);
382     my @results = map(decode($_), @fields[1..$#fields]);
383     if ($#results == 2){
384                 return $results[2];
385     } else {
386                 return $barcode;
387     }
388 }
389
390 sub fixdate {
391     my ($year, $month, $day) = @_;
392     if (($year eq 0) && ($month eq 0) && ($year eq 0)) {
393                 $env{'datedue'}='';
394                 return(undef,undef);
395     } 
396         
397 # FIXME - Can we set two flags here, one that says 'invalidduedate', so that 
398 # the template can check for it, and then one for a particular message?
399 # Ex: <TMPL_IF NAME="invalidduedate">  <TMPL_IF NAME="daysinFeb">
400 # Invalid Due Date Specified. Book was not issued.  Never that many days
401 # in February! </TMPL_IF> </TMPL_IF>
402
403     my ($date);
404         my ($invalidduedate) = "Invalid Due Date Specified. Book was not issued. ";
405         if (($year eq 0) || ($month eq 0) || ($year eq 0)) {
406             $invalidduedate .= "<p>\n";
407         } else {
408             if (($day>30) && (($month==4) || ($month==6) || ($month==9) || ($month==11))) {
409                         $invalidduedate .= "Only 30 days in $month month.<p>\n";
410             } elsif (($day > 29) && ($month == 2)) {
411                         $invalidduedate .= "Never that many days in February!<p>\n";
412             } elsif (($month == 2) && ($day > 28) && (($year%4) && ((!($year%100) || ($year%400))))) {
413                         $invalidduedate .= "$year is not a leap year.<p>\n";
414             } else {
415                         $date="$year-$month-$day";
416             }
417         }
418     return ($date, $invalidduedate);
419 }
420
421
422 sub patrontable {
423     my ($borrower) = @_;
424     my $flags = $borrower->{'flags'};
425     my $flaginfotable='';
426     my $flaginfotext;
427     #my $flaginfotext='';
428     my $flag;
429     my $color='';
430     foreach $flag (sort keys %$flags) {
431         warn $flag;
432 #       my @itemswaiting='';
433         ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
434         $flags->{$flag}->{'message'}=~s/\n/<br>/g;
435         if ($flags->{$flag}->{'noissues'}) {
436                 $template->param(
437                         noissues => 'true',
438                         color => $color,
439                 );
440                 if ($flag eq 'GNA'    ){ $template->param(    gna => 'true'); }
441                 if ($flag eq 'LOST'   ){ $template->param(   lost => 'true'); }
442                 if ($flag eq 'DBARRED'){ $template->param(dbarred => 'true'); }
443                 if ($flag eq 'CHARGES'){
444                         $template->param(
445                                 charges => 'true',
446                                 chargesmsg => $flags->{'CHARGES'}->{'message'}
447                         );
448                 }
449         } else {
450                 if ($flag eq 'CHARGES') {
451                         $template->param(
452                                 charges => 'true',
453                                 chargesmsg => $flags->{'CHARGES'}->{'message'}
454                          );
455                 }
456             if ($flag eq 'WAITING') {
457                         my $items=$flags->{$flag}->{'itemlist'};
458                         my @itemswaiting;
459                         foreach my $item (@$items) {
460                                 my ($iteminformation) = getiteminformation(\%env, $item->{'itemnumber'}, 0);
461                                 $iteminformation->{'branchname'} = $branches->{$iteminformation->{'holdingbranch'}}->{'branchname'};
462                                 push @itemswaiting, $iteminformation;
463                         }
464                         $template->param(
465                                 waiting => 'true',
466                                 waitingmsg => $flags->{'WAITING'}->{'message'},
467                                 itemswaiting => \@itemswaiting,
468                          );
469                 }
470                 if ($flag eq 'ODUES') {
471                         $template->param(
472                                 odues => 'true',
473                                 oduesmsg => $flags->{'ODUES'}->{'message'}
474                          );
475
476                         my $items=$flags->{$flag}->{'itemlist'};
477                         my $lcolor=$color;
478                         my @itemswaiting;
479                         foreach my $item (@$items) {
480                                 $lcolor = ($lcolor eq $linecolor1) ? $linecolor2 : $linecolor1;
481                                 my ($iteminformation) = getiteminformation(\%env, $item->{'itemnumber'}, 0);
482                                 push @itemswaiting, $iteminformation;
483                         }
484                         if ($query->param('module') ne 'returns'){
485                                 $template->param( nonreturns => 'true' );
486                         }
487                 }
488                 if ($flag eq 'NOTES') {
489                         $template->param(
490                                 notes => 'true',
491                                 notesmsg => $flags->{'NOTES'}->{'message'}
492                         );
493                 }
494         }
495     }
496     return($patrontable, $flaginfotext);
497 }
498
499
500 # FIXME - This clashes with &C4::Print::printslip
501 sub printslip {
502     my ($env,$borrowernumber)=@_;
503     my ($borrower, $flags) = getpatroninformation($env,$borrowernumber,0);
504     $env->{'todaysissues'}=1;
505     my ($borrowerissues) = currentissues($env, $borrower);
506     $env->{'nottodaysissues'}=1;
507     $env->{'todaysissues'}=0;
508     my ($borroweriss2) = currentissues($env, $borrower);
509     $env->{'nottodaysissues'}=0;
510     my $i=0;
511     my @issues;
512     foreach (sort {$a <=> $b} keys %$borrowerissues) {
513                 $issues[$i]=$borrowerissues->{$_};
514                 $issues[$i]->{'date_due'} = C4::Dates->new($issues[$i]->{'date_due'},'iso')->output;
515                 # convert to syspref style date
516                 $i++;
517     }
518     foreach (sort {$a <=> $b} keys %$borroweriss2) {
519                 $issues[$i]=$borroweriss2->{$_};
520                 $issues[$i]->{'date_due'} = C4::Dates->new($issues[$i]->{'date_due'},'iso')->output;
521                 # convert to syspref style date
522                 $i++;
523         }
524     remoteprint($env,\@issues,$borrower);
525 }
526
527 # Begin code added by Christina Lee
528 sub set_duedate
529 {
530         my $loanlength;
531         my $dbh = C4::Context->dbh;
532         my $sth = $dbh->prepare ("select loanlength from biblioitems, biblio,itemtypes, items where barcode = ? and biblio.biblionumber = biblioitems.biblionumber and biblioitems.biblionumber = items.biblionumber and biblioitems.itemtype=itemtypes.itemtype;"); 
533         $sth->execute($barc);
534         while (my @val = $sth->fetchrow_array()) {
535                 $loanlength = @val[0];
536         }
537         my ($s, $min, $hr, $mday, $mo, $year, $wday, $yday) = localtime(time + $loanlength * 86400);
538
539         #adjust month and date for output
540         $year -= 100;
541         $mo++;
542         return ($year, $mo, $mday);
543 }
544
545 sub get_due_date {
546         # This function is clearly unfinished. Don't rely on it yet.
547         my $duedate;
548         my $dbh = C4::Context->dbh;
549 }
550
551 # End code added by Christina Lee
552
553 # Local Variables:
554 # tab-width: 8
555 # End:
556