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