Merge remote branch 'kc/new/enh/bug_5432' into kcmaster
[koha.git] / offline_circ / process_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 with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA  02111-1307 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::Members;
33 use C4::Stats;
34 use C4::UploadedFile;
35 use C4::BackgroundJob;
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 our $query = CGI->new;
45
46 my ($template, $loggedinuser, $cookie) = get_template_and_user({
47     template_name => "offline_circ/process_koc.tmpl",
48     query => $query,
49     type => "intranet",
50     authnotrequired => 0,
51      flagsrequired   => { circulate => "circulate_remaining_permissions" },
52 });
53
54
55 my $fileID=$query->param('uploadedfileid');
56 my $runinbackground = $query->param('runinbackground');
57 my $completedJobID = $query->param('completedJobID');
58 my %cookies = parse CGI::Cookie($cookie);
59 my $sessionID = $cookies{'CGISESSID'}->value;
60 ## 'Local' globals.
61 our $dbh = C4::Context->dbh();
62 our @output = (); ## For storing messages to be displayed to the user
63
64
65 if ($completedJobID) {
66     my $job = C4::BackgroundJob->fetch($sessionID, $completedJobID);
67     my $results = $job->results();
68     $template->param(transactions_loaded => 1);
69     $template->param(messages => $results->{results});
70 } elsif ($fileID) {
71     my $uploaded_file = C4::UploadedFile->fetch($sessionID, $fileID);
72     my $fh = $uploaded_file->fh();
73     my @input_lines = <$fh>;
74
75     my $filename = $uploaded_file->name();
76     my $job = undef;
77
78     if ($runinbackground) {
79         my $job_size = scalar(@input_lines);
80         $job = C4::BackgroundJob->new($sessionID, $filename, $ENV{'SCRIPT_NAME'}, $job_size);
81         my $jobID = $job->id();
82
83         # fork off
84         if (my $pid = fork) {
85             # parent
86             # return job ID as JSON
87
88             # prevent parent exiting from
89             # destroying the kid's database handle
90             # FIXME: according to DBI doc, this may not work for Oracle
91             $dbh->{InactiveDestroy}  = 1;
92
93             my $reply = CGI->new("");
94             print $reply->header(-type => 'text/html');
95             print "{ jobID: '$jobID' }";
96             exit 0;
97         } elsif (defined $pid) {
98             # child
99             # close STDOUT to signal to Apache that
100             # we're now running in the background
101             close STDOUT;
102             close STDERR;
103         } else {
104             # fork failed, so exit immediately
105             # fork failed, so exit immediately
106             warn "fork failed while attempting to run $ENV{'SCRIPT_NAME'} as a background job";
107             exit 0;
108         }
109
110         # if we get here, we're a child that has detached
111         # itself from Apache
112
113     }
114
115     my $header_line = shift @input_lines;
116     my $file_info   = parse_header_line($header_line);
117     if ($file_info->{'Version'} ne $FILE_VERSION) {
118         push @output, {
119             message => 1,
120             ERROR_file_version => 1,
121             upload_version => $file_info->{'Version'},
122             current_version => $FILE_VERSION
123         };
124     }
125
126     my $i = 0;
127     foreach  my $line (@input_lines)  {
128         $i++;
129         my $command_line = parse_command_line($line);
130
131         # map command names in the file to subroutine names
132         my %dispatch_table = (
133             issue     => \&kocIssueItem,
134             'return'  => \&kocReturnItem,
135             payment   => \&kocMakePayment,
136         );
137
138         # call the right sub name, passing the hashref of command_line to it.
139         if ( exists $dispatch_table{ $command_line->{'command'} } ) {
140             $dispatch_table{ $command_line->{'command'} }->($command_line);
141         } else {
142             warn "unknown command: '$command_line->{command}' not processed";
143         }
144
145         if ($runinbackground) {
146             $job->progress($i);
147         }
148     }
149
150     if ($runinbackground) {
151         $job->finish({ results => \@output }) if defined($job);
152     } else {
153         $template->param(transactions_loaded => 1);
154         $template->param(messages => \@output);
155     }
156 }
157
158 output_html_with_http_headers $query, $cookie, $template->output;
159
160 =head1 FUNCTIONS
161
162 =head2 parse_header_line
163
164 parses the header line from a .koc file. This is the line that
165 specifies things such as the file version, and the name and version of
166 the offline circulation tool that generated the file. See
167 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
168 for more information.
169
170 pass in a string containing the header line (the first line from th
171 file).
172
173 returns a hashref containing the information from the header.
174
175 =cut
176
177 sub parse_header_line {
178     my $header_line = shift;
179     chomp($header_line);
180     $header_line =~ s/\r//g;
181
182     my @fields = split( /\t/, $header_line );
183     my %header_info = map { split( /=/, $_ ) } @fields;
184     return \%header_info;
185 }
186
187 =head2 parse_command_line
188
189 =cut
190
191 sub parse_command_line {
192     my $command_line = shift;
193     chomp($command_line);
194     $command_line =~ s/\r//g;
195
196     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
197     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
198
199     my %command = (
200         date    => $date,
201         time    => $time,
202         id      => $id,
203         command => $command,
204     );
205
206     # set the rest of the keys using a hash slice
207     my $argument_names = arguments_for_command($command);
208     @command{@$argument_names} = @args;
209
210     return \%command;
211
212 }
213
214 =head2 arguments_for_command
215
216 fetches the names of the columns (and function arguments) found in the
217 .koc file for a particular command name. For instance, the C<issue>
218 command requires a C<cardnumber> and C<barcode>. In that case this
219 function returns a reference to the list C<qw( cardnumber barcode )>.
220
221 parameters: the command name
222
223 returns: listref of column names.
224
225 =cut
226
227 sub arguments_for_command {
228     my $command = shift;
229
230     # define the fields for this version of the file.
231     my %format = (
232         issue   => [qw( cardnumber barcode )],
233         return  => [qw( barcode )],
234         payment => [qw( cardnumber amount )],
235     );
236
237     return $format{$command};
238 }
239
240 sub kocIssueItem {
241     my $circ = shift;
242
243     $circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
244     my $branchcode = C4::Context->userenv->{branch};
245     my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
246     my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
247     my $issue = GetItemIssue( $item->{'itemnumber'} );
248
249     if ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
250         #warn "Item Currently Issued.";
251         my $issue = GetOpenIssue( $item->{'itemnumber'} );
252
253         if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
254             #warn "Item issued to this member already, renewing.";
255
256             C4::Circulation::AddRenewal(
257                 $issue->{'borrowernumber'},    # borrowernumber
258                 $item->{'itemnumber'},         # itemnumber
259                 undef,                         # branch
260                 undef,                         # datedue - let AddRenewal calculate it automatically
261                 $circ->{'date'},               # issuedate
262             ) unless ($DEBUG);
263
264             push @output, {
265                 renew => 1,
266                 title => $item->{ 'title' },
267                 biblionumber => $item->{'biblionumber'},
268                 barcode => $item->{ 'barcode' },
269                 firstname => $borrower->{ 'firstname' },
270                 surname => $borrower->{ 'surname' },
271                 borrowernumber => $borrower->{'borrowernumber'},
272                 cardnumber => $borrower->{'cardnumber'},
273                 datetime => $circ->{ 'datetime' }
274             };
275
276         } else {
277             #warn "Item issued to a different member.";
278             #warn "Date of previous issue: $issue->{'issuedate'}";
279             #warn "Date of this issue: $circ->{'date'}";
280             my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
281             my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
282
283             if ( Date_to_Days( $i_y, $i_m, $i_d ) < Date_to_Days( $c_y, $c_m, $c_d ) ) { ## Current issue to a different persion is older than this issue, return and issue.
284                 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
285                 push @output, {
286                     issue => 1,
287                     title => $item->{ 'title' },
288                     biblionumber => $item->{'biblionumber'},
289                     barcode => $item->{ 'barcode' },
290                     firstname => $borrower->{ 'firstname' },
291                     surname => $borrower->{ 'surname' },
292                     borrowernumber => $borrower->{'borrowernumber'},
293                     cardnumber => $borrower->{'cardnumber'},
294                     datetime => $circ->{ 'datetime' }
295                 };
296
297             } else { ## Current issue is *newer* than this issue, write a 'returned' issue, as the item is most likely in the hands of someone else now.
298                 #warn "Current issue to another member is newer. Doing nothing";
299                 ## This situation should only happen of the Offline Circ data is *really* old.
300                 ## FIXME: write line to old_issues and statistics
301             }
302         }
303     } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
304         C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
305         push @output, {
306             issue => 1,
307             title => $item->{ 'title' },
308             biblionumber => $item->{'biblionumber'},
309             barcode => $item->{ 'barcode' },
310             firstname => $borrower->{ 'firstname' },
311             surname => $borrower->{ 'surname' },
312             borrowernumber => $borrower->{'borrowernumber'},
313             cardnumber => $borrower->{'cardnumber'},
314             datetime =>$circ->{ 'datetime' }
315         };
316     }
317 }
318
319 sub kocReturnItem {
320     my ( $circ ) = @_;
321     $circ->{'barcode'} = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
322     my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
323     #warn( Data::Dumper->Dump( [ $circ, $item ], [ qw( circ item ) ] ) );
324     my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
325     if ( $borrowernumber ) {
326         my $borrower = GetMember( 'borrowernumber' =>$borrowernumber );
327         C4::Circulation::MarkIssueReturned(
328             $borrowernumber,
329             $item->{'itemnumber'},
330             undef,
331             $circ->{'date'}
332         );
333
334         push @output, {
335             return => 1,
336             title => $item->{ 'title' },
337             biblionumber => $item->{'biblionumber'},
338             barcode => $item->{ 'barcode' },
339             borrowernumber => $borrower->{'borrowernumber'},
340             firstname => $borrower->{'firstname'},
341             surname => $borrower->{'surname'},
342             cardnumber => $borrower->{'cardnumber'},
343             datetime => $circ->{ 'datetime' }
344         };
345     } else {
346         push @output, {
347             ERROR_no_borrower_from_item => 1,
348             badbarcode => $circ->{'barcode'}
349         };
350     }
351 }
352
353 sub kocMakePayment {
354     my ( $circ ) = @_;
355     my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
356     recordpayment( $borrower->{'borrowernumber'}, $circ->{'amount'} );
357     push @output, {
358         payment => 1,
359         amount => $circ->{'amount'},
360         firstname => $borrower->{'firstname'},
361         surname => $borrower->{'surname'},
362         cardnumber => $circ->{'cardnumber'},
363         borrower => $borrower->{'borrowernumber'}
364     };
365 }
366
367 =head2 _get_borrowernumber_from_barcode
368
369 pass in a barcode
370 get back the borrowernumber of the patron who has it checked out.
371 undef if that can't be found
372
373 =cut
374
375 sub _get_borrowernumber_from_barcode {
376     my $barcode = shift;
377
378     return unless $barcode;
379
380     my $item = GetBiblioFromItemNumber( undef, $barcode );
381     return unless $item->{'itemnumber'};
382
383     my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
384     return unless $issue->{'borrowernumber'};
385     return $issue->{'borrowernumber'};
386 }