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::Upload;
  39 use Koha::Account;
  40
  41 use Date::Calc qw( Add_Delta_Days Date_to_Days );
  42
  43 use constant DEBUG => 0;
  44
  45 # this is the file version number that we're coded against.
  46 my $FILE_VERSION = '1.0';
  47
  48 our $query = CGI->new;
  49
  50 my ($template, $loggedinuser, $cookie) = get_template_and_user({
  51     template_name => "offline_circ/process_koc.tt",
  52     query => $query,
  53     type => "intranet",
  54     authnotrequired => 0,
  55      flagsrequired   => { circulate => "circulate_remaining_permissions" },
  56 });
  57
  58
  59 my $fileID=$query->param('uploadedfileid');
  60 my $runinbackground = $query->param('runinbackground');
  61 my $completedJobID = $query->param('completedJobID');
  62 my %cookies = parse CGI::Cookie($cookie);
  63 my $sessionID = $cookies{'CGISESSID'}->value;
  64 ## 'Local' globals.
  65 our $dbh = C4::Context->dbh();
  66 our @output = (); ## For storing messages to be displayed to the user
  67
  68
  69 if ($completedJobID) {
  70     my $job = C4::BackgroundJob->fetch($sessionID, $completedJobID);
  71     my $results = $job->results();
  72     $template->param(transactions_loaded => 1);
  73     $template->param(messages => $results->{results});
  74 } elsif ($fileID) {
  75     my $upload = Koha::Upload->new->get({ id => $fileID, filehandle => 1 });
  76     my $fh = $upload->{fh};
  77     my $filename = $upload->{name};
  78     my @input_lines = <$fh>;
  79
  80     my $job = undef;
  81
  82     if ($runinbackground) {
  83         my $job_size = scalar(@input_lines);
  84         $job = C4::BackgroundJob->new($sessionID, $filename, '/cgi-bin/koha/offline_circ/process_koc.pl', $job_size);
  85         my $jobID = $job->id();
  86
  87         # fork off
  88         if (my $pid = fork) {
  89             # parent
  90             # return job ID as JSON
  91
  92             # prevent parent exiting from
  93             # destroying the kid's database handle
  94             # FIXME: according to DBI doc, this may not work for Oracle
  95             $dbh->{InactiveDestroy}  = 1;
  96
  97             my $reply = CGI->new("");
  98             print $reply->header(-type => 'text/html');
  99             print '{"jobID":"' . $jobID . '"}';
 100             exit 0;
 101         } elsif (defined $pid) {
 102             # child
 103             # close STDOUT to signal to Apache that
 104             # we're now running in the background
 105             close STDOUT;
 106             close STDERR;
 107         } else {
 108             # fork failed, so exit immediately
 109             # fork failed, so exit immediately
 110             warn "fork failed while attempting to run offline_circ/process_koc.pl as a background job";
 111             exit 0;
 112         }
 113
 114         # if we get here, we're a child that has detached
 115         # itself from Apache
 116
 117     }
 118
 119     my $header_line = shift @input_lines;
 120     my $file_info   = parse_header_line($header_line);
 121     if ($file_info->{'Version'} ne $FILE_VERSION) {
 122         push @output, {
 123             message => 1,
 124             ERROR_file_version => 1,
 125             upload_version => $file_info->{'Version'},
 126             current_version => $FILE_VERSION
 127         };
 128     }
 129
 130     my $i = 0;
 131     foreach  my $line (@input_lines)  {
 132         $i++;
 133         my $command_line = parse_command_line($line);
 134
 135         # map command names in the file to subroutine names
 136         my %dispatch_table = (
 137             issue     => \&kocIssueItem,
 138             'return'  => \&kocReturnItem,
 139             payment   => \&kocMakePayment,
 140         );
 141
 142         # call the right sub name, passing the hashref of command_line to it.
 143         if ( exists $dispatch_table{ $command_line->{'command'} } ) {
 144             $dispatch_table{ $command_line->{'command'} }->($command_line);
 145         } else {
 146             warn "unknown command: '$command_line->{command}' not processed";
 147         }
 148
 149         if ($runinbackground) {
 150             $job->progress($i);
 151         }
 152     }
 153
 154     if ($runinbackground) {
 155         $job->finish({ results => \@output }) if defined($job);
 156     } else {
 157         $template->param(transactions_loaded => 1);
 158         $template->param(messages => \@output);
 159     }
 160 }
 161
 162 output_html_with_http_headers $query, $cookie, $template->output;
 163
 164 =head1 FUNCTIONS
 165
 166 =head2 parse_header_line
 167
 168 parses the header line from a .koc file. This is the line that
 169 specifies things such as the file version, and the name and version of
 170 the offline circulation tool that generated the file. See
 171 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
 172 for more information.
 173
 174 pass in a string containing the header line (the first line from th
 175 file).
 176
 177 returns a hashref containing the information from the header.
 178
 179 =cut
 180
 181 sub parse_header_line {
 182     my $header_line = shift;
 183     chomp($header_line);
 184     $header_line =~ s/\r//g;
 185
 186     my @fields = split( /\t/, $header_line );
 187     my %header_info = map { split( /=/, $_ ) } @fields;
 188     return \%header_info;
 189 }
 190
 191 =head2 parse_command_line
 192
 193 =cut
 194
 195 sub parse_command_line {
 196     my $command_line = shift;
 197     chomp($command_line);
 198     $command_line =~ s/\r//g;
 199
 200     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
 201     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
 202
 203     my %command = (
 204         date    => $date,
 205         time    => $time,
 206         id      => $id,
 207         command => $command,
 208     );
 209
 210     # set the rest of the keys using a hash slice
 211     my $argument_names = arguments_for_command($command);
 212     @command{@$argument_names} = @args;
 213
 214     return \%command;
 215
 216 }
 217
 218 =head2 arguments_for_command
 219
 220 fetches the names of the columns (and function arguments) found in the
 221 .koc file for a particular command name. For instance, the C<issue>
 222 command requires a C<cardnumber> and C<barcode>. In that case this
 223 function returns a reference to the list C<qw( cardnumber barcode )>.
 224
 225 parameters: the command name
 226
 227 returns: listref of column names.
 228
 229 =cut
 230
 231 sub arguments_for_command {
 232     my $command = shift;
 233
 234     # define the fields for this version of the file.
 235     my %format = (
 236         issue   => [qw( cardnumber barcode )],
 237         return  => [qw( barcode )],
 238         payment => [qw( cardnumber amount )],
 239     );
 240
 241     return $format{$command};
 242 }
 243
 244 sub kocIssueItem {
 245     my $circ = shift;
 246
 247     $circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
 248     my $branchcode = C4::Context->userenv->{branch};
 249     my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
 250     my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
 251     my $issue = GetItemIssue( $item->{'itemnumber'} );
 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             C4::Circulation::AddRenewal(
 261                 $issue->{'borrowernumber'},    # borrowernumber
 262                 $item->{'itemnumber'},         # itemnumber
 263                 undef,                         # branch
 264                 undef,                         # datedue - let AddRenewal calculate it automatically
 265                 $circ->{'date'},               # issuedate
 266             ) unless ($DEBUG);
 267
 268             push @output, {
 269                 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                 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
 289                 push @output, {
 290                     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     } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
 308         C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
 309         push @output, {
 310             issue => 1,
 311             title => $item->{ 'title' },
 312             biblionumber => $item->{'biblionumber'},
 313             barcode => $item->{ 'barcode' },
 314             firstname => $borrower->{ 'firstname' },
 315             surname => $borrower->{ 'surname' },
 316             borrowernumber => $borrower->{'borrowernumber'},
 317             cardnumber => $borrower->{'cardnumber'},
 318             datetime =>$circ->{ 'datetime' }
 319         };
 320     }
 321 }
 322
 323 sub kocReturnItem {
 324     my ( $circ ) = @_;
 325     $circ->{'barcode'} = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
 326     my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
 327     #warn( Data::Dumper->Dump( [ $circ, $item ], [ qw( circ item ) ] ) );
 328     my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
 329     if ( $borrowernumber ) {
 330         my $borrower = GetMember( 'borrowernumber' => $borrowernumber );
 331         C4::Circulation::MarkIssueReturned(
 332             $borrowernumber,
 333             $item->{'itemnumber'},
 334             undef,
 335             $circ->{'date'},
 336             $borrower->{'privacy'}
 337         );
 338
 339         ModItem({ onloan => undef }, $item->{'biblionumber'}, $item->{'itemnumber'});
 340         ModDateLastSeen( $item->{'itemnumber'} );
 341
 342         push @output, {
 343             return => 1,
 344             title => $item->{ 'title' },
 345             biblionumber => $item->{'biblionumber'},
 346             barcode => $item->{ 'barcode' },
 347             borrowernumber => $borrower->{'borrowernumber'},
 348             firstname => $borrower->{'firstname'},
 349             surname => $borrower->{'surname'},
 350             cardnumber => $borrower->{'cardnumber'},
 351             datetime => $circ->{ 'datetime' }
 352         };
 353     } else {
 354         push @output, {
 355             ERROR_no_borrower_from_item => 1,
 356             badbarcode => $circ->{'barcode'}
 357         };
 358     }
 359 }
 360
 361 sub kocMakePayment {
 362     my ($circ) = @_;
 363
 364     my $cardnumber = $circ->{cardnumber};
 365     my $amount = $circ->{amount};
 366
 367     my $patron = Koha::Borrowers->find( { cardnumber => $cardnumber } );
 368
 369     Koha::Account->new( { patron_id => $patron->id } )
 370       ->pay( { amount => $amount } );
 371
 372     push @output,
 373       {
 374         payment    => 1,
 375         amount     => $circ->{'amount'},
 376         firstname  => $patron->firstname,
 377         surname    => $patron->surname,
 378         cardnumber => $patron->cardnumber,
 379         borrower   => $patron->id,
 380       };
 381 }
 382
 383 =head2 _get_borrowernumber_from_barcode
 384
 385 pass in a barcode
 386 get back the borrowernumber of the patron who has it checked out.
 387 undef if that can't be found
 388
 389 =cut
 390
 391 sub _get_borrowernumber_from_barcode {
 392     my $barcode = shift;
 393
 394     return unless $barcode;
 395
 396     my $item = GetBiblioFromItemNumber( undef, $barcode );
 397     return unless $item->{'itemnumber'};
 398
 399     my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
 400     return unless $issue->{'borrowernumber'};
 401     return $issue->{'borrowernumber'};
 402 }