offline_circ/process_koc.pl

   1 #!/usr/bin/perl
   2
   3 # 2008 Kyle Hall <kyle.m.hall@gmail.com>
   4
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19 #
  20
  21 use strict;
  22 require Exporter;
  23
  24 use CGI;
  25 use C4::Output;
  26 use C4::Auth;
  27 use C4::Koha;
  28 use C4::Context;
  29 use C4::Biblio;
  30 use C4::Accounts;
  31 use C4::Circulation;
  32 use C4::Members;
  33 use C4::Stats;
  34
  35 use Date::Calc qw( Add_Delta_Days Date_to_Days );
  36
  37 use constant DEBUG => 0;
  38
  39 our $query = new CGI;
  40
  41 my ($template, $loggedinuser, $cookie)
  42   = get_template_and_user( { template_name => "offline_circ/process_koc.tmpl",
  43                                 query => $query,
  44                                 type => "intranet",
  45                                 authnotrequired => 1,
  46                                 debug => 1,
  47                                 });
  48
  49 ## 'Local' globals.
  50 our $dbh = C4::Context->dbh();
  51
  52 our $branchcode = C4::Context->userenv->{branch};
  53
  54 warn "Branchcode: $branchcode";
  55
  56 our @output; ## For storing messages to be displayed to the user
  57
  58 $query::POST_MAX = 1024 * 10000;
  59
  60 my $file = $query->param("kocfile");
  61 $file=~m/^.*(\\|\/)(.*)/; # strip the remote path and keep the filename
  62 my $name = $file;
  63
  64 my $header = <$file>;
  65
  66 while ( my $line = <$file> ) {
  67   my ( $type, $cardnumber, $barcode, $datetime ) = split( /\t/, $line );
  68   ( $datetime ) = split( /\+/, $datetime );
  69   my ( $date ) = split( / /, $datetime );
  70
  71   my $circ;
  72   $circ->{ 'type' } = $type;
  73   $circ->{ 'cardnumber' } = $cardnumber;
  74   $circ->{ 'barcode' } = $barcode;
  75   $circ->{ 'datetime' } = $datetime;
  76   $circ->{ 'date' } = $date;
  77
  78   if ( $circ->{ 'type' } eq 'issue' ) {
  79     kocIssueItem( $circ, $branchcode );
  80   } elsif ( $circ->{ 'type' } eq 'return' ) {
  81     kocReturnItem( $circ );
  82   } elsif ( $circ->{ 'type' } eq 'payment' ) {
  83       $circ->{'payment_amount'} = delete $circ->{'barcode'};
  84     kocMakePayment( $circ );
  85   }
  86 }
  87
  88 $template->param(
  89                 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
  90                 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
  91                 IntranetNav => C4::Context->preference("IntranetNav"),
  92
  93                 messages => \@output,
  94         );
  95 output_html_with_http_headers $query, $cookie, $template->output;
  96
  97 sub kocIssueItem {
  98   my ( $circ, $branchcode ) = @_;
  99
 100   my $borrower = GetMember( $circ->{ 'cardnumber' }, 'cardnumber' );
 101   my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
 102   my $issue = GetItemIssue( $item->{'itemnumber'} );
 103
 104   my $issuingrule = GetIssuingRule( $borrower->{ 'categorycode' }, $item->{ 'itemtype' }, $branchcode );
 105   my $issuelength = $issuingrule->{ 'issuelength' };
 106   my ( $year, $month, $day ) = split( /-/, $circ->{'date'} );
 107   ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, $issuelength );
 108   my $date_due = sprintf("%04d-%02d-%02d", $year, $month, $day);
 109
 110   if ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
 111 warn "Item Currently Issued.";
 112     my $issue = GetOpenIssue( $item->{'itemnumber'} );
 113
 114     if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
 115 warn "Item issued to this member already, renewing.";
 116
 117     my $date_due_object = C4::Dates->new($date_due ,'iso');
 118     C4::Circulation::AddRenewal(
 119         $issue->{'borrowernumber'},    # borrowernumber
 120         $item->{'itemnumber'},         # itemnumber
 121         undef,                         # branch
 122         $date_due_object,              # datedue
 123         $circ->{'date'},               # issuedate
 124     ) unless ($DEBUG);
 125
 126       push( @output, { message => "Renewed $item->{ 'title' } ( $item->{ 'barcode' } ) to $borrower->{ 'firstname' } $borrower->{ 'surename' } ( $borrower->{'cardnumber'} ) : $circ->{ 'datetime' }\n" } );
 127
 128     } else {
 129 warn "Item issued to a different member.";
 130 warn "Date of previous issue: $issue->{'issuedate'}";
 131 warn "Date of this issue: $circ->{'date'}";
 132       my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
 133       my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
 134
 135       if ( Date_to_Days( $i_y, $i_m, $i_d ) < Date_to_Days( $c_y, $c_m, $c_d ) ) { ## Current issue to a different persion is older than this issue, return and issue.
 136         C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due ) unless ( DEBUG );
 137         push( @output, { message => "Issued $item->{ 'title' } ( $item->{ 'barcode' } ) to $borrower->{ 'firstname' } $borrower->{ 'surename' } ( $borrower->{'cardnumber'} ) : $circ->{ 'datetime' }\n" } );
 138
 139       } else { ## Current issue is *newer* than this issue, write a 'returned' issue, as the item is most likely in the hands of someone else now.
 140 warn "Current issue to another member is newer. Doing nothing";
 141         ## This situation should only happen of the Offline Circ data is *really* old.
 142         ## FIXME: write line to old_issues and statistics
 143       }
 144
 145     }
 146   } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
 147       C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due ) unless ( DEBUG );
 148     push( @output, { message => "Issued $item->{ 'title' } ( $item->{ 'barcode' } ) to $borrower->{ 'firstname' } $borrower->{ 'surename' } ( $borrower->{'cardnumber'} ) : $circ->{ 'datetime' }\n" } );
 149   }
 150 }
 151
 152 sub kocReturnItem {
 153   my ( $circ ) = @_;
 154   my $borrower = GetMember( $circ->{ 'cardnumber' }, 'cardnumber' );
 155   my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
 156   C4::Circulation::MarkIssueReturned( $borrower->{'borrowernumber'},
 157                                       $item->{'itemnumber'},
 158                                       undef,
 159                                       $circ->{'date'} );
 160
 161   push( @output, { message => "Returned $item->{ 'title' } ( $item->{ 'barcode' } ) From borrower number $borrower->{'borrowernumber'} : $circ->{ 'datetime' }\n" } );
 162 }
 163
 164 sub kocMakePayment {
 165   my ( $circ ) = @_;
 166   my $borrower = GetMember( $circ->{ 'cardnumber' }, 'cardnumber' );
 167   recordpayment( $borrower->{'borrowernumber'}, $circ->{'payment_amount'} );
 168   push( @output, { message => "accepted payment ($circ->{'payment_amount'}) from cardnumber ($circ->{'cardnumber'}), borrower ($borrower->{'borrowernumber'})" } );
 169 }
 170