Bug 19274: Translatability: Fix new splitting problems related to database warnings
[koha.git] / offline_circ / enqueue_koc.pl
blob57ae38c86e96206a60889ec1a799d97ea3cebeb6
1 #!/usr/bin/perl
3 # 2008 Kyle Hall <kyle.m.hall@gmail.com>
5 # This file is part of Koha.
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.
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.
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>.
21 use strict;
22 use warnings;
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::Checkouts;
36 use Koha::UploadedFiles;
37 use Koha::Items;
39 use Date::Calc qw( Add_Delta_Days Date_to_Days );
41 use constant DEBUG => 0;
43 # this is the file version number that we're coded against.
44 my $FILE_VERSION = '1.0';
46 my $query = CGI->new;
47 my @output;
49 my ($template, $loggedinuser, $cookie) = get_template_and_user({
50 template_name => "offline_circ/enqueue_koc.tt",
51 query => $query,
52 type => "intranet",
53 authnotrequired => 0,
54 flagsrequired => { circulate => "circulate_remaining_permissions" },
55 });
58 my $fileID=$query->param('uploadedfileid');
59 my %cookies = parse CGI::Cookie($cookie);
60 my $sessionID = $cookies{'CGISESSID'}->value;
61 ## 'Local' globals.
62 our $dbh = C4::Context->dbh();
64 if ($fileID) {
65 my $upload = Koha::UploadedFiles->find($fileID);
66 my $fh = $upload? $upload->file_handle: undef;
67 my @input_lines = $fh? <$fh>: ();
68 $fh->close if $fh;
70 my $header_line = shift @input_lines;
71 my $file_info = parse_header_line($header_line);
72 if ($file_info->{'Version'} ne $FILE_VERSION) {
73 push @output, {
74 message => 1,
75 ERROR_file_version => 1,
76 upload_version => $file_info->{'Version'},
77 current_version => $FILE_VERSION
81 my $userid = C4::Context->userenv->{id};
82 my $branchcode = C4::Context->userenv->{branch};
84 foreach my $line (@input_lines) {
85 my $command_line = parse_command_line($line);
86 my $timestamp = $command_line->{'date'} . ' ' . $command_line->{'time'};
87 my $action = $command_line->{'command'};
88 my $barcode = $command_line->{'barcode'};
89 my $cardnumber = $command_line->{'cardnumber'};
90 my $amount = $command_line->{'amount'};
92 AddOfflineOperation( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
97 $template->param( messages => \@output );
99 output_html_with_http_headers $query, $cookie, $template->output;
101 =head1 FUNCTIONS
103 =head2 parse_header_line
105 parses the header line from a .koc file. This is the line that
106 specifies things such as the file version, and the name and version of
107 the offline circulation tool that generated the file. See
108 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
109 for more information.
111 pass in a string containing the header line (the first line from th
112 file).
114 returns a hashref containing the information from the header.
116 =cut
118 sub parse_header_line {
119 my $header_line = shift;
120 chomp($header_line);
121 $header_line =~ s/\r//g;
123 my @fields = split( /\t/, $header_line );
124 my %header_info = map { split( /=/, $_ ) } @fields;
125 return \%header_info;
128 =head2 parse_command_line
130 =cut
132 sub parse_command_line {
133 my $command_line = shift;
134 chomp($command_line);
135 $command_line =~ s/\r//g;
137 my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
138 my ( $date, $time, $id ) = split( /\s/, $timestamp );
140 my %command = (
141 date => $date,
142 time => $time,
143 id => $id,
144 command => $command,
147 # set the rest of the keys using a hash slice
148 my $argument_names = arguments_for_command($command);
149 @command{@$argument_names} = @args;
151 return \%command;
155 =head2 arguments_for_command
157 fetches the names of the columns (and function arguments) found in the
158 .koc file for a particular command name. For instance, the C<issue>
159 command requires a C<cardnumber> and C<barcode>. In that case this
160 function returns a reference to the list C<qw( cardnumber barcode )>.
162 parameters: the command name
164 returns: listref of column names.
166 =cut
168 sub arguments_for_command {
169 my $command = shift;
171 # define the fields for this version of the file.
172 my %format = (
173 issue => [qw( cardnumber barcode )],
174 return => [qw( barcode )],
175 payment => [qw( cardnumber amount )],
178 return $format{$command};
181 =head2 _get_borrowernumber_from_barcode
183 pass in a barcode
184 get back the borrowernumber of the patron who has it checked out.
185 undef if that can't be found
187 =cut
189 sub _get_borrowernumber_from_barcode {
190 my $barcode = shift;
192 return unless $barcode;
194 my $item = Koha::Items->find({ barcode => $barcode });
195 return unless $item;
197 my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
198 return unless $issue;
199 return $issue->borrowernumber;