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