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     kocMakePayment( $circ );
  84   }
  85 }
  86
  87 $template->param(
  88                 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
  89                 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
  90                 IntranetNav => C4::Context->preference("IntranetNav"),
  91
  92                 messages => \@output,
  93         );
  94 output_html_with_http_headers $query, $cookie, $template->output;
  95
  96 sub kocIssueItem {
  97   my ( $circ, $branchcode ) = @_;
  98
  99   my $borrower = GetMember( $circ->{ 'cardnumber' }, 'cardnumber' );
 100   my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
 101   my $issue = GetItemIssue( $item->{'itemnumber'} );
 102
 103   my $issuingrule = GetIssuingRule( $borrower->{ 'categorycode' }, $item->{ 'itemtype' }, $branchcode );
 104   my $issuelength = $issuingrule->{ 'issuelength' };
 105   my ( $year, $month, $day ) = split( /-/, $circ->{'date'} );
 106   ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, $issuelength );
 107   my $date_due = "$year-$month-$day";
 108
 109   if ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
 110 warn "Item Currently Issued.";
 111     my $issue = GetOpenIssue( $item->{'itemnumber'} );
 112
 113     if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
 114 warn "Item issued to this member already, renewing.";
 115
 116       my $renewals = $issue->{'renewals'} + 1;
 117       ForceRenewal( $item->{'itemnumber'}, $circ->{'date'}, $date_due ) unless ( DEBUG );
 118
 119       push( @output, { message => "Renewed $item->{ 'title' } ( $item->{ 'barcode' } ) to $borrower->{ 'firstname' } $borrower->{ 'surename' } ( $borrower->{'cardnumber'} ) : $circ->{ 'datetime' }\n" } );
 120
 121     } else {
 122 warn "Item issued to a different member.";
 123 warn "Date of previous issue: $issue->{'issuedate'}";
 124 warn "Date of this issue: $circ->{'date'}";
 125       my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
 126       my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
 127
 128       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.
 129 warn "Current issue to another member is older, returning and issuing";
 130         push( @output, { message => "$item->{ 'title' } ( $item->{'barcode'} ) currently issued, returning item.\n" } );
 131         ## AddReturnk() should be replaced with a custom function, as it will make the return date today, should be before the issue date of the current circ
 132         AddReturn( $circ->{ 'barcode' }, $branchcode ) unless ( DEBUG );
 133
 134         ForceIssue( $borrower->{ 'borrowernumber' }, $item->{ 'itemnumber' }, $date_due, $branchcode, $circ->{'date'} ) unless ( DEBUG );
 135
 136         push( @output, { message => "Issued $item->{ 'title' } ( $item->{ 'barcode' } ) to $borrower->{ 'firstname' } $borrower->{ 'surename' } ( $borrower->{'cardnumber'} ) : $circ->{ 'datetime' }\n" } );
 137
 138       } 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.
 139 warn "Current issue to another member is newer. Doing nothing";
 140         ## This situation should only happen of the Offline Circ data is *really* old.
 141         ## FIXME: write line to old_issues and statistics
 142       }
 143
 144     }
 145   } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
 146     ForceIssue( $borrower->{ 'borrowernumber' }, $item->{ 'itemnumber' }, $date_due, $branchcode, $circ->{'date'} ) unless ( DEBUG );
 147     push( @output, { message => "Issued $item->{ 'title' } ( $item->{ 'barcode' } ) to $borrower->{ 'firstname' } $borrower->{ 'surename' } ( $borrower->{'cardnumber'} ) : $circ->{ 'datetime' }\n" } );
 148   }
 149 }
 150
 151 sub kocReturnItem {
 152   my ( $circ ) = @_;
 153   ForceReturn( $circ->{'barcode'}, $circ->{'date'}, $branchcode );
 154
 155   my $item = GetBiblioFromItemNumber( undef, $circ->{'barcode'} );
 156
 157   ## FIXME: Is there a way to get the borrower of an item through the Koha API?
 158   my $sth=$dbh->prepare( "SELECT borrowernumber FROM issues WHERE itemnumber = ? AND returndate IS NULL");
 159   $sth->execute( $item->{'itemnumber'} );
 160   my ( $borrowernumber ) = $sth->fetchrow;
 161   $sth->finish();
 162
 163   push( @output, { message => "Returned $item->{ 'title' } ( $item->{ 'barcode' } ) From borrower number $borrowernumber : $circ->{ 'datetime' }\n" } );
 164 }
 165
 166 sub kocMakePayment {
 167   my ( $circ ) = @_;
 168   my $borrower = GetMember( $circ->{ 'cardnumber' }, 'cardnumber' );
 169   recordpayment( my $env, $borrower->{'borrowernumber'}, $circ->{'barcode'} );
 170 }
 171