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
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19 #
  20
  21 use strict;
  22 use warnings;
  23
  24 use CGI qw ( -utf8 );
  25 use Carp;
  26
  27 use C4::Output;
  28 use C4::Auth;
  29 use C4::Koha;
  30 use C4::Context;
  31 use C4::Biblio;
  32 use C4::Accounts;
  33 use C4::Circulation;
  34 use C4::Items;
  35 use C4::Members;
  36 use C4::Stats;
  37 use C4::BackgroundJob;
  38 use Koha::UploadedFiles;
  39 use Koha::Account;
  40 use Koha::Patrons;
  41
  42 use Date::Calc qw( Add_Delta_Days Date_to_Days );
  43
  44 use constant DEBUG => 0;
  45
  46 # this is the file version number that we're coded against.
  47 my $FILE_VERSION = '1.0';
  48
  49 our $query = CGI->new;
  50
  51 my ($template, $loggedinuser, $cookie) = get_template_and_user({
  52     template_name => "offline_circ/process_koc.tt",
  53     query => $query,
  54     type => "intranet",
  55     authnotrequired => 0,
  56      flagsrequired   => { circulate => "circulate_remaining_permissions" },
  57 });
  58
  59
  60 my $fileID=$query->param('uploadedfileid');
  61 my $runinbackground = $query->param('runinbackground');
  62 my $completedJobID = $query->param('completedJobID');
  63 my %cookies = parse CGI::Cookie($cookie);
  64 my $sessionID = $cookies{'CGISESSID'}->value;
  65 ## 'Local' globals.
  66 our $dbh = C4::Context->dbh();
  67 our @output = (); ## For storing messages to be displayed to the user
  68
  69
  70 if ($completedJobID) {
  71     my $job = C4::BackgroundJob->fetch($sessionID, $completedJobID);
  72     my $results = $job->results();
  73     $template->param(transactions_loaded => 1);
  74     $template->param(messages => $results->{results});
  75 } elsif ($fileID) {
  76     my $upload = Koha::UploadedFiles->find( $fileID );
  77     my $fh = $upload? $upload->file_handle: undef;
  78     my $filename = $upload? $upload->filename: undef;
  79     my @input_lines = $fh? <$fh>: ();
  80     $fh->close if $fh;
  81
  82     my $job = undef;
  83
  84     if ($runinbackground) {
  85         my $job_size = scalar(@input_lines);
  86         $job = C4::BackgroundJob->new($sessionID, $filename, '/cgi-bin/koha/offline_circ/process_koc.pl', $job_size);
  87         my $jobID = $job->id();
  88
  89         # fork off
  90         if (my $pid = fork) {
  91             # parent
  92             # return job ID as JSON
  93
  94             # prevent parent exiting from
  95             # destroying the kid's database handle
  96             # FIXME: according to DBI doc, this may not work for Oracle
  97             $dbh->{InactiveDestroy}  = 1;
  98
  99             my $reply = CGI->new("");
 100             print $reply->header(-type => 'text/html');
 101             print '{"jobID":"' . $jobID . '"}';
 102             exit 0;
 103         } elsif (defined $pid) {
 104             # child
 105             # close STDOUT to signal to Apache that
 106             # we're now running in the background
 107             close STDOUT;
 108             close STDERR;
 109         } else {
 110             # fork failed, so exit immediately
 111             # fork failed, so exit immediately
 112             warn "fork failed while attempting to run offline_circ/process_koc.pl as a background job";
 113             exit 0;
 114         }
 115
 116         # if we get here, we're a child that has detached
 117         # itself from Apache
 118
 119     }
 120
 121     my $header_line = shift @input_lines;
 122     my $file_info   = parse_header_line($header_line);
 123     if ($file_info->{'Version'} ne $FILE_VERSION) {
 124         push @output, {
 125             message => 1,
 126             ERROR_file_version => 1,
 127             upload_version => $file_info->{'Version'},
 128             current_version => $FILE_VERSION
 129         };
 130     }
 131
 132     my $i = 0;
 133     foreach  my $line (@input_lines)  {
 134         $i++;
 135         my $command_line = parse_command_line($line);
 136
 137         # map command names in the file to subroutine names
 138         my %dispatch_table = (
 139             issue     => \&kocIssueItem,
 140             'return'  => \&kocReturnItem,
 141             payment   => \&kocMakePayment,
 142         );
 143
 144         # call the right sub name, passing the hashref of command_line to it.
 145         if ( exists $dispatch_table{ $command_line->{'command'} } ) {
 146             $dispatch_table{ $command_line->{'command'} }->($command_line);
 147         } else {
 148             warn "unknown command: '$command_line->{command}' not processed";
 149         }
 150
 151         if ($runinbackground) {
 152             $job->progress($i);
 153         }
 154     }
 155
 156     if ($runinbackground) {
 157         $job->finish({ results => \@output }) if defined($job);
 158     } else {
 159         $template->param(transactions_loaded => 1);
 160         $template->param(messages => \@output);
 161     }
 162 }
 163
 164 output_html_with_http_headers $query, $cookie, $template->output;
 165
 166 =head1 FUNCTIONS
 167
 168 =head2 parse_header_line
 169
 170 parses the header line from a .koc file. This is the line that
 171 specifies things such as the file version, and the name and version of
 172 the offline circulation tool that generated the file. See
 173 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
 174 for more information.
 175
 176 pass in a string containing the header line (the first line from th
 177 file).
 178
 179 returns a hashref containing the information from the header.
 180
 181 =cut
 182
 183 sub parse_header_line {
 184     my $header_line = shift;
 185     chomp($header_line);
 186     $header_line =~ s/\r//g;
 187
 188     my @fields = split( /\t/, $header_line );
 189     my %header_info = map { split( /=/, $_ ) } @fields;
 190     return \%header_info;
 191 }
 192
 193 =head2 parse_command_line
 194
 195 =cut
 196
 197 sub parse_command_line {
 198     my $command_line = shift;
 199     chomp($command_line);
 200     $command_line =~ s/\r//g;
 201
 202     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
 203     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
 204
 205     my %command = (
 206         date    => $date,
 207         time    => $time,
 208         id      => $id,
 209         command => $command,
 210     );
 211
 212     # set the rest of the keys using a hash slice
 213     my $argument_names = arguments_for_command($command);
 214     @command{@$argument_names} = @args;
 215
 216     return \%command;
 217
 218 }
 219
 220 =head2 arguments_for_command
 221
 222 fetches the names of the columns (and function arguments) found in the
 223 .koc file for a particular command name. For instance, the C<issue>
 224 command requires a C<cardnumber> and C<barcode>. In that case this
 225 function returns a reference to the list C<qw( cardnumber barcode )>.
 226
 227 parameters: the command name
 228
 229 returns: listref of column names.
 230
 231 =cut
 232
 233 sub arguments_for_command {
 234     my $command = shift;
 235
 236     # define the fields for this version of the file.
 237     my %format = (
 238         issue   => [qw( cardnumber barcode )],
 239         return  => [qw( barcode )],
 240         payment => [qw( cardnumber amount )],
 241     );
 242
 243     return $format{$command};
 244 }
 245
 246 sub kocIssueItem {
 247     my $circ = shift;
 248
 249     $circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
 250     my $branchcode = C4::Context->userenv->{branch};
 251     my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
 252     my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
 253     my $issue = GetItemIssue( $item->{'itemnumber'} );
 254
 255     if ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
 256         #warn "Item Currently Issued.";
 257         my $issue = GetOpenIssue( $item->{'itemnumber'} );
 258
 259         if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
 260             #warn "Item issued to this member already, renewing.";
 261
 262             C4::Circulation::AddRenewal(
 263                 $issue->{'borrowernumber'},    # borrowernumber
 264                 $item->{'itemnumber'},         # itemnumber
 265                 undef,                         # branch
 266                 undef,                         # datedue - let AddRenewal calculate it automatically
 267                 $circ->{'date'},               # issuedate
 268             ) unless ($DEBUG);
 269
 270             push @output, {
 271                 renew => 1,
 272                 title => $item->{ 'title' },
 273                 biblionumber => $item->{'biblionumber'},
 274                 barcode => $item->{ 'barcode' },
 275                 firstname => $borrower->{ 'firstname' },
 276                 surname => $borrower->{ 'surname' },
 277                 borrowernumber => $borrower->{'borrowernumber'},
 278                 cardnumber => $borrower->{'cardnumber'},
 279                 datetime => $circ->{ 'datetime' }
 280             };
 281
 282         } else {
 283             #warn "Item issued to a different member.";
 284             #warn "Date of previous issue: $issue->{'issuedate'}";
 285             #warn "Date of this issue: $circ->{'date'}";
 286             my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
 287             my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
 288
 289             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.
 290                 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
 291                 push @output, {
 292                     issue => 1,
 293                     title => $item->{ 'title' },
 294                     biblionumber => $item->{'biblionumber'},
 295                     barcode => $item->{ 'barcode' },
 296                     firstname => $borrower->{ 'firstname' },
 297                     surname => $borrower->{ 'surname' },
 298                     borrowernumber => $borrower->{'borrowernumber'},
 299                     cardnumber => $borrower->{'cardnumber'},
 300                     datetime => $circ->{ 'datetime' }
 301                 };
 302
 303             } 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.
 304                 #warn "Current issue to another member is newer. Doing nothing";
 305                 ## This situation should only happen of the Offline Circ data is *really* old.
 306                 ## FIXME: write line to old_issues and statistics
 307             }
 308         }
 309     } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
 310         C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
 311         push @output, {
 312             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(
 334             $borrowernumber,
 335             $item->{'itemnumber'},
 336             undef,
 337             $circ->{'date'},
 338             $borrower->{'privacy'}
 339         );
 340
 341         ModItem({ onloan => undef }, $item->{'biblionumber'}, $item->{'itemnumber'});
 342         ModDateLastSeen( $item->{'itemnumber'} );
 343
 344         push @output, {
 345             return => 1,
 346             title => $item->{ 'title' },
 347             biblionumber => $item->{'biblionumber'},
 348             barcode => $item->{ 'barcode' },
 349             borrowernumber => $borrower->{'borrowernumber'},
 350             firstname => $borrower->{'firstname'},
 351             surname => $borrower->{'surname'},
 352             cardnumber => $borrower->{'cardnumber'},
 353             datetime => $circ->{ 'datetime' }
 354         };
 355     } else {
 356         push @output, {
 357             ERROR_no_borrower_from_item => 1,
 358             badbarcode => $circ->{'barcode'}
 359         };
 360     }
 361 }
 362
 363 sub kocMakePayment {
 364     my ($circ) = @_;
 365
 366     my $cardnumber = $circ->{cardnumber};
 367     my $amount = $circ->{amount};
 368
 369     my $patron = Koha::Patrons->find( { cardnumber => $cardnumber } );
 370
 371     Koha::Account->new( { patron_id => $patron->id } )
 372       ->pay( { amount => $amount } );
 373
 374     push @output,
 375       {
 376         payment    => 1,
 377         amount     => $circ->{'amount'},
 378         firstname  => $patron->firstname,
 379         surname    => $patron->surname,
 380         cardnumber => $patron->cardnumber,
 381         borrower   => $patron->id,
 382       };
 383 }
 384
 385 =head2 _get_borrowernumber_from_barcode
 386
 387 pass in a barcode
 388 get back the borrowernumber of the patron who has it checked out.
 389 undef if that can't be found
 390
 391 =cut
 392
 393 sub _get_borrowernumber_from_barcode {
 394     my $barcode = shift;
 395
 396     return unless $barcode;
 397
 398     my $item = GetBiblioFromItemNumber( undef, $barcode );
 399     return unless $item->{'itemnumber'};
 400
 401     my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
 402     return unless $issue->{'borrowernumber'};
 403     return $issue->{'borrowernumber'};
 404 }