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 use warnings;
  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 use C4::UploadedFile;
  35 use C4::BackgroundJob;
  36
  37 use Date::Calc qw( Add_Delta_Days Date_to_Days );
  38
  39 use constant DEBUG => 0;
  40
  41 # this is the file version number that we're coded against.
  42 my $FILE_VERSION = '1.0';
  43
  44 our $query = CGI->new;
  45
  46 my ($template, $loggedinuser, $cookie)
  47   = get_template_and_user( { template_name => "offline_circ/process_koc.tmpl",
  48                                 query => $query,
  49                                 type => "intranet",
  50                                 authnotrequired => 0,
  51                                  flagsrequired   => { circulate => "circulate_remaining_permissions" },
  52                                 });
  53
  54
  55 my $fileID=$query->param('uploadedfileid');
  56 my $runinbackground = $query->param('runinbackground');
  57 my $completedJobID = $query->param('completedJobID');
  58 my %cookies = parse CGI::Cookie($cookie);
  59 my $sessionID = $cookies{'CGISESSID'}->value;
  60 ## 'Local' globals.
  61 our $dbh = C4::Context->dbh();
  62 our @output = (); ## For storing messages to be displayed to the user
  63
  64
  65 if ($completedJobID) {
  66     my $job = C4::BackgroundJob->fetch($sessionID, $completedJobID);
  67     my $results = $job->results();
  68     $template->param(transactions_loaded => 1);
  69     $template->param(messages => $results->{results});
  70 } elsif ($fileID) {
  71     my $uploaded_file = C4::UploadedFile->fetch($sessionID, $fileID);
  72     my $fh = $uploaded_file->fh();
  73     my @input_lines = <$fh>;
  74
  75     my $filename = $uploaded_file->name();
  76     my $job = undef;
  77
  78     if ($runinbackground) {
  79         my $job_size = scalar(@input_lines);
  80         $job = C4::BackgroundJob->new($sessionID, $filename, $ENV{'SCRIPT_NAME'}, $job_size);
  81         my $jobID = $job->id();
  82
  83         # fork off
  84         if (my $pid = fork) {
  85             # parent
  86             # return job ID as JSON
  87
  88             # prevent parent exiting from
  89             # destroying the kid's database handle
  90             # FIXME: according to DBI doc, this may not work for Oracle
  91             $dbh->{InactiveDestroy}  = 1;
  92
  93             my $reply = CGI->new("");
  94             print $reply->header(-type => 'text/html');
  95             print "{ jobID: '$jobID' }";
  96             exit 0;
  97         } elsif (defined $pid) {
  98             # child
  99             # close STDOUT to signal to Apache that
 100             # we're now running in the background
 101             close STDOUT;
 102             close STDERR;
 103         } else {
 104             # fork failed, so exit immediately
 105             # fork failed, so exit immediately
 106             warn "fork failed while attempting to run $ENV{'SCRIPT_NAME'} as a background job";
 107             exit 0;
 108         }
 109
 110         # if we get here, we're a child that has detached
 111         # itself from Apache
 112
 113     }
 114
 115     my $header_line = shift @input_lines;
 116     my $file_info   = parse_header_line($header_line);
 117     if ($file_info->{'Version'} ne $FILE_VERSION) {
 118       push( @output, { message => 1,
 119       ERROR_file_version => 1,
 120       upload_version => $file_info->{'Version'},
 121       current_version => $FILE_VERSION
 122       } );
 123     }
 124
 125
 126     my $i = 0;
 127     foreach  my $line (@input_lines)  {
 128
 129         $i++;
 130         my $command_line = parse_command_line($line);
 131
 132         # map command names in the file to subroutine names
 133         my %dispatch_table = (
 134             issue     => \&kocIssueItem,
 135             'return'  => \&kocReturnItem,
 136             payment   => \&kocMakePayment,
 137         );
 138
 139         # call the right sub name, passing the hashref of command_line to it.
 140         if ( exists $dispatch_table{ $command_line->{'command'} } ) {
 141             $dispatch_table{ $command_line->{'command'} }->($command_line);
 142         } else {
 143             warn "unknown command: '$command_line->{command}' not processed";
 144         }
 145
 146         if ($runinbackground) {
 147             $job->progress($i);
 148         }
 149     }
 150
 151     if ($runinbackground) {
 152         $job->finish({ results => \@output }) if defined($job);
 153     } else {
 154         $template->param(transactions_loaded => 1);
 155         $template->param(messages => \@output);
 156     }
 157 }
 158
 159 output_html_with_http_headers $query, $cookie, $template->output;
 160
 161 =head3 parse_header_line
 162
 163 parses the header line from a .koc file. This is the line that
 164 specifies things such as the file version, and the name and version of
 165 the offline circulation tool that generated the file. See
 166 L<http://wiki.koha.org/doku.php?id=koha_offline_circulation_file_format>
 167 for more information.
 168
 169 pass in a string containing the header line (the first line from th
 170 file).
 171
 172 returns a hashref containing the information from the header.
 173
 174 =cut
 175
 176 sub parse_header_line {
 177     my $header_line = shift;
 178     chomp($header_line);
 179
 180     my @fields = split( /\t/, $header_line );
 181     my %header_info = map { split( /=/, $_ ) } @fields;
 182     return \%header_info;
 183 }
 184
 185 =head3 parse_command_line
 186
 187 =cut
 188
 189 sub parse_command_line {
 190     my $command_line = shift;
 191     chomp($command_line);
 192
 193     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
 194     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
 195
 196     my %command = (
 197         date    => $date,
 198         time    => $time,
 199         id      => $id,
 200         command => $command,
 201     );
 202
 203     # set the rest of the keys using a hash slice
 204     my $argument_names = arguments_for_command($command);
 205     @command{@$argument_names} = @args;
 206
 207     return \%command;
 208
 209 }
 210
 211 =head3 arguments_for_command
 212
 213 fetches the names of the columns (and function arguments) found in the
 214 .koc file for a particular command name. For instance, the C<issue>
 215 command requires a C<cardnumber> and C<barcode>. In that case this
 216 function returns a reference to the list C<qw( cardnumber barcode )>.
 217
 218 parameters: the command name
 219
 220 returns: listref of column names.
 221
 222 =cut
 223
 224 sub arguments_for_command {
 225     my $command = shift;
 226
 227     # define the fields for this version of the file.
 228     my %format = (
 229         issue   => [qw( cardnumber barcode )],
 230         return  => [qw( barcode )],
 231         payment => [qw( cardnumber amount )],
 232     );
 233
 234     return $format{$command};
 235 }
 236
 237 sub kocIssueItem {
 238   my $circ = shift;
 239
 240   $circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
 241   my $branchcode = C4::Context->userenv->{branch};
 242   my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
 243   my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
 244   my $issue = GetItemIssue( $item->{'itemnumber'} );
 245
 246   my $issuingrule = GetIssuingRule( $borrower->{ 'categorycode' }, $item->{ 'itemtype' }, $branchcode );
 247   my $issuelength = $issuingrule->{ 'issuelength' };
 248   my ( $year, $month, $day ) = split( /-/, $circ->{'date'} );
 249   ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, $issuelength );
 250   my $date_due = sprintf("%04d-%02d-%02d", $year, $month, $day);
 251
 252   if ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
 253 #warn "Item Currently Issued.";
 254     my $issue = GetOpenIssue( $item->{'itemnumber'} );
 255
 256     if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
 257 #warn "Item issued to this member already, renewing.";
 258
 259     my $date_due_object = C4::Dates->new($date_due ,'iso');
 260     C4::Circulation::AddRenewal(
 261         $issue->{'borrowernumber'},    # borrowernumber
 262         $item->{'itemnumber'},         # itemnumber
 263         undef,                         # branch
 264         $date_due_object,              # datedue
 265         $circ->{'date'},               # issuedate
 266     ) unless ($DEBUG);
 267
 268       push( @output, { renew => 1,
 269     title => $item->{ 'title' },
 270     biblionumber => $item->{'biblionumber'},
 271     barcode => $item->{ 'barcode' },
 272     firstname => $borrower->{ 'firstname' },
 273     surname => $borrower->{ 'surname' },
 274     borrowernumber => $borrower->{'borrowernumber'},
 275     cardnumber => $borrower->{'cardnumber'},
 276     datetime => $circ->{ 'datetime' }
 277     } );
 278
 279     } else {
 280 #warn "Item issued to a different member.";
 281 #warn "Date of previous issue: $issue->{'issuedate'}";
 282 #warn "Date of this issue: $circ->{'date'}";
 283       my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
 284       my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
 285
 286       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.
 287         my $date_due_object = C4::Dates->new($date_due ,'iso');
 288         C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due_object ) unless ( DEBUG );
 289         push( @output, { issue => 1,
 290     title => $item->{ 'title' },
 291     biblionumber => $item->{'biblionumber'},
 292     barcode => $item->{ 'barcode' },
 293     firstname => $borrower->{ 'firstname' },
 294     surname => $borrower->{ 'surname' },
 295     borrowernumber => $borrower->{'borrowernumber'},
 296     cardnumber => $borrower->{'cardnumber'},
 297     datetime => $circ->{ 'datetime' }
 298     } );
 299
 300       } 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.
 301 #warn "Current issue to another member is newer. Doing nothing";
 302         ## This situation should only happen of the Offline Circ data is *really* old.
 303         ## FIXME: write line to old_issues and statistics
 304       }
 305
 306     }
 307   } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
 308       my $date_due_object = C4::Dates->new($date_due ,'iso');
 309       C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due_object ) unless ( DEBUG );
 310     push( @output, { issue => 1,
 311     title => $item->{ 'title' },
 312     biblionumber => $item->{'biblionumber'},
 313     barcode => $item->{ 'barcode' },
 314     firstname => $borrower->{ 'firstname' },
 315     surname => $borrower->{ 'surname' },
 316     borrowernumber => $borrower->{'borrowernumber'},
 317     cardnumber => $borrower->{'cardnumber'},
 318     datetime =>$circ->{ 'datetime' }
 319     } );
 320          }
 321 }
 322
 323 sub kocReturnItem {
 324   my ( $circ ) = @_;
 325   $circ->{'barcode'} = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
 326   my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
 327   #warn( Data::Dumper->Dump( [ $circ, $item ], [ qw( circ item ) ] ) );
 328   my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
 329   if ( $borrowernumber ) {
 330   my $borrower = GetMember( 'borrowernumber' =>$borrowernumber );
 331     C4::Circulation::MarkIssueReturned( $borrowernumber,
 332                                       $item->{'itemnumber'},
 333                                       undef,
 334                                       $circ->{'date'} );
 335
 336   push( @output, { return => 1,
 337     title => $item->{ 'title' },
 338     biblionumber => $item->{'biblionumber'},
 339     barcode => $item->{ 'barcode' },
 340     borrowernumber => $borrower->{'borrowernumber'},
 341     firstname => $borrower->{'firstname'},
 342     surname => $borrower->{'surname'},
 343     cardnumber => $borrower->{'cardnumber'},
 344     datetime => $circ->{ 'datetime' }
 345     } );
 346   } else {
 347     push( @output, { ERROR_no_borrower_from_item => 1,
 348     badbarcode => $circ->{'barcode'}
 349     } );
 350
 351   }
 352
 353 }
 354
 355 sub kocMakePayment {
 356   my ( $circ ) = @_;
 357   my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
 358   recordpayment( $borrower->{'borrowernumber'}, $circ->{'amount'} );
 359   push( @output, { payment => 1,
 360     amount => $circ->{'amount'},
 361     firstname => $borrower->{'firstname'},
 362     surname => $borrower->{'surname'},
 363     cardnumber => $circ->{'cardnumber'},
 364     borrower => $borrower->{'borrowernumber'}
 365     } );
 366 }
 367
 368 =head3 _get_borrowernumber_from_barcode
 369
 370 pass in a barcode
 371 get back the borrowernumber of the patron who has it checked out.
 372 undef if that can't be found
 373
 374 =cut
 375
 376 sub _get_borrowernumber_from_barcode {
 377     my $barcode = shift;
 378
 379     return unless $barcode;
 380
 381     my $item = GetBiblioFromItemNumber( undef, $barcode );
 382     return unless $item->{'itemnumber'};
 383
 384     my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
 385     return unless $issue->{'borrowernumber'};
 386     return $issue->{'borrowernumber'};
 387
 388 }