Bug 28704: Library MARCOrgCode field needs maxlength attribute
[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      flagsrequired   => { circulate => "circulate_remaining_permissions" },
56 });
57
58
59 my $fileID=$query->param('uploadedfileid');
60 my $runinbackground = $query->param('runinbackground');
61 my $completedJobID = $query->param('completedJobID');
62 my %cookies = parse CGI::Cookie($cookie);
63 my $sessionID = $cookies{'CGISESSID'}->value;
64 ## 'Local' globals.
65 our $dbh = C4::Context->dbh();
66 our @output = (); ## For storing messages to be displayed to the user
67
68
69 if ($completedJobID) {
70     my $job = C4::BackgroundJob->fetch($sessionID, $completedJobID);
71     my $results = $job->results();
72     $template->param(transactions_loaded => 1);
73     $template->param(messages => $results->{results});
74 } elsif ($fileID) {
75     my $upload = Koha::UploadedFiles->find( $fileID );
76     my $fh = $upload? $upload->file_handle: undef;
77     my $filename = $upload? $upload->filename: undef;
78     my @input_lines = $fh? <$fh>: ();
79     $fh->close if $fh;
80
81     my $job = undef;
82
83     if ($runinbackground) {
84         my $job_size = scalar(@input_lines);
85         $job = C4::BackgroundJob->new($sessionID, $filename, '/cgi-bin/koha/offline_circ/process_koc.pl', $job_size);
86         my $jobID = $job->id();
87
88         # fork off
89         if (my $pid = fork) {
90             # parent
91             # return job ID as JSON
92
93             # prevent parent exiting from
94             # destroying the kid's database handle
95             # FIXME: according to DBI doc, this may not work for Oracle
96             $dbh->{InactiveDestroy}  = 1;
97
98             my $reply = CGI->new("");
99             print $reply->header(-type => 'text/html');
100             print '{"jobID":"' . $jobID . '"}';
101             exit 0;
102         } elsif (defined $pid) {
103             # child
104             # close STDOUT to signal to Apache that
105             # we're now running in the background
106             close STDOUT;
107             close STDERR;
108         } else {
109             # fork failed, so exit immediately
110             # fork failed, so exit immediately
111             warn "fork failed while attempting to run offline_circ/process_koc.pl as a background job";
112             exit 0;
113         }
114
115         # if we get here, we're a child that has detached
116         # itself from Apache
117
118     }
119
120     my $header_line = shift @input_lines;
121     my $file_info   = parse_header_line($header_line);
122     if ($file_info->{'Version'} ne $FILE_VERSION) {
123         push @output, {
124             message => 1,
125             ERROR_file_version => 1,
126             upload_version => $file_info->{'Version'},
127             current_version => $FILE_VERSION
128         };
129     }
130
131     my $i = 0;
132     foreach  my $line (@input_lines)  {
133         $i++;
134         my $command_line = parse_command_line($line);
135
136         # map command names in the file to subroutine names
137         my %dispatch_table = (
138             issue     => \&kocIssueItem,
139             'return'  => \&kocReturnItem,
140             payment   => \&kocMakePayment,
141         );
142
143         # call the right sub name, passing the hashref of command_line to it.
144         if ( exists $dispatch_table{ $command_line->{'command'} } ) {
145             $dispatch_table{ $command_line->{'command'} }->($command_line);
146         } else {
147             warn "unknown command: '$command_line->{command}' not processed";
148         }
149
150         if ($runinbackground) {
151             $job->progress($i);
152         }
153     }
154
155     if ($runinbackground) {
156         $job->finish({ results => \@output }) if defined($job);
157     } else {
158         $template->param(transactions_loaded => 1);
159         $template->param(messages => \@output);
160     }
161 }
162
163 output_html_with_http_headers $query, $cookie, $template->output;
164
165 =head1 FUNCTIONS
166
167 =head2 parse_header_line
168
169 parses the header line from a .koc file. This is the line that
170 specifies things such as the file version, and the name and version of
171 the offline circulation tool that generated the file. See
172 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
173 for more information.
174
175 pass in a string containing the header line (the first line from th
176 file).
177
178 returns a hashref containing the information from the header.
179
180 =cut
181
182 sub parse_header_line {
183     my $header_line = shift;
184     chomp($header_line);
185     $header_line =~ s/\r//g;
186
187     my @fields = split( /\t/, $header_line );
188     my %header_info = map { split( /=/, $_ ) } @fields;
189     return \%header_info;
190 }
191
192 =head2 parse_command_line
193
194 =cut
195
196 sub parse_command_line {
197     my $command_line = shift;
198     chomp($command_line);
199     $command_line =~ s/\r//g;
200
201     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
202     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
203
204     my %command = (
205         date    => $date,
206         time    => $time,
207         id      => $id,
208         command => $command,
209     );
210
211     # set the rest of the keys using a hash slice
212     my $argument_names = arguments_for_command($command);
213     @command{@$argument_names} = @args;
214
215     return \%command;
216
217 }
218
219 =head2 arguments_for_command
220
221 fetches the names of the columns (and function arguments) found in the
222 .koc file for a particular command name. For instance, the C<issue>
223 command requires a C<cardnumber> and C<barcode>. In that case this
224 function returns a reference to the list C<qw( cardnumber barcode )>.
225
226 parameters: the command name
227
228 returns: listref of column names.
229
230 =cut
231
232 sub arguments_for_command {
233     my $command = shift;
234
235     # define the fields for this version of the file.
236     my %format = (
237         issue   => [qw( cardnumber barcode )],
238         return  => [qw( barcode )],
239         payment => [qw( cardnumber amount )],
240     );
241
242     return $format{$command};
243 }
244
245 sub kocIssueItem {
246     my $circ = shift;
247
248     $circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
249     my $branchcode = C4::Context->userenv->{branch};
250     my $patron = Koha::Patrons->find( { cardnumber => $circ->{cardnumber} } );
251     my $borrower = $patron->unblessed;
252     my $item = Koha::Items->find({ barcode => $circ->{barcode} });
253     my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
254     my $biblio = $item->biblio;
255
256     if ( $issue ) { ## Item is currently checked out to another person.
257         #warn "Item Currently Issued.";
258         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)
259
260         if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
261             #warn "Item issued to this member already, renewing.";
262
263             C4::Circulation::AddRenewal(
264                 $issue->{'borrowernumber'},    # borrowernumber
265                 $item->itemnumber,             # itemnumber
266                 undef,                         # branch
267                 undef,                         # datedue - let AddRenewal calculate it automatically
268                 $circ->{'date'},               # issuedate
269             ) unless ($DEBUG);
270
271             push @output, {
272                 renew => 1,
273                 title => $biblio->title,
274                 biblionumber => $biblio->biblionumber,
275                 barcode => $item->barcode,
276                 firstname => $borrower->{ 'firstname' },
277                 surname => $borrower->{ 'surname' },
278                 borrowernumber => $borrower->{'borrowernumber'},
279                 cardnumber => $borrower->{'cardnumber'},
280                 datetime => $circ->{ 'datetime' }
281             };
282
283         } else {
284             #warn "Item issued to a different member.";
285             #warn "Date of previous issue: $issue->{'issuedate'}";
286             #warn "Date of this issue: $circ->{'date'}";
287             my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
288             my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
289
290             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.
291                 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
292                 push @output, {
293                     issue => 1,
294                     title => $biblio->title,
295                     biblionumber => $biblio->biblionumber,
296                     barcode => $item->barcode,
297                     firstname => $borrower->{ 'firstname' },
298                     surname => $borrower->{ 'surname' },
299                     borrowernumber => $borrower->{'borrowernumber'},
300                     cardnumber => $borrower->{'cardnumber'},
301                     datetime => $circ->{ 'datetime' }
302                 };
303
304             } 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.
305                 #warn "Current issue to another member is newer. Doing nothing";
306                 ## This situation should only happen of the Offline Circ data is *really* old.
307                 ## FIXME: write line to old_issues and statistics
308             }
309         }
310     } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
311         C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
312         push @output, {
313             issue => 1,
314             title => $biblio->title,
315             biblionumber => $biblio->biblionumber,
316             barcode => $item->barcode,
317             firstname => $borrower->{ 'firstname' },
318             surname => $borrower->{ 'surname' },
319             borrowernumber => $borrower->{'borrowernumber'},
320             cardnumber => $borrower->{'cardnumber'},
321             datetime =>$circ->{ 'datetime' }
322         };
323     }
324 }
325
326 sub kocReturnItem {
327     my ( $circ ) = @_;
328     $circ->{'barcode'} = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
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 }