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