Bug 28704: Library MARCOrgCode field needs maxlength attribute
[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
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;
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;
37
38 use Date::Calc qw( Add_Delta_Days Date_to_Days );
39
40 use constant DEBUG => 0;
41
42 # this is the file version number that we're coded against.
43 my $FILE_VERSION = '1.0';
44
45 my $query = CGI->new;
46 my @output;
47
48 my ($template, $loggedinuser, $cookie) = get_template_and_user({
49     template_name => "offline_circ/enqueue_koc.tt",
50     query => $query,
51     type => "intranet",
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 = Koha::Items->find({ barcode => $barcode });
193     return unless $item;
194
195     my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
196     return unless $issue;
197     return $issue->borrowernumber;
198 }