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 = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
254 my $issue = Koha::Checkouts->find( { itemnumber => $item->{itemnumber} } );
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)
260 if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
261 #warn "Item issued to this member already, renewing.";
263 C4::Circulation::AddRenewal(
264 $issue->{'borrowernumber'}, # borrowernumber
265 $item->{'itemnumber'}, # itemnumber
267 undef, # datedue - let AddRenewal calculate it automatically
268 $circ->{'date'}, # issuedate
273 title => $item->{ 'title' },
274 biblionumber => $item->{'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' }
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'} );
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 );
294 title => $item->{ 'title' },
295 biblionumber => $item->{'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' }
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
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 );
314 title => $item->{ 'title' },
315 biblionumber => $item->{'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' }
328 $circ->{'barcode'} = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
329 my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
330 #warn( Data::Dumper->Dump( [ $circ, $item ], [ qw( circ item ) ] ) );
331 my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
332 if ( $borrowernumber ) {
333 my $borrower = GetMember( 'borrowernumber' => $borrowernumber );
334 C4::Circulation::MarkIssueReturned(
336 $item->{'itemnumber'},
339 $borrower->{'privacy'}
342 ModItem({ onloan => undef }, $item->{'biblionumber'}, $item->{'itemnumber'});
343 ModDateLastSeen( $item->{'itemnumber'} );
347 title => $item->{ 'title' },
348 biblionumber => $item->{'biblionumber'},
349 barcode => $item->{ 'barcode' },
350 borrowernumber => $borrower->{'borrowernumber'},
351 firstname => $borrower->{'firstname'},
352 surname => $borrower->{'surname'},
353 cardnumber => $borrower->{'cardnumber'},
354 datetime => $circ->{ 'datetime' }
358 ERROR_no_borrower_from_item => 1,
359 badbarcode => $circ->{'barcode'}
367 my $cardnumber = $circ->{cardnumber};
368 my $amount = $circ->{amount};
370 my $patron = Koha::Patrons->find( { cardnumber => $cardnumber } );
372 Koha::Account->new( { patron_id => $patron->id } )
373 ->pay( { amount => $amount } );
378 amount => $circ->{'amount'},
379 firstname => $patron->firstname,
380 surname => $patron->surname,
381 cardnumber => $patron->cardnumber,
382 borrower => $patron->id,
386 =head2 _get_borrowernumber_from_barcode
389 get back the borrowernumber of the patron who has it checked out.
390 undef if that can't be found
394 sub _get_borrowernumber_from_barcode {
397 return unless $barcode;
399 my $item = GetBiblioFromItemNumber( undef, $barcode );
400 return unless $item->{'itemnumber'};
402 my $issue = Koha::Checkouts->find( { itemnumber => $item->{itemnumber} } );
403 return unless $issue;
404 return $issue->borrowernumber;