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   my $branchcode = C4::Context->userenv->{branch};
 241   my $borrower = GetMember( $circ->{ 'cardnumber' }, 'cardnumber' );
 242   my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
 243   my $issue = GetItemIssue( $item->{'itemnumber'} );
 244
 245   my $issuingrule = GetIssuingRule( $borrower->{ 'categorycode' }, $item->{ 'itemtype' }, $branchcode );
 246   my $issuelength = $issuingrule->{ 'issuelength' };
 247   my ( $year, $month, $day ) = split( /-/, $circ->{'date'} );
 248   ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, $issuelength );
 249   my $date_due = sprintf("%04d-%02d-%02d", $year, $month, $day);
 250
 251   if ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
 252 #warn "Item Currently Issued.";
 253     my $issue = GetOpenIssue( $item->{'itemnumber'} );
 254
 255     if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
 256 #warn "Item issued to this member already, renewing.";
 257
 258     my $date_due_object = C4::Dates->new($date_due ,'iso');
 259     C4::Circulation::AddRenewal(
 260         $issue->{'borrowernumber'},    # borrowernumber
 261         $item->{'itemnumber'},         # itemnumber
 262         undef,                         # branch
 263         $date_due_object,              # datedue
 264         $circ->{'date'},               # issuedate
 265     ) unless ($DEBUG);
 266
 267       push( @output, { renew => 1,
 268     title => $item->{ 'title' },
 269     biblionumber => $item->{'biblionumber'},
 270     barcode => $item->{ 'barcode' },
 271     firstname => $borrower->{ 'firstname' },
 272     surname => $borrower->{ 'surname' },
 273     borrowernumber => $borrower->{'borrowernumber'},
 274     cardnumber => $borrower->{'cardnumber'},
 275     datetime => $circ->{ 'datetime' }
 276     } );
 277
 278     } else {
 279 #warn "Item issued to a different member.";
 280 #warn "Date of previous issue: $issue->{'issuedate'}";
 281 #warn "Date of this issue: $circ->{'date'}";
 282       my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
 283       my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
 284
 285       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.
 286         my $date_due_object = C4::Dates->new($date_due ,'iso');
 287         C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due_object ) unless ( DEBUG );
 288         push( @output, { issue => 1,
 289     title => $item->{ 'title' },
 290     biblionumber => $item->{'biblionumber'},
 291     barcode => $item->{ 'barcode' },
 292     firstname => $borrower->{ 'firstname' },
 293     surname => $borrower->{ 'surname' },
 294     borrowernumber => $borrower->{'borrowernumber'},
 295     cardnumber => $borrower->{'cardnumber'},
 296     datetime => $circ->{ 'datetime' }
 297     } );
 298
 299       } 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.
 300 #warn "Current issue to another member is newer. Doing nothing";
 301         ## This situation should only happen of the Offline Circ data is *really* old.
 302         ## FIXME: write line to old_issues and statistics
 303       }
 304
 305     }
 306   } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
 307       my $date_due_object = C4::Dates->new($date_due ,'iso');
 308       C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due_object ) unless ( DEBUG );
 309     push( @output, { issue => 1,
 310     title => $item->{ 'title' },
 311     biblionumber => $item->{'biblionumber'},
 312     barcode => $item->{ 'barcode' },
 313     firstname => $borrower->{ 'firstname' },
 314     surname => $borrower->{ 'surname' },
 315     borrowernumber => $borrower->{'borrowernumber'},
 316     cardnumber => $borrower->{'cardnumber'},
 317     datetime =>$circ->{ 'datetime' }
 318     } );
 319          }
 320 }
 321
 322 sub kocReturnItem {
 323   my ( $circ ) = @_;
 324   my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
 325   #warn( Data::Dumper->Dump( [ $circ, $item ], [ qw( circ item ) ] ) );
 326   my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
 327   if ( $borrowernumber ) {
 328   my $borrower = GetMember( $borrowernumber, 'borrowernumber' );
 329     C4::Circulation::MarkIssueReturned( $borrowernumber,
 330                                       $item->{'itemnumber'},
 331                                       undef,
 332                                       $circ->{'date'} );
 333
 334   push( @output, { return => 1,
 335     title => $item->{ 'title' },
 336     biblionumber => $item->{'biblionumber'},
 337     barcode => $item->{ 'barcode' },
 338     borrowernumber => $borrower->{'borrowernumber'},
 339     firstname => $borrower->{'firstname'},
 340     surname => $borrower->{'surname'},
 341     cardnumber => $borrower->{'cardnumber'},
 342     datetime => $circ->{ 'datetime' }
 343     } );
 344   } else {
 345     push( @output, { ERROR_no_borrower_from_item => 1,
 346     badbarcode => $circ->{'barcode'}
 347     } );
 348
 349   }
 350
 351 }
 352
 353 sub kocMakePayment {
 354   my ( $circ ) = @_;
 355   my $borrower = GetMember( $circ->{ 'cardnumber' }, 'cardnumber' );
 356   recordpayment( $borrower->{'borrowernumber'}, $circ->{'amount'} );
 357   push( @output, { payment => 1,
 358     amount => $circ->{'amount'},
 359     firstname => $borrower->{'firstname'},
 360     surname => $borrower->{'surname'},
 361     cardnumber => $circ->{'cardnumber'},
 362     borrower => $borrower->{'borrowernumber'}
 363     } );
 364 }
 365
 366 =head3 _get_borrowernumber_from_barcode
 367
 368 pass in a barcode
 369 get back the borrowernumber of the patron who has it checked out.
 370 undef if that can't be found
 371
 372 =cut
 373
 374 sub _get_borrowernumber_from_barcode {
 375     my $barcode = shift;
 376
 377     return unless $barcode;
 378
 379     my $item = GetBiblioFromItemNumber( undef, $barcode );
 380     return unless $item->{'itemnumber'};
 381
 382     my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
 383     return unless $issue->{'borrowernumber'};
 384     return $issue->{'borrowernumber'};
 385
 386 }