offline_circ/enqueue_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 C4::Output;
  25 use C4::Auth;
  26 use C4::Koha;
  27 use C4::Context;
  28 use C4::Biblio;
  29 use C4::Accounts;
  30 use C4::Circulation;
  31 use C4::Items;
  32 use C4::Members;
  33 use C4::Stats;
  34 use Koha::Checkouts;
  35 use Koha::UploadedFiles;
  36 use Koha::Items;
  37
  38 use Date::Calc qw( Add_Delta_Days Date_to_Days );
  39
  40 # this is the file version number that we're coded against.
  41 my $FILE_VERSION = '1.0';
  42
  43 my $query = CGI->new;
  44 my @output;
  45
  46 my ($template, $loggedinuser, $cookie) = get_template_and_user({
  47     template_name => "offline_circ/enqueue_koc.tt",
  48     query => $query,
  49     type => "intranet",
  50      flagsrequired   => { circulate => "circulate_remaining_permissions" },
  51 });
  52
  53
  54 my $fileID=$query->param('uploadedfileid');
  55 my %cookies = parse CGI::Cookie($cookie);
  56 my $sessionID = $cookies{'CGISESSID'}->value;
  57 ## 'Local' globals.
  58 our $dbh = C4::Context->dbh();
  59
  60 if ($fileID) {
  61     my $upload = Koha::UploadedFiles->find($fileID);
  62     my $fh = $upload? $upload->file_handle: undef;
  63     my @input_lines = $fh? <$fh>: ();
  64     $fh->close if $fh;
  65
  66     my $header_line = shift @input_lines;
  67     my $file_info   = parse_header_line($header_line);
  68     if ($file_info->{'Version'} ne $FILE_VERSION) {
  69         push @output, {
  70             message => 1,
  71             ERROR_file_version => 1,
  72             upload_version => $file_info->{'Version'},
  73             current_version => $FILE_VERSION
  74         };
  75     }
  76
  77     my $userid = C4::Context->userenv->{id};
  78     my $branchcode = C4::Context->userenv->{branch};
  79
  80     foreach  my $line (@input_lines)  {
  81         my $command_line = parse_command_line($line);
  82         my $timestamp = $command_line->{'date'} . ' ' . $command_line->{'time'};
  83         my $action = $command_line->{'command'};
  84         my $barcode = $command_line->{'barcode'};
  85         my $cardnumber = $command_line->{'cardnumber'};
  86         my $amount = $command_line->{'amount'};
  87
  88         AddOfflineOperation( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
  89     }
  90
  91 }
  92
  93 $template->param( messages => \@output );
  94
  95 output_html_with_http_headers $query, $cookie, $template->output;
  96
  97 =head1 FUNCTIONS
  98
  99 =head2 parse_header_line
 100
 101 parses the header line from a .koc file. This is the line that
 102 specifies things such as the file version, and the name and version of
 103 the offline circulation tool that generated the file. See
 104 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
 105 for more information.
 106
 107 pass in a string containing the header line (the first line from th
 108 file).
 109
 110 returns a hashref containing the information from the header.
 111
 112 =cut
 113
 114 sub parse_header_line {
 115     my $header_line = shift;
 116     chomp($header_line);
 117     $header_line =~ s/\r//g;
 118
 119     my @fields = split( /\t/, $header_line );
 120     my %header_info = map { split( /=/, $_ ) } @fields;
 121     return \%header_info;
 122 }
 123
 124 =head2 parse_command_line
 125
 126 =cut
 127
 128 sub parse_command_line {
 129     my $command_line = shift;
 130     chomp($command_line);
 131     $command_line =~ s/\r//g;
 132
 133     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
 134     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
 135
 136     my %command = (
 137         date    => $date,
 138         time    => $time,
 139         id      => $id,
 140         command => $command,
 141     );
 142
 143     # set the rest of the keys using a hash slice
 144     my $argument_names = arguments_for_command($command);
 145     @command{@$argument_names} = @args;
 146
 147     return \%command;
 148
 149 }
 150
 151 =head2 arguments_for_command
 152
 153 fetches the names of the columns (and function arguments) found in the
 154 .koc file for a particular command name. For instance, the C<issue>
 155 command requires a C<cardnumber> and C<barcode>. In that case this
 156 function returns a reference to the list C<qw( cardnumber barcode )>.
 157
 158 parameters: the command name
 159
 160 returns: listref of column names.
 161
 162 =cut
 163
 164 sub arguments_for_command {
 165     my $command = shift;
 166
 167     # define the fields for this version of the file.
 168     my %format = (
 169         issue   => [qw( cardnumber barcode )],
 170         return  => [qw( barcode )],
 171         payment => [qw( cardnumber amount )],
 172     );
 173
 174     return $format{$command};
 175 }
 176
 177 =head2 _get_borrowernumber_from_barcode
 178
 179 pass in a barcode
 180 get back the borrowernumber of the patron who has it checked out.
 181 undef if that can't be found
 182
 183 =cut
 184
 185 sub _get_borrowernumber_from_barcode {
 186     my $barcode = shift;
 187
 188     return unless $barcode;
 189
 190     my $item = Koha::Items->find({ barcode => $barcode });
 191     return unless $item;
 192
 193     my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
 194     return unless $issue;
 195     return $issue->borrowernumber;
 196 }