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) = get_template_and_user({
  47     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, {
 119             message => 1,
 120             ERROR_file_version => 1,
 121             upload_version => $file_info->{'Version'},
 122             current_version => $FILE_VERSION
 123         };
 124     }
 125
 126     my $i = 0;
 127     foreach  my $line (@input_lines)  {
 128         $i++;
 129         my $command_line = parse_command_line($line);
 130
 131         # map command names in the file to subroutine names
 132         my %dispatch_table = (
 133             issue     => \&kocIssueItem,
 134             'return'  => \&kocReturnItem,
 135             payment   => \&kocMakePayment,
 136         );
 137
 138         # call the right sub name, passing the hashref of command_line to it.
 139         if ( exists $dispatch_table{ $command_line->{'command'} } ) {
 140             $dispatch_table{ $command_line->{'command'} }->($command_line);
 141         } else {
 142             warn "unknown command: '$command_line->{command}' not processed";
 143         }
 144
 145         if ($runinbackground) {
 146             $job->progress($i);
 147         }
 148     }
 149
 150     if ($runinbackground) {
 151         $job->finish({ results => \@output }) if defined($job);
 152     } else {
 153         $template->param(transactions_loaded => 1);
 154         $template->param(messages => \@output);
 155     }
 156 }
 157
 158 output_html_with_http_headers $query, $cookie, $template->output;
 159
 160 =head1 FUNCTIONS
 161
 162 =head2 parse_header_line
 163
 164 parses the header line from a .koc file. This is the line that
 165 specifies things such as the file version, and the name and version of
 166 the offline circulation tool that generated the file. See
 167 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
 168 for more information.
 169
 170 pass in a string containing the header line (the first line from th
 171 file).
 172
 173 returns a hashref containing the information from the header.
 174
 175 =cut
 176
 177 sub parse_header_line {
 178     my $header_line = shift;
 179     chomp($header_line);
 180     $header_line =~ s/\r//g;
 181
 182     my @fields = split( /\t/, $header_line );
 183     my %header_info = map { split( /=/, $_ ) } @fields;
 184     return \%header_info;
 185 }
 186
 187 =head2 parse_command_line
 188
 189 =cut
 190
 191 sub parse_command_line {
 192     my $command_line = shift;
 193     chomp($command_line);
 194     $command_line =~ s/\r//g;
 195
 196     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
 197     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
 198
 199     my %command = (
 200         date    => $date,
 201         time    => $time,
 202         id      => $id,
 203         command => $command,
 204     );
 205
 206     # set the rest of the keys using a hash slice
 207     my $argument_names = arguments_for_command($command);
 208     @command{@$argument_names} = @args;
 209
 210     return \%command;
 211
 212 }
 213
 214 =head2 arguments_for_command
 215
 216 fetches the names of the columns (and function arguments) found in the
 217 .koc file for a particular command name. For instance, the C<issue>
 218 command requires a C<cardnumber> and C<barcode>. In that case this
 219 function returns a reference to the list C<qw( cardnumber barcode )>.
 220
 221 parameters: the command name
 222
 223 returns: listref of column names.
 224
 225 =cut
 226
 227 sub arguments_for_command {
 228     my $command = shift;
 229
 230     # define the fields for this version of the file.
 231     my %format = (
 232         issue   => [qw( cardnumber barcode )],
 233         return  => [qw( barcode )],
 234         payment => [qw( cardnumber amount )],
 235     );
 236
 237     return $format{$command};
 238 }
 239
 240 sub kocIssueItem {
 241     my $circ = shift;
 242
 243     $circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
 244     my $branchcode = C4::Context->userenv->{branch};
 245     my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
 246     my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
 247     my $issue = GetItemIssue( $item->{'itemnumber'} );
 248
 249     if ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
 250         #warn "Item Currently Issued.";
 251         my $issue = GetOpenIssue( $item->{'itemnumber'} );
 252
 253         if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
 254             #warn "Item issued to this member already, renewing.";
 255
 256             C4::Circulation::AddRenewal(
 257                 $issue->{'borrowernumber'},    # borrowernumber
 258                 $item->{'itemnumber'},         # itemnumber
 259                 undef,                         # branch
 260                 undef,                         # datedue - let AddRenewal calculate it automatically
 261                 $circ->{'date'},               # issuedate
 262             ) unless ($DEBUG);
 263
 264             push @output, {
 265                 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, {
 286                     issue => 1,
 287                     title => $item->{ 'title' },
 288                     biblionumber => $item->{'biblionumber'},
 289                     barcode => $item->{ 'barcode' },
 290                     firstname => $borrower->{ 'firstname' },
 291                     surname => $borrower->{ 'surname' },
 292                     borrowernumber => $borrower->{'borrowernumber'},
 293                     cardnumber => $borrower->{'cardnumber'},
 294                     datetime => $circ->{ 'datetime' }
 295                 };
 296
 297             } 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.
 298                 #warn "Current issue to another member is newer. Doing nothing";
 299                 ## This situation should only happen of the Offline Circ data is *really* old.
 300                 ## FIXME: write line to old_issues and statistics
 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, {
 306             issue => 1,
 307             title => $item->{ 'title' },
 308             biblionumber => $item->{'biblionumber'},
 309             barcode => $item->{ 'barcode' },
 310             firstname => $borrower->{ 'firstname' },
 311             surname => $borrower->{ 'surname' },
 312             borrowernumber => $borrower->{'borrowernumber'},
 313             cardnumber => $borrower->{'cardnumber'},
 314             datetime =>$circ->{ 'datetime' }
 315         };
 316     }
 317 }
 318
 319 sub kocReturnItem {
 320     my ( $circ ) = @_;
 321     $circ->{'barcode'} = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
 322     my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
 323     #warn( Data::Dumper->Dump( [ $circ, $item ], [ qw( circ item ) ] ) );
 324     my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
 325     if ( $borrowernumber ) {
 326         my $borrower = GetMember( 'borrowernumber' =>$borrowernumber );
 327         C4::Circulation::MarkIssueReturned(
 328             $borrowernumber,
 329             $item->{'itemnumber'},
 330             undef,
 331             $circ->{'date'}
 332         );
 333
 334         push @output, {
 335             return => 1,
 336             title => $item->{ 'title' },
 337             biblionumber => $item->{'biblionumber'},
 338             barcode => $item->{ 'barcode' },
 339             borrowernumber => $borrower->{'borrowernumber'},
 340             firstname => $borrower->{'firstname'},
 341             surname => $borrower->{'surname'},
 342             cardnumber => $borrower->{'cardnumber'},
 343             datetime => $circ->{ 'datetime' }
 344         };
 345     } else {
 346         push @output, {
 347             ERROR_no_borrower_from_item => 1,
 348             badbarcode => $circ->{'barcode'}
 349         };
 350     }
 351 }
 352
 353 sub kocMakePayment {
 354     my ( $circ ) = @_;
 355     my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
 356     recordpayment( $borrower->{'borrowernumber'}, $circ->{'amount'} );
 357     push @output, {
 358         payment => 1,
 359         amount => $circ->{'amount'},
 360         firstname => $borrower->{'firstname'},
 361         surname => $borrower->{'surname'},
 362         cardnumber => $circ->{'cardnumber'},
 363         borrower => $borrower->{'borrowernumber'}
 364     };
 365 }
 366
 367 =head2 _get_borrowernumber_from_barcode
 368
 369 pass in a barcode
 370 get back the borrowernumber of the patron who has it checked out.
 371 undef if that can't be found
 372
 373 =cut
 374
 375 sub _get_borrowernumber_from_barcode {
 376     my $barcode = shift;
 377
 378     return unless $barcode;
 379
 380     my $item = GetBiblioFromItemNumber( undef, $barcode );
 381     return unless $item->{'itemnumber'};
 382
 383     my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
 384     return unless $issue->{'borrowernumber'};
 385     return $issue->{'borrowernumber'};
 386 }