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::Circulation qw( barcodedecode AddRenewal AddIssue MarkIssueReturned );
  29 use C4::Items qw( ModDateLastSeen );
  30 use Koha::UploadedFiles;
  31 use Koha::Account;
  32 use Koha::Checkouts;
  33 use Koha::Patrons;
  34
  35 use Date::Calc qw( Date_to_Days );
  36
  37 use constant DEBUG => 0;
  38
  39 # this is the file version number that we're coded against.
  40 my $FILE_VERSION = '1.0';
  41
  42 our $query = CGI->new;
  43
  44 my ($template, $loggedinuser, $cookie) = get_template_and_user({
  45     template_name => "offline_circ/process_koc.tt",
  46     query => $query,
  47     type => "intranet",
  48      flagsrequired   => { circulate => "circulate_remaining_permissions" },
  49 });
  50
  51
  52 my $fileID=$query->param('uploadedfileid');
  53 my $op = $query->param('op') || q{};
  54 my %cookies = CGI::Cookie->fetch();
  55 my $sessionID = $cookies{'CGISESSID'}->value;
  56 ## 'Local' globals.
  57 our $dbh = C4::Context->dbh();
  58 our @output = (); ## For storing messages to be displayed to the user
  59
  60 if ( $op eq 'add_to_queue' ) {
  61     $template->param(transactions_loaded => 1);
  62 } elsif ($fileID) {
  63     my $upload = Koha::UploadedFiles->find( $fileID );
  64     my $fh = $upload? $upload->file_handle: undef;
  65     my $filename = $upload? $upload->filename: undef;
  66     my @input_lines = $fh? <$fh>: ();
  67     $fh->close if $fh;
  68
  69     my $header_line = shift @input_lines;
  70     my $file_info   = parse_header_line($header_line);
  71     if ($file_info->{'Version'} ne $FILE_VERSION) {
  72         push @output, {
  73             message => 1,
  74             ERROR_file_version => 1,
  75             upload_version => $file_info->{'Version'},
  76             current_version => $FILE_VERSION
  77         };
  78     }
  79
  80     my $i = 0;
  81     foreach  my $line (@input_lines)  {
  82         $i++;
  83         my $command_line = parse_command_line($line);
  84
  85         # map command names in the file to subroutine names
  86         my %dispatch_table = (
  87             issue     => \&kocIssueItem,
  88             'return'  => \&kocReturnItem,
  89             payment   => \&kocMakePayment,
  90         );
  91
  92         # call the right sub name, passing the hashref of command_line to it.
  93         if ( exists $dispatch_table{ $command_line->{'command'} } ) {
  94             $dispatch_table{ $command_line->{'command'} }->($command_line);
  95         } else {
  96             warn "unknown command: '$command_line->{command}' not processed";
  97         }
  98     }
  99
 100     $template->param(transactions_loaded => 1);
 101     $template->param(messages => \@output);
 102 }
 103
 104 output_html_with_http_headers $query, $cookie, $template->output;
 105
 106 =head1 FUNCTIONS
 107
 108 =head2 parse_header_line
 109
 110 parses the header line from a .koc file. This is the line that
 111 specifies things such as the file version, and the name and version of
 112 the offline circulation tool that generated the file. See
 113 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
 114 for more information.
 115
 116 pass in a string containing the header line (the first line from th
 117 file).
 118
 119 returns a hashref containing the information from the header.
 120
 121 =cut
 122
 123 sub parse_header_line {
 124     my $header_line = shift;
 125     chomp($header_line);
 126     $header_line =~ s/\r//g;
 127
 128     my @fields = split( /\t/, $header_line );
 129     my %header_info = map { split( /=/, $_ ) } @fields;
 130     return \%header_info;
 131 }
 132
 133 =head2 parse_command_line
 134
 135 =cut
 136
 137 sub parse_command_line {
 138     my $command_line = shift;
 139     chomp($command_line);
 140     $command_line =~ s/\r//g;
 141
 142     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
 143     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
 144
 145     my %command = (
 146         date    => $date,
 147         time    => $time,
 148         id      => $id,
 149         command => $command,
 150     );
 151
 152     # set the rest of the keys using a hash slice
 153     my $argument_names = arguments_for_command($command);
 154     @command{@$argument_names} = @args;
 155
 156     return \%command;
 157
 158 }
 159
 160 =head2 arguments_for_command
 161
 162 fetches the names of the columns (and function arguments) found in the
 163 .koc file for a particular command name. For instance, the C<issue>
 164 command requires a C<cardnumber> and C<barcode>. In that case this
 165 function returns a reference to the list C<qw( cardnumber barcode )>.
 166
 167 parameters: the command name
 168
 169 returns: listref of column names.
 170
 171 =cut
 172
 173 sub arguments_for_command {
 174     my $command = shift;
 175
 176     # define the fields for this version of the file.
 177     my %format = (
 178         issue   => [qw( cardnumber barcode )],
 179         return  => [qw( barcode )],
 180         payment => [qw( cardnumber amount )],
 181     );
 182
 183     return $format{$command};
 184 }
 185
 186 sub kocIssueItem {
 187     my $circ = shift;
 188
 189     $circ->{barcode} = barcodedecode( $circ->{barcode} ) if $circ->{barcode};
 190
 191     my $branchcode = C4::Context->userenv->{branch};
 192     my $patron = Koha::Patrons->find( { cardnumber => $circ->{cardnumber} } );
 193     my $item = Koha::Items->find({ barcode => $circ->{barcode} });
 194     my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
 195     my $biblio = $item->biblio;
 196
 197     if ( $issue ) { ## Item is currently checked out to another person.
 198         #warn "Item Currently Issued.";
 199
 200         if ( $issue->borrowernumber eq $patron->borrowernumber ) { ## Issued to this person already, renew it.
 201             #warn "Item issued to this member already, renewing.";
 202
 203             C4::Circulation::AddRenewal(
 204                 {
 205                     borrowernumber  => $issue->borrowernumber,
 206                     itemnumber      => $item->itemnumber,
 207                     lastreneweddate => $circ->{'date'},
 208                 }
 209             ) unless (DEBUG);
 210
 211             push @output, {
 212                 renew => 1,
 213                 title => $biblio->title,
 214                 biblionumber => $biblio->biblionumber,
 215                 barcode => $item->barcode,
 216                 firstname => $patron->firstname,
 217                 surname => $patron->surname,
 218                 borrowernumber => $patron->borrowernumber,
 219                 cardnumber => $patron->cardnumber,
 220                 datetime => $circ->datetime
 221             };
 222
 223         } else {
 224             #warn "Item issued to a different member.";
 225             #warn "Date of previous issue: $issue->issuedate";
 226             #warn "Date of this issue: $circ->{'date'}";
 227             my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->issuedate );
 228             my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
 229
 230             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.
 231                 C4::Circulation::AddIssue( $patron, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
 232                 push @output, {
 233                     issue => 1,
 234                     title => $biblio->title,
 235                     biblionumber => $biblio->biblionumber,
 236                     barcode => $item->barcode,
 237                     firstname => $patron->firstname,
 238                     surname => $patron->surname,
 239                     borrowernumber => $patron->borrowernumber,
 240                     cardnumber => $patron->cardnumber,
 241                     datetime => $circ->datetime
 242                 };
 243
 244             } 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.
 245                 #warn "Current issue to another member is newer. Doing nothing";
 246                 ## This situation should only happen of the Offline Circ data is *really* old.
 247                 ## FIXME: write line to old_issues and statistics
 248             }
 249         }
 250     } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
 251         C4::Circulation::AddIssue( $patron, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
 252         push @output, {
 253             issue => 1,
 254             title => $biblio->title,
 255             biblionumber => $biblio->biblionumber,
 256             barcode => $item->barcode,
 257             firstname => $patron->firstname,
 258             surname => $patron->surname,
 259             borrowernumber => $patron->borrowernumber,
 260             cardnumber => $patron->cardnumber,
 261             datetime =>$circ->datetime
 262         };
 263     }
 264 }
 265
 266 sub kocReturnItem {
 267     my ( $circ ) = @_;
 268
 269     $circ->{barcode} = barcodedecode( $circ->{barcode} ) if $circ->{barcode};
 270
 271     my $item = Koha::Items->find({ barcode => $circ->{barcode} });
 272     my $biblio = $item->biblio;
 273     my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
 274     if ( $borrowernumber ) {
 275         my $patron = Koha::Patrons->find( $borrowernumber );
 276         C4::Circulation::MarkIssueReturned(
 277             $borrowernumber,
 278             $item->itemnumber,
 279             $circ->{'date'},
 280             $patron->privacy
 281         );
 282
 283         $item->onloan(undef)->store;
 284         ModDateLastSeen( $item->itemnumber );
 285
 286         push @output,
 287           {
 288             return         => 1,
 289             title          => $biblio->title,
 290             biblionumber   => $biblio->biblionumber,
 291             barcode        => $item->barcode,
 292             borrowernumber => $patron->borrowernumber,
 293             firstname      => $patron->firstname,
 294             surname        => $patron->surname,
 295             cardnumber     => $patron->cardnumber,
 296             datetime       => $circ->{'datetime'}
 297           };
 298     } else {
 299         push @output, {
 300             ERROR_no_borrower_from_item => 1,
 301             badbarcode => $circ->{'barcode'}
 302         };
 303     }
 304 }
 305
 306 sub kocMakePayment {
 307     my ($circ) = @_;
 308
 309     my $cardnumber = $circ->{cardnumber};
 310     my $amount = $circ->{amount};
 311
 312     my $patron = Koha::Patrons->find( { cardnumber => $cardnumber } );
 313
 314     Koha::Account->new( { patron_id => $patron->id } )
 315       ->pay( { amount => $amount, interface => C4::Context->interface } );
 316
 317     push @output,
 318       {
 319         payment    => 1,
 320         amount     => $circ->{'amount'},
 321         firstname  => $patron->firstname,
 322         surname    => $patron->surname,
 323         cardnumber => $patron->cardnumber,
 324         borrower   => $patron->id,
 325       };
 326 }
 327
 328 =head2 _get_borrowernumber_from_barcode
 329
 330 pass in a barcode
 331 get back the borrowernumber of the patron who has it checked out.
 332 undef if that can't be found
 333
 334 =cut
 335
 336 sub _get_borrowernumber_from_barcode {
 337     my $barcode = shift;
 338
 339     return unless $barcode;
 340
 341     my $item = Koha::Items->find({ barcode => $barcode });
 342     return unless $item;
 343
 344     my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
 345     return unless $issue;
 346     return $issue->borrowernumber;
 347 }