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