circ/circulation.pl

   1 #!/usr/bin/perl
   2
   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 # 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::Search;
  29 use C4::Members;
  30 use C4::Output;
  31 use C4::Print;
  32 use DBI;
  33 use C4::Auth;
  34 use C4::Interface::CGI::Output;
  35 use C4::Koha;
  36 use HTML::Template;
  37 use C4::Date;
  38 use Date::Manip;
  39 use C4::Biblio;
  40 use C4::Reserves2;
  41 use C4::Circulation::Date;
  42
  43 #
  44 # PARAMETERS READING
  45 #
  46 my $query = new CGI;
  47
  48 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
  49     {
  50         template_name   => 'circ/circulation.tmpl',
  51         query           => $query,
  52         type            => "intranet",
  53         authnotrequired => 0,
  54         flagsrequired   => { circulate => 1 },
  55     }
  56 );
  57 my $branches = getbranches();
  58 # my $printers = getprinters();
  59 # my $printer = getprinter($query, $printers);
  60
  61 my $findborrower = $query->param('findborrower');
  62 $findborrower =~ s|,| |g;
  63 $findborrower =~ s|'| |g;
  64 my $borrowernumber = $query->param('borrnumber');
  65 # new op dev the branch and the printer are now defined by the userenv
  66 my $branch = C4::Context->userenv->{'branch'};
  67 my $printer=C4::Context->userenv->{'branchprinter'};
  68
  69 my $barcode = $query->param('barcode') || '';
  70 my $year=$query->param('year');
  71 my $month=$query->param('month');
  72 my $day=$query->param('day');
  73 my $stickyduedate=$query->param('stickyduedate');
  74 my $issueconfirmed = $query->param('issueconfirmed');
  75 my $cancelreserve  = $query->param('cancelreserve');
  76 my $organisation   = $query->param('organisations');
  77 my $print = $query->param('print');
  78
  79 #set up cookie.....
  80 # my $branchcookie;
  81 # my $printercookie;
  82 # if ($query->param('setcookies')) {
  83 #       $branchcookie = $query->cookie(-name=>'branch', -value=>"$branch", -expires=>'+1y');
  84 #       $printercookie = $query->cookie(-name=>'printer', -value=>"$printer", -expires=>'+1y');
  85 # }
  86
  87 my %env; # FIXME env is used as an "environment" variable. Could be dropped probably...
  88 #
  89 my $print;
  90 $env{'branchcode'}= $branch;
  91 $env{'printer'}= $printer;
  92 # $env{'queue'}=$printer;
  93
  94 my @datearr = localtime(time());
  95 # FIXME - Could just use POSIX::strftime("%Y%m%d", localtime);
  96 my $todaysdate =
  97     ( 1900 + $datearr[5] )
  98   . sprintf( "%0.2d", ( $datearr[4] + 1 ) )
  99   . sprintf( "%0.2d", ( $datearr[3] ) );
 100
 101 # check and see if we should print
 102 if ( $barcode eq '' && $print eq 'maybe' ) {
 103     $print = 'yes';
 104 }
 105
 106 my $inprocess = $query->param('inprocess');
 107 if ($barcode eq ''){
 108         $inprocess='';
 109 }
 110 else {
 111 }
 112
 113 if ($barcode eq '' && $query->param('charges') eq 'yes'){
 114         $template->param( PAYCHARGES=>'yes',
 115         bornum=>$borrowernumber);
 116    }
 117
 118 if ( $print eq 'yes' && $borrowernumber ne '' ) {
 119     printslip( \%env, $borrowernumber );
 120     $query->param( 'borrnumber', '' );
 121     $borrowernumber = '';
 122 }
 123
 124 #
 125 # STEP 2 : FIND BORROWER
 126 # if there is a list of find borrowers....
 127 #
 128 my $borrowerslist;
 129 my $message;
 130 if ($findborrower) {
 131     my ( $count, $borrowers ) =
 132       BornameSearch( \%env, $findborrower, 'cardnumber', 'web' );
 133     my @borrowers = @$borrowers;
 134     if ( $#borrowers == -1 ) {
 135         $query->param( 'findborrower', '' );
 136         $message = "'$findborrower'";
 137     }
 138     elsif ( $#borrowers == 0 ) {
 139         $query->param( 'borrnumber', $borrowers[0]->{'borrowernumber'} );
 140         $query->param( 'barcode',    '' );
 141         $borrowernumber = $borrowers[0]->{'borrowernumber'};
 142     }
 143     else {
 144         $borrowerslist = \@borrowers;
 145     }
 146 }
 147
 148 # get the borrower information.....
 149 my $borrower;
 150 my $picture;
 151 my @lines;
 152 if ($borrowernumber) {
 153     $borrower = getpatroninformation( \%env, $borrowernumber, 0 );
 154     my ( $od, $issue, $fines ) = borrdata2( \%env, $borrowernumber );
 155     my $warningdate =
 156       DateCalc( $borrower->{'expiry'},
 157         "- " . C4::Context->preference('NotifyBorrowerDeparture') . "  days" );
 158     my $warning = Date_Cmp( ParseDate("today"), $warningdate );
 159     if ( $warning > 0 ) {
 160
 161         #borrowercard expired
 162         $template->param( warndeparture => $warning );
 163     }
 164     my ($reserved_num,$reserved_waiting) = CheckWaiting($borrowernumber);
 165     if ($reserved_num > 0) {
 166            for (my $i = 0; $i < $reserved_num; $i++) {
 167                      my ($count,$line) = getbiblio($reserved_waiting->[$i]->{'biblionumber'});
 168                      push(@lines, $line);
 169            }
 170           # warn Dumper(@lines);
 171     }
 172
 173     $template->param(
 174         overduecount => $od,
 175         issuecount   => $issue,
 176         finetotal    => $fines,
 177         returned_reserve => \@lines,
 178     );
 179     my $htdocs = C4::Context->config('intrahtdocs');
 180     $picture = "/borrowerimages/" . $borrowernumber . ".jpg";
 181     if ( -e $htdocs . "$picture" ) {
 182         $template->param( picture => $picture );
 183     }
 184 }
 185
 186 #
 187 # STEP 3 : ISSUING
 188 #
 189 #
 190
 191 if ($barcode) {
 192     $barcode = cuecatbarcodedecode($barcode);
 193     my ( $datedue, $invalidduedate ) = fixdate( $year, $month, $day );
 194     if ($issueconfirmed) {
 195         issuebook( \%env, $borrower, $barcode, $datedue, $cancelreserve );
 196         $inprocess=1;
 197     }
 198     else {
 199         my ( $error, $question ) =
 200           canbookbeissued( \%env, $borrower, $barcode, $year, $month, $day, $inprocess );
 201         my $noerror    = 1;
 202         my $noquestion = 1;
 203         foreach my $impossible ( keys %$error ) {
 204             $template->param(
 205                 $impossible => $$error{$impossible},
 206                 IMPOSSIBLE  => 1
 207             );
 208             $noerror = 0;
 209         }
 210         foreach my $needsconfirmation ( keys %$question ) {
 211             $template->param(
 212                 $needsconfirmation => $$question{$needsconfirmation},
 213                 NEEDSCONFIRMATION  => 1
 214             );
 215             $noquestion = 0;
 216         }
 217         $template->param(
 218             day   => $day,
 219             month => $month,
 220             year  => $year
 221         );
 222         if ( $noerror && ( $noquestion || $issueconfirmed ) ) {
 223             issuebook( \%env, $borrower, $barcode, $datedue );
 224             $inprocess=1;
 225         }
 226     }
 227 }
 228
 229 # reload the borrower info for the sake of reseting the flags.....
 230 if ($borrowernumber) {
 231     $borrower = getpatroninformation( \%env, $borrowernumber, 0 );
 232 }
 233
 234 ##################################################################################
 235 # BUILD HTML
 236 # show all reserves of this borrower, and the position of the reservation ....
 237 if ($borrowernumber) {
 238 # new op dev
 239 # now we show the status of the borrower's reservations
 240         my @borrowerreserv = FastFindReserves(0,$borrowernumber);
 241         my @reservloop;
 242         foreach my $num_res (@borrowerreserv) {
 243                 my %getreserv;
 244                 my %env;
 245                 my $getiteminfo = getiteminformation(\%env,$num_res->{'itemnumber'});
 246                 my $itemtypeinfo = getitemtypeinfo($getiteminfo->{'itemtype'});
 247                 my ($transfertwhen,$transfertfrom,$transfertto) = checktransferts($num_res->{'itemnumber'});
 248
 249                 $getreserv{waiting} = 0;
 250                 $getreserv{transfered} = 0;
 251                 $getreserv{nottransfered} = 0;
 252
 253                 $getreserv{reservedate} = format_date($num_res->{'reservedate'});
 254                 $getreserv{biblionumber} = $getiteminfo->{'biblionumber'};
 255                 $getreserv{title} = $getiteminfo->{'title'};
 256                 $getreserv{itemtype} = $itemtypeinfo->{'description'};
 257                 $getreserv{author} = $getiteminfo->{'author'};
 258                 $getreserv{barcodereserv} = $getiteminfo->{'barcode'};
 259                 $getreserv{itemcallnumber} = $getiteminfo->{'itemcallnumber'};
 260 #               check if we have a waitin status for reservations
 261                 if ($num_res->{'found'} eq 'W'){
 262                         $getreserv{color} = 'reserved';
 263                         $getreserv{waiting} = 1;
 264                 }
 265
 266 #               check transfers with the itemnumber foud in th reservation loop
 267                 if ($transfertwhen){
 268                 $getreserv{color} = 'transfered';
 269                 $getreserv{transfered} = 1;
 270                 $getreserv{datesent} = format_date($transfertwhen);
 271                 $getreserv{frombranch} = getbranchname($transfertfrom);
 272                 }
 273
 274                 if (($getiteminfo->{'holdingbranch'} ne $num_res->{'branchcode'}) and not $transfertwhen){
 275                 $getreserv{nottransfered} = 1;
 276                 $getreserv{nottransferedby} = getbranchname($getiteminfo->{'holdingbranch'});
 277                 }
 278
 279 #               if we don't have a reserv on item, we put the biblio infos and the waiting position
 280                 if ($getiteminfo->{'title'} eq '' ){
 281                         my $getbibinfo = bibitemdata($num_res->{'biblionumber'});
 282                         my $getbibtype = getitemtypeinfo($getbibinfo->{'itemtype'});
 283                         $getreserv{color} = 'inwait';
 284                         $getreserv{title} = $getbibinfo->{'title'};
 285                         $getreserv{waitingposition} = $num_res->{'priority'};
 286                         $getreserv{nottransfered} = 0;
 287                         $getreserv{itemtype} = $getbibtype->{'description'};
 288                         $getreserv{author} = $getbibinfo->{'author'};
 289                         $getreserv{itemcallnumber} = '----------';
 290
 291                 }
 292
 293                 push(@reservloop, \%getreserv);
 294         }
 295         # return result to the template
 296         $template->param(reservloop => \@reservloop);
 297
 298 }
 299
 300
 301 # make the issued books table.....
 302 my $todaysissues = '';
 303 my $previssues   = '';
 304 my @realtodayissues;
 305 my @realprevissues;
 306 my $allowborrow;
 307 if ($borrower) {
 308
 309 # get each issue of the borrower & separate them in todayissues & previous issues
 310     my @todaysissues;
 311     my @previousissues;
 312     my $issueslist = getissues($borrower);
 313
 314     # split in 2 arrays for today & previous
 315     my $dbh = C4::Context->dbh;
 316     foreach my $it ( keys %$issueslist ) {
 317         my $issuedate = $issueslist->{$it}->{'timestamp'};
 318         $issuedate =~ s/-//g;
 319         $issuedate = substr( $issuedate, 0, 8 );
 320         if ( $todaysdate == $issuedate ) {
 321                 ($issueslist->{$it}->{'charge'}, $issueslist->{$it}->{'itemtype_charge'})=calc_charges($dbh,$issueslist->{$it}->{'itemnumber'},$borrower->{'borrowernumber'});
 322                 $issueslist->{$it}->{'charge'} = sprintf("%.2f",$issueslist->{$it}->{'charge'});
 323                 ($issueslist->{$it}->{'can_renew'}, $issueslist->{$it}->{'can_renew_error'}) =renewstatus(\%env,$borrower->{'borrowernumber'}, $issueslist->{$it}->{'itemnumber'});
 324                 my ($restype,$reserves)=CheckReserves($issueslist->{$it}->{'itemnumber'});
 325                 if ($restype){
 326                     $issueslist->{$it}->{'can_renew'}=0;
 327                 }
 328                 push @todaysissues, $issueslist->{$it};
 329         }
 330         else {
 331                 ($issueslist->{$it}->{'charge'}, $issueslist->{$it}->{'itemtype_charge'})=calc_charges($dbh,$issueslist->{$it}->{'itemnumber'},$borrower->{'borrowernumber'});
 332                 $issueslist->{$it}->{'charge'} = sprintf("%.2f",$issueslist->{$it}->{'charge'});
 333                 ($issueslist->{$it}->{'can_renew'}, $issueslist->{$it}->{'can_renew_error'}) =renewstatus(\%env,$borrower->{'borrowernumber'}, $issueslist->{$it}->{'itemnumber'});
 334                 my ($restype,$reserves)=CheckReserves($issueslist->{$it}->{'itemnumber'});
 335                 if ($restype){
 336                     $issueslist->{$it}->{'can_renew'}=0;
 337                 }
 338                 push @previousissues, $issueslist->{$it};
 339         }
 340     }
 341     my $od;    # overdues
 342     my $i = 0;
 343     my $togglecolor;
 344
 345     # parses today & build Template array
 346     foreach my $book ( sort { $b->{'timestamp'} <=> $a->{'timestamp'} }
 347         @todaysissues )
 348     {
 349         my $dd      = $book->{'date_due'};
 350         my $datedue = $book->{'date_due'};
 351         $dd = format_date($dd);
 352         $datedue =~ s/-//g;
 353         if ( $datedue < $todaysdate ) {
 354             $od = 1;
 355         }
 356         else {
 357             $od = 0;
 358         }
 359         if ( $i % 2 ) {
 360             $togglecolor = 0;
 361         }
 362         else {
 363             $togglecolor = 1;
 364         }
 365         $book->{'togglecolor'} = $togglecolor;
 366         $book->{'od'}          = $od;
 367         $book->{'dd'}          = $dd;
 368         if ( $book->{'author'} eq '' ) {
 369             $book->{'author'} = ' ';
 370         }
 371         push @realtodayissues, $book;
 372         $i++;
 373     }
 374
 375     # parses previous & build Template array
 376     $i = 0;
 377     foreach my $book ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
 378         @previousissues )
 379     {
 380         my $dd      = $book->{'date_due'};
 381         my $datedue = $book->{'date_due'};
 382         $dd = format_date($dd);
 383         my $pcolor = '';
 384         my $od     = '';
 385         $datedue =~ s/-//g;
 386         if ( $datedue < $todaysdate ) {
 387             $od = 1;
 388         }
 389         else {
 390             $od = 0;
 391         }
 392         if ( $i % 2 ) {
 393             $togglecolor = 0;
 394         }
 395         else {
 396             $togglecolor = 1;
 397         }
 398         $book->{'togglecolor'} = $togglecolor;
 399         $book->{'dd'}          = $dd;
 400         $book->{'od'}          = $od;
 401         if ( $book->{'author'} eq '' ) {
 402             $book->{'author'} = ' ';
 403         }
 404         push @realprevissues, $book;
 405         $i++;
 406     }
 407 }
 408
 409 my @values;
 410 my %labels;
 411 my $CGIselectborrower;
 412 if ($borrowerslist) {
 413     foreach (
 414         sort {
 415             $a->{'surname'}
 416               . $a->{'firstname'} cmp $b->{'surname'}
 417               . $b->{'firstname'}
 418         } @$borrowerslist
 419       )
 420     {
 421         push @values, $_->{'borrowernumber'};
 422         $labels{ $_->{'borrowernumber'} } =
 423 "$_->{'surname'}, $_->{'firstname'} ... ($_->{'cardnumber'} - $_->{'categorycode'}) ...  $_->{'streetaddress'} ";
 424     }
 425     $CGIselectborrower = CGI::scrolling_list(
 426         -name     => 'borrnumber',
 427         -values   => \@values,
 428         -labels   => \%labels,
 429         -size     => 7,
 430         -multiple => 0
 431     );
 432 }
 433
 434 #title
 435
 436 my ( $patrontable, $flaginfotable ) = patrontable($borrower);
 437 my $amountold = $borrower->{flags}->{'CHARGES'}->{'message'} || 0;
 438 my @temp = split( /\$/, $amountold );
 439
 440 my $CGIorganisations;
 441 my $member_of_institution;
 442 if ( C4::Context->preference("memberofinstitution") ) {
 443     my $organisations = get_institutions();
 444     my @orgs;
 445     my %org_labels;
 446     foreach my $organisation ( keys %$organisations ) {
 447         push @orgs, $organisation;
 448         $org_labels{$organisation} =
 449           $organisations->{$organisation}->{'surname'};
 450     }
 451     $member_of_institution = 1;
 452     $CGIorganisations = CGI::popup_menu(
 453         -id       => 'organisations',
 454         -name     => 'organisations',
 455         -labels   => \%org_labels,
 456         -values   => \@orgs,
 457
 458     );
 459 }
 460
 461 $amountold = $temp[1];
 462 $template->param(
 463     findborrower      => $findborrower,
 464     borrower          => $borrower,
 465     borrowernumber    => $borrowernumber,
 466     branch            => $branch,
 467     printer           => $printer,
 468     printername       => $printer,
 469     firstname         => $borrower->{'firstname'},
 470     surname           => $borrower->{'surname'},
 471     categorycode      => $borrower->{'categorycode'},
 472     streetaddress     => $borrower->{'streetaddress'},
 473     emailaddress      => $borrower->{'emailaddress'},
 474     borrowernotes     => $borrower->{'borrowernotes'},
 475     city              => $borrower->{'city'},
 476     phone             => $borrower->{'phone'},
 477     cardnumber        => $borrower->{'cardnumber'},
 478     amountold         => $amountold,
 479     barcode           => $barcode,
 480     stickyduedate     => $stickyduedate,
 481     message           => $message,
 482     CGIselectborrower => $CGIselectborrower,
 483     todayissues       => \@realtodayissues,
 484     previssues        => \@realprevissues,
 485     inprocess         => $inprocess,
 486     memberofinstution => $member_of_institution,
 487     CGIorganisations => $CGIorganisations,
 488 );
 489
 490 # set return date if stickyduedate
 491 if ($stickyduedate) {
 492     my $t_year  = "year" . $year;
 493     my $t_month = "month" . $month;
 494     my $t_day   = "day" . $day;
 495     $template->param(
 496         $t_year  => 1,
 497         $t_month => 1,
 498         $t_day   => 1,
 499     );
 500 }
 501
 502
 503 # if ($branchcookie) {
 504 #     $cookie=[$cookie, $branchcookie, $printercookie];
 505 # }
 506
 507 output_html_with_http_headers $query, $cookie, $template->output;
 508
 509 ####################################################################
 510 # Extra subroutines,,,
 511
 512 sub patrontable {
 513     my ($borrower)    = @_;
 514     my $flags         = $borrower->{'flags'};
 515     my $flaginfotable = '';
 516     my $flaginfotext;
 517
 518     #my $flaginfotext='';
 519     my $flag;
 520     my $color = '';
 521     foreach $flag ( sort keys %$flags ) {
 522
 523         #       my @itemswaiting='';
 524         $flags->{$flag}->{'message'} =~ s/\n/<br>/g;
 525         if ( $flags->{$flag}->{'noissues'} ) {
 526             $template->param(
 527                 flagged  => 1,
 528                 noissues => 'true',
 529             );
 530             if ( $flag eq 'GNA' ) {
 531                 $template->param( gna => 'true' );
 532             }
 533             if ( $flag eq 'LOST' ) {
 534                 $template->param( lost => 'true' );
 535             }
 536             if ( $flag eq 'DBARRED' ) {
 537                 $template->param( dbarred => 'true' );
 538             }
 539             if ( $flag eq 'CHARGES' ) {
 540                 $template->param(
 541                     charges    => 'true',
 542                     chargesmsg => $flags->{'CHARGES'}->{'message'}
 543                 );
 544             }
 545             if ($flag eq 'CREDITS') {
 546                 $template->param(
 547                     credits => 'true',
 548                     creditsmsg => $flags->{'CREDITS'}->{'message'}
 549                 );
 550             }
 551         }
 552         else {
 553             if ( $flag eq 'CHARGES' ) {
 554                 $template->param(
 555                     charges    => 'true',
 556                     flagged    => 1,
 557                     chargesmsg => $flags->{'CHARGES'}->{'message'}
 558                 );
 559             }
 560             if ($flag eq 'CREDITS') {
 561                 $template->param(
 562                     credits => 'true',
 563                     creditsmsg => $flags->{'CREDITS'}->{'message'}
 564                 );
 565             }
 566
 567 # FIXME this part can be removed if we keep new display of reserves "reservloop"
 568 #             if ( $flag eq 'WAITING' ) {
 569 #                 my $items = $flags->{$flag}->{'itemlist'};
 570 #                 my @itemswaiting;
 571 #                 foreach my $item (@$items) {
 572 #                     my ($iteminformation) =
 573 #                       getiteminformation( \%env, $item->{'itemnumber'}, 0 );
 574 #                     $iteminformation->{'branchname'} =
 575 #                       $branches->{ $iteminformation->{'holdingbranch'} }
 576 #                       ->{'branchname'};
 577 #                     push @itemswaiting, $iteminformation;
 578 #                 }
 579 #                 $template->param(
 580 #                     flagged      => 1,
 581 #                     waiting      => 'true',
 582 #                     waitingmsg   => $flags->{'WAITING'}->{'message'},
 583 #                     itemswaiting => \@itemswaiting,
 584 #                 );
 585 #             }
 586             if ( $flag eq 'ODUES' ) {
 587                 $template->param(
 588                     odues    => 'true',
 589                     flagged  => 1,
 590                     oduesmsg => $flags->{'ODUES'}->{'message'}
 591                 );
 592
 593                 my $items = $flags->{$flag}->{'itemlist'};
 594                 {
 595                     my @itemswaiting;
 596                     foreach my $item (@$items) {
 597                         my ($iteminformation) =
 598                           getiteminformation( \%env, $item->{'itemnumber'}, 0 );
 599                         push @itemswaiting, $iteminformation;
 600                     }
 601                 }
 602                 if ( $query->param('module') ne 'returns' ) {
 603                     $template->param( nonreturns => 'true' );
 604                 }
 605             }
 606             if ( $flag eq 'NOTES' ) {
 607                 $template->param(
 608                     notes    => 'true',
 609                     flagged  => 1,
 610                     notesmsg => $flags->{'NOTES'}->{'message'}
 611                 );
 612             }
 613         }
 614     }
 615     return ( $patrontable, $flaginfotext );
 616 }
 617
 618 sub cuecatbarcodedecode {
 619     my ($barcode) = @_;
 620     chomp($barcode);
 621     my @fields = split( /\./, $barcode );
 622     my @results = map( decode($_), @fields[ 1 .. $#fields ] );
 623     if ( $#results == 2 ) {
 624         return $results[2];
 625     }
 626     else {
 627         return $barcode;
 628     }
 629 }
 630
 631 # Local Variables:
 632 # tab-width: 8
 633 # End: