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 $borrower = $patron->unblessed;
 194     my $item = Koha::Items->find({ barcode => $circ->{barcode} });
 195     my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
 196     my $biblio = $item->biblio;
 197
 198     if ( $issue ) { ## Item is currently checked out to another person.
 199         #warn "Item Currently Issued.";
 200
 201         if ( $issue->borrowernumber eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
 202             #warn "Item issued to this member already, renewing.";
 203
 204             C4::Circulation::AddRenewal(
 205                 {
 206                     borrowernumber  => $issue->borrowernumber,
 207                     itemnumber      => $item->itemnumber,
 208                     lastreneweddate => $circ->{'date'},
 209                 }
 210             ) unless (DEBUG);
 211
 212             push @output, {
 213                 renew => 1,
 214                 title => $biblio->title,
 215                 biblionumber => $biblio->biblionumber,
 216                 barcode => $item->barcode,
 217                 firstname => $borrower->{ 'firstname' },
 218                 surname => $borrower->{ 'surname' },
 219                 borrowernumber => $borrower->{'borrowernumber'},
 220                 cardnumber => $borrower->{'cardnumber'},
 221                 datetime => $circ->{ 'datetime' }
 222             };
 223
 224         } else {
 225             #warn "Item issued to a different member.";
 226             #warn "Date of previous issue: $issue->issuedate";
 227             #warn "Date of this issue: $circ->{'date'}";
 228             my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->issuedate );
 229             my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
 230
 231             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.
 232                 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
 233                 push @output, {
 234                     issue => 1,
 235                     title => $biblio->title,
 236                     biblionumber => $biblio->biblionumber,
 237                     barcode => $item->barcode,
 238                     firstname => $borrower->{ 'firstname' },
 239                     surname => $borrower->{ 'surname' },
 240                     borrowernumber => $borrower->{'borrowernumber'},
 241                     cardnumber => $borrower->{'cardnumber'},
 242                     datetime => $circ->{ 'datetime' }
 243                 };
 244
 245             } 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.
 246                 #warn "Current issue to another member is newer. Doing nothing";
 247                 ## This situation should only happen of the Offline Circ data is *really* old.
 248                 ## FIXME: write line to old_issues and statistics
 249             }
 250         }
 251     } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
 252         C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
 253         push @output, {
 254             issue => 1,
 255             title => $biblio->title,
 256             biblionumber => $biblio->biblionumber,
 257             barcode => $item->barcode,
 258             firstname => $borrower->{ 'firstname' },
 259             surname => $borrower->{ 'surname' },
 260             borrowernumber => $borrower->{'borrowernumber'},
 261             cardnumber => $borrower->{'cardnumber'},
 262             datetime =>$circ->{ 'datetime' }
 263         };
 264     }
 265 }
 266
 267 sub kocReturnItem {
 268     my ( $circ ) = @_;
 269
 270     $circ->{barcode} = barcodedecode( $circ->{barcode} ) if $circ->{barcode};
 271
 272     my $item = Koha::Items->find({ barcode => $circ->{barcode} });
 273     my $biblio = $item->biblio;
 274     my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
 275     if ( $borrowernumber ) {
 276         my $patron = Koha::Patrons->find( $borrowernumber );
 277         C4::Circulation::MarkIssueReturned(
 278             $borrowernumber,
 279             $item->itemnumber,
 280             $circ->{'date'},
 281             $patron->privacy
 282         );
 283
 284         $item->onloan(undef)->store;
 285         ModDateLastSeen( $item->itemnumber );
 286
 287         push @output,
 288           {
 289             return         => 1,
 290             title          => $biblio->title,
 291             biblionumber   => $biblio->biblionumber,
 292             barcode        => $item->barcode,
 293             borrowernumber => $patron->borrowernumber,
 294             firstname      => $patron->firstname,
 295             surname        => $patron->surname,
 296             cardnumber     => $patron->cardnumber,
 297             datetime       => $circ->{'datetime'}
 298           };
 299     } else {
 300         push @output, {
 301             ERROR_no_borrower_from_item => 1,
 302             badbarcode => $circ->{'barcode'}
 303         };
 304     }
 305 }
 306
 307 sub kocMakePayment {
 308     my ($circ) = @_;
 309
 310     my $cardnumber = $circ->{cardnumber};
 311     my $amount = $circ->{amount};
 312
 313     my $patron = Koha::Patrons->find( { cardnumber => $cardnumber } );
 314
 315     Koha::Account->new( { patron_id => $patron->id } )
 316       ->pay( { amount => $amount, interface => C4::Context->interface } );
 317
 318     push @output,
 319       {
 320         payment    => 1,
 321         amount     => $circ->{'amount'},
 322         firstname  => $patron->firstname,
 323         surname    => $patron->surname,
 324         cardnumber => $patron->cardnumber,
 325         borrower   => $patron->id,
 326       };
 327 }
 328
 329 =head2 _get_borrowernumber_from_barcode
 330
 331 pass in a barcode
 332 get back the borrowernumber of the patron who has it checked out.
 333 undef if that can't be found
 334
 335 =cut
 336
 337 sub _get_borrowernumber_from_barcode {
 338     my $barcode = shift;
 339
 340     return unless $barcode;
 341
 342     my $item = Koha::Items->find({ barcode => $barcode });
 343     return unless $item;
 344
 345     my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
 346     return unless $issue;
 347     return $issue->borrowernumber;
 348 }