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