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 Modern::Perl;
  22
  23 use CGI qw ( -utf8 );
  24
  25 use C4::Output qw( output_html_with_http_headers );
  26 use C4::Auth qw( get_template_and_user );
  27 use C4::Context;
  28 use C4::Accounts;
  29 use C4::Circulation qw( barcodedecode AddRenewal AddIssue MarkIssueReturned );
  30 use C4::Items qw( ModDateLastSeen );
  31 use C4::Members;
  32 use C4::Stats;
  33 use C4::BackgroundJob;
  34 use Koha::UploadedFiles;
  35 use Koha::Account;
  36 use Koha::Checkouts;
  37 use Koha::Patrons;
  38
  39 use Date::Calc qw( Date_to_Days );
  40
  41 use constant DEBUG => 0;
  42
  43 # this is the file version number that we're coded against.
  44 my $FILE_VERSION = '1.0';
  45
  46 our $query = CGI->new;
  47
  48 my ($template, $loggedinuser, $cookie) = get_template_and_user({
  49     template_name => "offline_circ/process_koc.tt",
  50     query => $query,
  51     type => "intranet",
  52      flagsrequired   => { circulate => "circulate_remaining_permissions" },
  53 });
  54
  55
  56 my $fileID=$query->param('uploadedfileid');
  57 my $runinbackground = $query->param('runinbackground');
  58 my $completedJobID = $query->param('completedJobID');
  59 my %cookies = CGI::Cookie->fetch();
  60 my $sessionID = $cookies{'CGISESSID'}->value;
  61 ## 'Local' globals.
  62 our $dbh = C4::Context->dbh();
  63 our @output = (); ## For storing messages to be displayed to the user
  64
  65
  66 if ($completedJobID) {
  67     my $job = C4::BackgroundJob->fetch($sessionID, $completedJobID);
  68     my $results = $job->results();
  69     $template->param(transactions_loaded => 1);
  70     $template->param(messages => $results->{results});
  71 } elsif ($fileID) {
  72     my $upload = Koha::UploadedFiles->find( $fileID );
  73     my $fh = $upload? $upload->file_handle: undef;
  74     my $filename = $upload? $upload->filename: undef;
  75     my @input_lines = $fh? <$fh>: ();
  76     $fh->close if $fh;
  77
  78     my $job = undef;
  79
  80     if ($runinbackground) {
  81         my $job_size = scalar(@input_lines);
  82         $job = C4::BackgroundJob->new($sessionID, $filename, '/cgi-bin/koha/offline_circ/process_koc.pl', $job_size);
  83         my $jobID = $job->id();
  84
  85         # fork off
  86         if (my $pid = fork) {
  87             # parent
  88             # return job ID as JSON
  89
  90             # prevent parent exiting from
  91             # destroying the kid's database handle
  92             # FIXME: according to DBI doc, this may not work for Oracle
  93             $dbh->{InactiveDestroy}  = 1;
  94
  95             my $reply = CGI->new("");
  96             print $reply->header(-type => 'text/html');
  97             print '{"jobID":"' . $jobID . '"}';
  98             exit 0;
  99         } elsif (defined $pid) {
 100             # child
 101             # close STDOUT to signal to Apache that
 102             # we're now running in the background
 103             close STDOUT;
 104             close STDERR;
 105         } else {
 106             # fork failed, so exit immediately
 107             # fork failed, so exit immediately
 108             warn "fork failed while attempting to run offline_circ/process_koc.pl as a background job";
 109             exit 0;
 110         }
 111
 112         # if we get here, we're a child that has detached
 113         # itself from Apache
 114
 115     }
 116
 117     my $header_line = shift @input_lines;
 118     my $file_info   = parse_header_line($header_line);
 119     if ($file_info->{'Version'} ne $FILE_VERSION) {
 120         push @output, {
 121             message => 1,
 122             ERROR_file_version => 1,
 123             upload_version => $file_info->{'Version'},
 124             current_version => $FILE_VERSION
 125         };
 126     }
 127
 128     my $i = 0;
 129     foreach  my $line (@input_lines)  {
 130         $i++;
 131         my $command_line = parse_command_line($line);
 132
 133         # map command names in the file to subroutine names
 134         my %dispatch_table = (
 135             issue     => \&kocIssueItem,
 136             'return'  => \&kocReturnItem,
 137             payment   => \&kocMakePayment,
 138         );
 139
 140         # call the right sub name, passing the hashref of command_line to it.
 141         if ( exists $dispatch_table{ $command_line->{'command'} } ) {
 142             $dispatch_table{ $command_line->{'command'} }->($command_line);
 143         } else {
 144             warn "unknown command: '$command_line->{command}' not processed";
 145         }
 146
 147         if ($runinbackground) {
 148             $job->progress($i);
 149         }
 150     }
 151
 152     if ($runinbackground) {
 153         $job->finish({ results => \@output }) if defined($job);
 154     } else {
 155         $template->param(transactions_loaded => 1);
 156         $template->param(messages => \@output);
 157     }
 158 }
 159
 160 output_html_with_http_headers $query, $cookie, $template->output;
 161
 162 =head1 FUNCTIONS
 163
 164 =head2 parse_header_line
 165
 166 parses the header line from a .koc file. This is the line that
 167 specifies things such as the file version, and the name and version of
 168 the offline circulation tool that generated the file. See
 169 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
 170 for more information.
 171
 172 pass in a string containing the header line (the first line from th
 173 file).
 174
 175 returns a hashref containing the information from the header.
 176
 177 =cut
 178
 179 sub parse_header_line {
 180     my $header_line = shift;
 181     chomp($header_line);
 182     $header_line =~ s/\r//g;
 183
 184     my @fields = split( /\t/, $header_line );
 185     my %header_info = map { split( /=/, $_ ) } @fields;
 186     return \%header_info;
 187 }
 188
 189 =head2 parse_command_line
 190
 191 =cut
 192
 193 sub parse_command_line {
 194     my $command_line = shift;
 195     chomp($command_line);
 196     $command_line =~ s/\r//g;
 197
 198     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
 199     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
 200
 201     my %command = (
 202         date    => $date,
 203         time    => $time,
 204         id      => $id,
 205         command => $command,
 206     );
 207
 208     # set the rest of the keys using a hash slice
 209     my $argument_names = arguments_for_command($command);
 210     @command{@$argument_names} = @args;
 211
 212     return \%command;
 213
 214 }
 215
 216 =head2 arguments_for_command
 217
 218 fetches the names of the columns (and function arguments) found in the
 219 .koc file for a particular command name. For instance, the C<issue>
 220 command requires a C<cardnumber> and C<barcode>. In that case this
 221 function returns a reference to the list C<qw( cardnumber barcode )>.
 222
 223 parameters: the command name
 224
 225 returns: listref of column names.
 226
 227 =cut
 228
 229 sub arguments_for_command {
 230     my $command = shift;
 231
 232     # define the fields for this version of the file.
 233     my %format = (
 234         issue   => [qw( cardnumber barcode )],
 235         return  => [qw( barcode )],
 236         payment => [qw( cardnumber amount )],
 237     );
 238
 239     return $format{$command};
 240 }
 241
 242 sub kocIssueItem {
 243     my $circ = shift;
 244
 245     $circ->{barcode} = barcodedecode( $circ->{barcode} ) if $circ->{barcode};
 246
 247     my $branchcode = C4::Context->userenv->{branch};
 248     my $patron = Koha::Patrons->find( { cardnumber => $circ->{cardnumber} } );
 249     my $borrower = $patron->unblessed;
 250     my $item = Koha::Items->find({ barcode => $circ->{barcode} });
 251     my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
 252     my $biblio = $item->biblio;
 253
 254     if ( $issue ) { ## Item is currently checked out to another person.
 255         #warn "Item Currently Issued.";
 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 => $biblio->title,
 271                 biblionumber => $biblio->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 => $biblio->title,
 292                     biblionumber => $biblio->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 => $biblio->title,
 312             biblionumber => $biblio->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
 326     $circ->{barcode} = barcodedecode( $circ->{barcode} ) if $circ->{barcode};
 327
 328     my $item = Koha::Items->find({ barcode => $circ->{barcode} });
 329     my $biblio = $item->biblio;
 330     my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
 331     if ( $borrowernumber ) {
 332         my $patron = Koha::Patrons->find( $borrowernumber );
 333         C4::Circulation::MarkIssueReturned(
 334             $borrowernumber,
 335             $item->itemnumber,
 336             $circ->{'date'},
 337             $patron->privacy
 338         );
 339
 340         $item->onloan(undef)->store;
 341         ModDateLastSeen( $item->itemnumber );
 342
 343         push @output,
 344           {
 345             return         => 1,
 346             title          => $biblio->title,
 347             biblionumber   => $biblio->biblionumber,
 348             barcode        => $item->barcode,
 349             borrowernumber => $patron->borrowernumber,
 350             firstname      => $patron->firstname,
 351             surname        => $patron->surname,
 352             cardnumber     => $patron->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, interface => C4::Context->interface } );
 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 = Koha::Items->find({ barcode => $barcode });
 399     return unless $item;
 400
 401     my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
 402     return unless $issue;
 403     return $issue->borrowernumber;
 404 }