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