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