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