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