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