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 use Carp;
  25
  26 use C4::Output;
  27 use C4::Auth;
  28 use C4::Koha;
  29 use C4::Context;
  30 use C4::Biblio;
  31 use C4::Accounts;
  32 use C4::Circulation;
  33 use C4::Items;
  34 use C4::Members;
  35 use C4::Stats;
  36 use C4::BackgroundJob;
  37 use Koha::UploadedFiles;
  38 use Koha::Account;
  39 use Koha::Checkouts;
  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 $patron = Koha::Patrons->find( { cardnumber => $circ->{cardnumber} } );
 252     my $borrower = $patron->unblessed;
 253     my $item = Koha::Items->find({ barcode => $circ->{barcode} });
 254     my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
 255     my $biblio = $item->biblio;
 256
 257     if ( $issue ) { ## Item is currently checked out to another person.
 258         #warn "Item Currently Issued.";
 259         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)
 260
 261         if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
 262             #warn "Item issued to this member already, renewing.";
 263
 264             C4::Circulation::AddRenewal(
 265                 $issue->{'borrowernumber'},    # borrowernumber
 266                 $item->itemnumber,             # itemnumber
 267                 undef,                         # branch
 268                 undef,                         # datedue - let AddRenewal calculate it automatically
 269                 $circ->{'date'},               # issuedate
 270             ) unless ($DEBUG);
 271
 272             push @output, {
 273                 renew => 1,
 274                 title => $biblio->title,
 275                 biblionumber => $biblio->biblionumber,
 276                 barcode => $item->barcode,
 277                 firstname => $borrower->{ 'firstname' },
 278                 surname => $borrower->{ 'surname' },
 279                 borrowernumber => $borrower->{'borrowernumber'},
 280                 cardnumber => $borrower->{'cardnumber'},
 281                 datetime => $circ->{ 'datetime' }
 282             };
 283
 284         } else {
 285             #warn "Item issued to a different member.";
 286             #warn "Date of previous issue: $issue->{'issuedate'}";
 287             #warn "Date of this issue: $circ->{'date'}";
 288             my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
 289             my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
 290
 291             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.
 292                 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
 293                 push @output, {
 294                     issue => 1,
 295                     title => $biblio->title,
 296                     biblionumber => $biblio->biblionumber,
 297                     barcode => $item->barcode,
 298                     firstname => $borrower->{ 'firstname' },
 299                     surname => $borrower->{ 'surname' },
 300                     borrowernumber => $borrower->{'borrowernumber'},
 301                     cardnumber => $borrower->{'cardnumber'},
 302                     datetime => $circ->{ 'datetime' }
 303                 };
 304
 305             } 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.
 306                 #warn "Current issue to another member is newer. Doing nothing";
 307                 ## This situation should only happen of the Offline Circ data is *really* old.
 308                 ## FIXME: write line to old_issues and statistics
 309             }
 310         }
 311     } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
 312         C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
 313         push @output, {
 314             issue => 1,
 315             title => $biblio->title,
 316             biblionumber => $biblio->biblionumber,
 317             barcode => $item->barcode,
 318             firstname => $borrower->{ 'firstname' },
 319             surname => $borrower->{ 'surname' },
 320             borrowernumber => $borrower->{'borrowernumber'},
 321             cardnumber => $borrower->{'cardnumber'},
 322             datetime =>$circ->{ 'datetime' }
 323         };
 324     }
 325 }
 326
 327 sub kocReturnItem {
 328     my ( $circ ) = @_;
 329     $circ->{'barcode'} = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
 330     my $item = Koha::Items->find({ barcode => $circ->{barcode} });
 331     my $biblio = $item->biblio;
 332     my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
 333     if ( $borrowernumber ) {
 334         my $patron = Koha::Patrons->find( $borrowernumber );
 335         C4::Circulation::MarkIssueReturned(
 336             $borrowernumber,
 337             $item->itemnumber,
 338             $circ->{'date'},
 339             $patron->privacy
 340         );
 341
 342         ModItem({ onloan => undef }, $biblio->biblionumber, $item->itemnumber);
 343         ModDateLastSeen( $item->itemnumber );
 344
 345         push @output,
 346           {
 347             return         => 1,
 348             title          => $biblio->title,
 349             biblionumber   => $biblio->biblionumber,
 350             barcode        => $item->barcode,
 351             borrowernumber => $patron->borrowernumber,
 352             firstname      => $patron->firstname,
 353             surname        => $patron->surname,
 354             cardnumber     => $patron->cardnumber,
 355             datetime       => $circ->{'datetime'}
 356           };
 357     } else {
 358         push @output, {
 359             ERROR_no_borrower_from_item => 1,
 360             badbarcode => $circ->{'barcode'}
 361         };
 362     }
 363 }
 364
 365 sub kocMakePayment {
 366     my ($circ) = @_;
 367
 368     my $cardnumber = $circ->{cardnumber};
 369     my $amount = $circ->{amount};
 370
 371     my $patron = Koha::Patrons->find( { cardnumber => $cardnumber } );
 372
 373     Koha::Account->new( { patron_id => $patron->id } )
 374       ->pay( { amount => $amount, interface => C4::Context->interface } );
 375
 376     push @output,
 377       {
 378         payment    => 1,
 379         amount     => $circ->{'amount'},
 380         firstname  => $patron->firstname,
 381         surname    => $patron->surname,
 382         cardnumber => $patron->cardnumber,
 383         borrower   => $patron->id,
 384       };
 385 }
 386
 387 =head2 _get_borrowernumber_from_barcode
 388
 389 pass in a barcode
 390 get back the borrowernumber of the patron who has it checked out.
 391 undef if that can't be found
 392
 393 =cut
 394
 395 sub _get_borrowernumber_from_barcode {
 396     my $barcode = shift;
 397
 398     return unless $barcode;
 399
 400     my $item = Koha::Items->find({ barcode => $barcode });
 401     return unless $item;
 402
 403     my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
 404     return unless $issue;
 405     return $issue->borrowernumber;
 406 }