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-community.org/wiki/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     $header_line =~ s/\r//g;
 180
 181     my @fields = split( /\t/, $header_line );
 182     my %header_info = map { split( /=/, $_ ) } @fields;
 183     return \%header_info;
 184 }
 185
 186 =head3 parse_command_line
 187
 188 =cut
 189
 190 sub parse_command_line {
 191     my $command_line = shift;
 192     chomp($command_line);
 193     $command_line =~ s/\r//g;
 194
 195     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
 196     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
 197
 198     my %command = (
 199         date    => $date,
 200         time    => $time,
 201         id      => $id,
 202         command => $command,
 203     );
 204
 205     # set the rest of the keys using a hash slice
 206     my $argument_names = arguments_for_command($command);
 207     @command{@$argument_names} = @args;
 208
 209     return \%command;
 210
 211 }
 212
 213 =head3 arguments_for_command
 214
 215 fetches the names of the columns (and function arguments) found in the
 216 .koc file for a particular command name. For instance, the C<issue>
 217 command requires a C<cardnumber> and C<barcode>. In that case this
 218 function returns a reference to the list C<qw( cardnumber barcode )>.
 219
 220 parameters: the command name
 221
 222 returns: listref of column names.
 223
 224 =cut
 225
 226 sub arguments_for_command {
 227     my $command = shift;
 228
 229     # define the fields for this version of the file.
 230     my %format = (
 231         issue   => [qw( cardnumber barcode )],
 232         return  => [qw( barcode )],
 233         payment => [qw( cardnumber amount )],
 234     );
 235
 236     return $format{$command};
 237 }
 238
 239 sub kocIssueItem {
 240   my $circ = shift;
 241
 242   $circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
 243   my $branchcode = C4::Context->userenv->{branch};
 244   my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
 245   my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
 246   my $issue = GetItemIssue( $item->{'itemnumber'} );
 247
 248   my $issuingrule = GetIssuingRule( $borrower->{ 'categorycode' }, $item->{ 'itemtype' }, $branchcode );
 249   my $issuelength = $issuingrule->{ 'issuelength' };
 250   my ( $year, $month, $day ) = split( /-/, $circ->{'date'} );
 251   ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, $issuelength );
 252   my $date_due = sprintf("%04d-%02d-%02d", $year, $month, $day);
 253
 254   if ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
 255 #warn "Item Currently Issued.";
 256     my $issue = GetOpenIssue( $item->{'itemnumber'} );
 257
 258     if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
 259 #warn "Item issued to this member already, renewing.";
 260
 261     my $date_due_object = C4::Dates->new($date_due ,'iso');
 262     C4::Circulation::AddRenewal(
 263         $issue->{'borrowernumber'},    # borrowernumber
 264         $item->{'itemnumber'},         # itemnumber
 265         undef,                         # branch
 266         $date_due_object,              # datedue
 267         $circ->{'date'},               # issuedate
 268     ) unless ($DEBUG);
 269
 270       push( @output, { renew => 1,
 271     title => $item->{ 'title' },
 272     biblionumber => $item->{'biblionumber'},
 273     barcode => $item->{ 'barcode' },
 274     firstname => $borrower->{ 'firstname' },
 275     surname => $borrower->{ 'surname' },
 276     borrowernumber => $borrower->{'borrowernumber'},
 277     cardnumber => $borrower->{'cardnumber'},
 278     datetime => $circ->{ 'datetime' }
 279     } );
 280
 281     } else {
 282 #warn "Item issued to a different member.";
 283 #warn "Date of previous issue: $issue->{'issuedate'}";
 284 #warn "Date of this issue: $circ->{'date'}";
 285       my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
 286       my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
 287
 288       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.
 289         my $date_due_object = C4::Dates->new($date_due ,'iso');
 290         C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due_object ) unless ( DEBUG );
 291         push( @output, { issue => 1,
 292     title => $item->{ 'title' },
 293     biblionumber => $item->{'biblionumber'},
 294     barcode => $item->{ 'barcode' },
 295     firstname => $borrower->{ 'firstname' },
 296     surname => $borrower->{ 'surname' },
 297     borrowernumber => $borrower->{'borrowernumber'},
 298     cardnumber => $borrower->{'cardnumber'},
 299     datetime => $circ->{ 'datetime' }
 300     } );
 301
 302       } 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.
 303 #warn "Current issue to another member is newer. Doing nothing";
 304         ## This situation should only happen of the Offline Circ data is *really* old.
 305         ## FIXME: write line to old_issues and statistics
 306       }
 307
 308     }
 309   } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
 310       my $date_due_object = C4::Dates->new($date_due ,'iso');
 311       C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due_object ) unless ( DEBUG );
 312     push( @output, { issue => 1,
 313     title => $item->{ 'title' },
 314     biblionumber => $item->{'biblionumber'},
 315     barcode => $item->{ 'barcode' },
 316     firstname => $borrower->{ 'firstname' },
 317     surname => $borrower->{ 'surname' },
 318     borrowernumber => $borrower->{'borrowernumber'},
 319     cardnumber => $borrower->{'cardnumber'},
 320     datetime =>$circ->{ 'datetime' }
 321     } );
 322          }
 323 }
 324
 325 sub kocReturnItem {
 326   my ( $circ ) = @_;
 327   $circ->{'barcode'} = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
 328   my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
 329   #warn( Data::Dumper->Dump( [ $circ, $item ], [ qw( circ item ) ] ) );
 330   my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
 331   if ( $borrowernumber ) {
 332   my $borrower = GetMember( 'borrowernumber' =>$borrowernumber );
 333     C4::Circulation::MarkIssueReturned( $borrowernumber,
 334                                       $item->{'itemnumber'},
 335                                       undef,
 336                                       $circ->{'date'} );
 337
 338   push( @output, { return => 1,
 339     title => $item->{ 'title' },
 340     biblionumber => $item->{'biblionumber'},
 341     barcode => $item->{ 'barcode' },
 342     borrowernumber => $borrower->{'borrowernumber'},
 343     firstname => $borrower->{'firstname'},
 344     surname => $borrower->{'surname'},
 345     cardnumber => $borrower->{'cardnumber'},
 346     datetime => $circ->{ 'datetime' }
 347     } );
 348   } else {
 349     push( @output, { ERROR_no_borrower_from_item => 1,
 350     badbarcode => $circ->{'barcode'}
 351     } );
 352
 353   }
 354
 355 }
 356
 357 sub kocMakePayment {
 358   my ( $circ ) = @_;
 359   my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
 360   recordpayment( $borrower->{'borrowernumber'}, $circ->{'amount'} );
 361   push( @output, { payment => 1,
 362     amount => $circ->{'amount'},
 363     firstname => $borrower->{'firstname'},
 364     surname => $borrower->{'surname'},
 365     cardnumber => $circ->{'cardnumber'},
 366     borrower => $borrower->{'borrowernumber'}
 367     } );
 368 }
 369
 370 =head3 _get_borrowernumber_from_barcode
 371
 372 pass in a barcode
 373 get back the borrowernumber of the patron who has it checked out.
 374 undef if that can't be found
 375
 376 =cut
 377
 378 sub _get_borrowernumber_from_barcode {
 379     my $barcode = shift;
 380
 381     return unless $barcode;
 382
 383     my $item = GetBiblioFromItemNumber( undef, $barcode );
 384     return unless $item->{'itemnumber'};
 385
 386     my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
 387     return unless $issue->{'borrowernumber'};
 388     return $issue->{'borrowernumber'};
 389
 390 }