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 under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19 #
  20
  21 use strict;
  22 use warnings;
  23
  24 use CGI qw ( -utf8 );
  25 use C4::Output;
  26 use C4::Auth;
  27 use C4::Koha;
  28 use C4::Context;
  29 use C4::Biblio;
  30 use C4::Accounts;
  31 use C4::Circulation;
  32 use C4::Items;
  33 use C4::Members;
  34 use C4::Stats;
  35 use C4::UploadedFile;
  36
  37 use Date::Calc qw( Add_Delta_Days Date_to_Days );
  38
  39 use constant DEBUG => 0;
  40
  41 # this is the file version number that we're coded against.
  42 my $FILE_VERSION = '1.0';
  43
  44 my $query = CGI->new;
  45 my @output;
  46
  47 my ($template, $loggedinuser, $cookie) = get_template_and_user({
  48     template_name => "offline_circ/enqueue_koc.tt",
  49     query => $query,
  50     type => "intranet",
  51     authnotrequired => 0,
  52      flagsrequired   => { circulate => "circulate_remaining_permissions" },
  53 });
  54
  55
  56 my $fileID=$query->param('uploadedfileid');
  57 my %cookies = parse CGI::Cookie($cookie);
  58 my $sessionID = $cookies{'CGISESSID'}->value;
  59 ## 'Local' globals.
  60 our $dbh = C4::Context->dbh();
  61
  62 if ($fileID) {
  63     my $uploaded_file = C4::UploadedFile->fetch($sessionID, $fileID);
  64     my $fh = $uploaded_file->fh();
  65     my @input_lines = <$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 $userid = C4::Context->userenv->{id};
  79     my $branchcode = C4::Context->userenv->{branch};
  80
  81     foreach  my $line (@input_lines)  {
  82         my $command_line = parse_command_line($line);
  83         my $timestamp = $command_line->{'date'} . ' ' . $command_line->{'time'};
  84         my $action = $command_line->{'command'};
  85         my $barcode = $command_line->{'barcode'};
  86         my $cardnumber = $command_line->{'cardnumber'};
  87         my $amount = $command_line->{'amount'};
  88
  89         AddOfflineOperation( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
  90     }
  91
  92 }
  93
  94 $template->param( messages => \@output );
  95
  96 output_html_with_http_headers $query, $cookie, $template->output;
  97
  98 =head1 FUNCTIONS
  99
 100 =head2 parse_header_line
 101
 102 parses the header line from a .koc file. This is the line that
 103 specifies things such as the file version, and the name and version of
 104 the offline circulation tool that generated the file. See
 105 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
 106 for more information.
 107
 108 pass in a string containing the header line (the first line from th
 109 file).
 110
 111 returns a hashref containing the information from the header.
 112
 113 =cut
 114
 115 sub parse_header_line {
 116     my $header_line = shift;
 117     chomp($header_line);
 118     $header_line =~ s/\r//g;
 119
 120     my @fields = split( /\t/, $header_line );
 121     my %header_info = map { split( /=/, $_ ) } @fields;
 122     return \%header_info;
 123 }
 124
 125 =head2 parse_command_line
 126
 127 =cut
 128
 129 sub parse_command_line {
 130     my $command_line = shift;
 131     chomp($command_line);
 132     $command_line =~ s/\r//g;
 133
 134     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
 135     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
 136
 137     my %command = (
 138         date    => $date,
 139         time    => $time,
 140         id      => $id,
 141         command => $command,
 142     );
 143
 144     # set the rest of the keys using a hash slice
 145     my $argument_names = arguments_for_command($command);
 146     @command{@$argument_names} = @args;
 147
 148     return \%command;
 149
 150 }
 151
 152 =head2 arguments_for_command
 153
 154 fetches the names of the columns (and function arguments) found in the
 155 .koc file for a particular command name. For instance, the C<issue>
 156 command requires a C<cardnumber> and C<barcode>. In that case this
 157 function returns a reference to the list C<qw( cardnumber barcode )>.
 158
 159 parameters: the command name
 160
 161 returns: listref of column names.
 162
 163 =cut
 164
 165 sub arguments_for_command {
 166     my $command = shift;
 167
 168     # define the fields for this version of the file.
 169     my %format = (
 170         issue   => [qw( cardnumber barcode )],
 171         return  => [qw( barcode )],
 172         payment => [qw( cardnumber amount )],
 173     );
 174
 175     return $format{$command};
 176 }
 177
 178 =head2 _get_borrowernumber_from_barcode
 179
 180 pass in a barcode
 181 get back the borrowernumber of the patron who has it checked out.
 182 undef if that can't be found
 183
 184 =cut
 185
 186 sub _get_borrowernumber_from_barcode {
 187     my $barcode = shift;
 188
 189     return unless $barcode;
 190
 191     my $item = GetBiblioFromItemNumber( undef, $barcode );
 192     return unless $item->{'itemnumber'};
 193
 194     my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
 195     return unless $issue->{'borrowernumber'};
 196     return $issue->{'borrowernumber'};
 197 }