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