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