Bug 10240: (follow-up) don't display patrons as lost or gone-no-address incorrectly
[koha.git] / 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 under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 #
20
21 use strict;
22 use warnings;
23
24 use CGI;
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 C4::UploadedFile;
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.tmpl",
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 $uploaded_file = C4::UploadedFile->fetch($sessionID, $fileID);
64     my $fh = $uploaded_file->fh();
65     my @input_lines = <$fh>;
66
67     my $header_line = shift @input_lines;
68     my $file_info   = parse_header_line($header_line);
69     if ($file_info->{'Version'} ne $FILE_VERSION) {
70         push @output, {
71             message => 1,
72             ERROR_file_version => 1,
73             upload_version => $file_info->{'Version'},
74             current_version => $FILE_VERSION
75         };
76     }
77
78     my $userid = C4::Context->userenv->{id};
79     my $branchcode = C4::Context->userenv->{branch};
80
81     foreach  my $line (@input_lines)  {
82         my $command_line = parse_command_line($line);
83         my $timestamp = $command_line->{'date'} . ' ' . $command_line->{'time'};
84         my $action = $command_line->{'command'};
85         my $barcode = $command_line->{'barcode'};
86         my $cardnumber = $command_line->{'cardnumber'};
87         my $amount = $command_line->{'amount'};
88
89         AddOfflineOperation( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
90     }
91
92 }
93
94 $template->param( messages => \@output );
95
96 output_html_with_http_headers $query, $cookie, $template->output;
97
98 =head1 FUNCTIONS
99
100 =head2 parse_header_line
101
102 parses the header line from a .koc file. This is the line that
103 specifies things such as the file version, and the name and version of
104 the offline circulation tool that generated the file. See
105 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
106 for more information.
107
108 pass in a string containing the header line (the first line from th
109 file).
110
111 returns a hashref containing the information from the header.
112
113 =cut
114
115 sub parse_header_line {
116     my $header_line = shift;
117     chomp($header_line);
118     $header_line =~ s/\r//g;
119
120     my @fields = split( /\t/, $header_line );
121     my %header_info = map { split( /=/, $_ ) } @fields;
122     return \%header_info;
123 }
124
125 =head2 parse_command_line
126
127 =cut
128
129 sub parse_command_line {
130     my $command_line = shift;
131     chomp($command_line);
132     $command_line =~ s/\r//g;
133
134     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
135     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
136
137     my %command = (
138         date    => $date,
139         time    => $time,
140         id      => $id,
141         command => $command,
142     );
143
144     # set the rest of the keys using a hash slice
145     my $argument_names = arguments_for_command($command);
146     @command{@$argument_names} = @args;
147
148     return \%command;
149
150 }
151
152 =head2 arguments_for_command
153
154 fetches the names of the columns (and function arguments) found in the
155 .koc file for a particular command name. For instance, the C<issue>
156 command requires a C<cardnumber> and C<barcode>. In that case this
157 function returns a reference to the list C<qw( cardnumber barcode )>.
158
159 parameters: the command name
160
161 returns: listref of column names.
162
163 =cut
164
165 sub arguments_for_command {
166     my $command = shift;
167
168     # define the fields for this version of the file.
169     my %format = (
170         issue   => [qw( cardnumber barcode )],
171         return  => [qw( barcode )],
172         payment => [qw( cardnumber amount )],
173     );
174
175     return $format{$command};
176 }
177
178 =head2 _get_borrowernumber_from_barcode
179
180 pass in a barcode
181 get back the borrowernumber of the patron who has it checked out.
182 undef if that can't be found
183
184 =cut
185
186 sub _get_borrowernumber_from_barcode {
187     my $barcode = shift;
188
189     return unless $barcode;
190
191     my $item = GetBiblioFromItemNumber( undef, $barcode );
192     return unless $item->{'itemnumber'};
193
194     my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
195     return unless $issue->{'borrowernumber'};
196     return $issue->{'borrowernumber'};
197 }