3 # 2008 Kyle Hall <kyle.m.hall@gmail.com>
5 # This file is part of Koha.
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.
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.
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>.
37 use C4::BackgroundJob;
38 use Koha::UploadedFiles;
43 use Date::Calc qw( Add_Delta_Days Date_to_Days );
45 use constant DEBUG => 0;
47 # this is the file version number that we're coded against.
48 my $FILE_VERSION = '1.0';
50 our $query = CGI->new;
52 my ($template, $loggedinuser, $cookie) = get_template_and_user({
53 template_name => "offline_circ/process_koc.tt",
57 flagsrequired => { circulate => "circulate_remaining_permissions" },
61 my $fileID=$query->param('uploadedfileid');
62 my $runinbackground = $query->param('runinbackground');
63 my $completedJobID = $query->param('completedJobID');
64 my %cookies = parse CGI::Cookie($cookie);
65 my $sessionID = $cookies{'CGISESSID'}->value;
67 our $dbh = C4::Context->dbh();
68 our @output = (); ## For storing messages to be displayed to the user
71 if ($completedJobID) {
72 my $job = C4::BackgroundJob->fetch($sessionID, $completedJobID);
73 my $results = $job->results();
74 $template->param(transactions_loaded => 1);
75 $template->param(messages => $results->{results});
77 my $upload = Koha::UploadedFiles->find( $fileID );
78 my $fh = $upload? $upload->file_handle: undef;
79 my $filename = $upload? $upload->filename: undef;
80 my @input_lines = $fh? <$fh>: ();
85 if ($runinbackground) {
86 my $job_size = scalar(@input_lines);
87 $job = C4::BackgroundJob->new($sessionID, $filename, '/cgi-bin/koha/offline_circ/process_koc.pl', $job_size);
88 my $jobID = $job->id();
93 # return job ID as JSON
95 # prevent parent exiting from
96 # destroying the kid's database handle
97 # FIXME: according to DBI doc, this may not work for Oracle
98 $dbh->{InactiveDestroy} = 1;
100 my $reply = CGI->new("");
101 print $reply->header(-type => 'text/html');
102 print '{"jobID":"' . $jobID . '"}';
104 } elsif (defined $pid) {
106 # close STDOUT to signal to Apache that
107 # we're now running in the background
111 # fork failed, so exit immediately
112 # fork failed, so exit immediately
113 warn "fork failed while attempting to run offline_circ/process_koc.pl as a background job";
117 # if we get here, we're a child that has detached
122 my $header_line = shift @input_lines;
123 my $file_info = parse_header_line($header_line);
124 if ($file_info->{'Version'} ne $FILE_VERSION) {
127 ERROR_file_version => 1,
128 upload_version => $file_info->{'Version'},
129 current_version => $FILE_VERSION
134 foreach my $line (@input_lines) {
136 my $command_line = parse_command_line($line);
138 # map command names in the file to subroutine names
139 my %dispatch_table = (
140 issue => \&kocIssueItem,
141 'return' => \&kocReturnItem,
142 payment => \&kocMakePayment,
145 # call the right sub name, passing the hashref of command_line to it.
146 if ( exists $dispatch_table{ $command_line->{'command'} } ) {
147 $dispatch_table{ $command_line->{'command'} }->($command_line);
149 warn "unknown command: '$command_line->{command}' not processed";
152 if ($runinbackground) {
157 if ($runinbackground) {
158 $job->finish({ results => \@output }) if defined($job);
160 $template->param(transactions_loaded => 1);
161 $template->param(messages => \@output);
165 output_html_with_http_headers $query, $cookie, $template->output;
169 =head2 parse_header_line
171 parses the header line from a .koc file. This is the line that
172 specifies things such as the file version, and the name and version of
173 the offline circulation tool that generated the file. See
174 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
175 for more information.
177 pass in a string containing the header line (the first line from th
180 returns a hashref containing the information from the header.
184 sub parse_header_line {
185 my $header_line = shift;
187 $header_line =~ s/\r//g;
189 my @fields = split( /\t/, $header_line );
190 my %header_info = map { split( /=/, $_ ) } @fields;
191 return \%header_info;
194 =head2 parse_command_line
198 sub parse_command_line {
199 my $command_line = shift;
200 chomp($command_line);
201 $command_line =~ s/\r//g;
203 my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
204 my ( $date, $time, $id ) = split( /\s/, $timestamp );
213 # set the rest of the keys using a hash slice
214 my $argument_names = arguments_for_command($command);
215 @command{@$argument_names} = @args;
221 =head2 arguments_for_command
223 fetches the names of the columns (and function arguments) found in the
224 .koc file for a particular command name. For instance, the C<issue>
225 command requires a C<cardnumber> and C<barcode>. In that case this
226 function returns a reference to the list C<qw( cardnumber barcode )>.
228 parameters: the command name
230 returns: listref of column names.
234 sub arguments_for_command {
237 # define the fields for this version of the file.
239 issue => [qw( cardnumber barcode )],
240 return => [qw( barcode )],
241 payment => [qw( cardnumber amount )],
244 return $format{$command};
250 $circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
251 my $branchcode = C4::Context->userenv->{branch};
252 my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
253 my $item = Koha::Items->find({ barcode => $circ->{barcode} });
254 my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
255 my $biblio = $item->biblio;
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)
261 if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
262 #warn "Item issued to this member already, renewing.";
264 C4::Circulation::AddRenewal(
265 $issue->{'borrowernumber'}, # borrowernumber
266 $item->itemnumber, # itemnumber
268 undef, # datedue - let AddRenewal calculate it automatically
269 $circ->{'date'}, # issuedate
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' }
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'} );
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 );
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' }
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
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 );
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' }
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 $borrower = GetMember( 'borrowernumber' => $borrowernumber );
335 C4::Circulation::MarkIssueReturned(
340 $borrower->{'privacy'}
343 ModItem({ onloan => undef }, $biblio->biblionumber, $item->itemnumber);
344 ModDateLastSeen( $item->itemnumber );
348 title => $biblio->title,
349 biblionumber => $biblio->biblionumber,
350 barcode => $item->barcode,
351 borrowernumber => $borrower->{'borrowernumber'},
352 firstname => $borrower->{'firstname'},
353 surname => $borrower->{'surname'},
354 cardnumber => $borrower->{'cardnumber'},
355 datetime => $circ->{ 'datetime' }
359 ERROR_no_borrower_from_item => 1,
360 badbarcode => $circ->{'barcode'}
368 my $cardnumber = $circ->{cardnumber};
369 my $amount = $circ->{amount};
371 my $patron = Koha::Patrons->find( { cardnumber => $cardnumber } );
373 Koha::Account->new( { patron_id => $patron->id } )
374 ->pay( { amount => $amount } );
379 amount => $circ->{'amount'},
380 firstname => $patron->firstname,
381 surname => $patron->surname,
382 cardnumber => $patron->cardnumber,
383 borrower => $patron->id,
387 =head2 _get_borrowernumber_from_barcode
390 get back the borrowernumber of the patron who has it checked out.
391 undef if that can't be found
395 sub _get_borrowernumber_from_barcode {
398 return unless $barcode;
400 my $item = Koha::Items->find({ barcode => $barcode });
403 my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
404 return unless $issue;
405 return $issue->borrowernumber;