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