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 under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
35 use C4::BackgroundJob;
37 use Date::Calc qw( Add_Delta_Days Date_to_Days );
39 use constant DEBUG => 0;
41 # this is the file version number that we're coded against.
42 my $FILE_VERSION = '1.0';
44 our $query = CGI->new;
46 my ($template, $loggedinuser, $cookie) = get_template_and_user({
47 template_name => "offline_circ/process_koc.tmpl",
51 flagsrequired => { circulate => "circulate_remaining_permissions" },
55 my $fileID=$query->param('uploadedfileid');
56 my $runinbackground = $query->param('runinbackground');
57 my $completedJobID = $query->param('completedJobID');
58 my %cookies = parse CGI::Cookie($cookie);
59 my $sessionID = $cookies{'CGISESSID'}->value;
61 our $dbh = C4::Context->dbh();
62 our @output = (); ## For storing messages to be displayed to the user
65 if ($completedJobID) {
66 my $job = C4::BackgroundJob->fetch($sessionID, $completedJobID);
67 my $results = $job->results();
68 $template->param(transactions_loaded => 1);
69 $template->param(messages => $results->{results});
71 my $uploaded_file = C4::UploadedFile->fetch($sessionID, $fileID);
72 my $fh = $uploaded_file->fh();
73 my @input_lines = <$fh>;
75 my $filename = $uploaded_file->name();
78 if ($runinbackground) {
79 my $job_size = scalar(@input_lines);
80 $job = C4::BackgroundJob->new($sessionID, $filename, $ENV{'SCRIPT_NAME'}, $job_size);
81 my $jobID = $job->id();
86 # return job ID as JSON
88 # prevent parent exiting from
89 # destroying the kid's database handle
90 # FIXME: according to DBI doc, this may not work for Oracle
91 $dbh->{InactiveDestroy} = 1;
93 my $reply = CGI->new("");
94 print $reply->header(-type => 'text/html');
95 print '{"jobID":"' . $jobID . '"}';
97 } elsif (defined $pid) {
99 # close STDOUT to signal to Apache that
100 # we're now running in the background
104 # fork failed, so exit immediately
105 # fork failed, so exit immediately
106 warn "fork failed while attempting to run $ENV{'SCRIPT_NAME'} as a background job";
110 # if we get here, we're a child that has detached
115 my $header_line = shift @input_lines;
116 my $file_info = parse_header_line($header_line);
117 if ($file_info->{'Version'} ne $FILE_VERSION) {
120 ERROR_file_version => 1,
121 upload_version => $file_info->{'Version'},
122 current_version => $FILE_VERSION
127 foreach my $line (@input_lines) {
129 my $command_line = parse_command_line($line);
131 # map command names in the file to subroutine names
132 my %dispatch_table = (
133 issue => \&kocIssueItem,
134 'return' => \&kocReturnItem,
135 payment => \&kocMakePayment,
138 # call the right sub name, passing the hashref of command_line to it.
139 if ( exists $dispatch_table{ $command_line->{'command'} } ) {
140 $dispatch_table{ $command_line->{'command'} }->($command_line);
142 warn "unknown command: '$command_line->{command}' not processed";
145 if ($runinbackground) {
150 if ($runinbackground) {
151 $job->finish({ results => \@output }) if defined($job);
153 $template->param(transactions_loaded => 1);
154 $template->param(messages => \@output);
158 output_html_with_http_headers $query, $cookie, $template->output;
162 =head2 parse_header_line
164 parses the header line from a .koc file. This is the line that
165 specifies things such as the file version, and the name and version of
166 the offline circulation tool that generated the file. See
167 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
168 for more information.
170 pass in a string containing the header line (the first line from th
173 returns a hashref containing the information from the header.
177 sub parse_header_line {
178 my $header_line = shift;
180 $header_line =~ s/\r//g;
182 my @fields = split( /\t/, $header_line );
183 my %header_info = map { split( /=/, $_ ) } @fields;
184 return \%header_info;
187 =head2 parse_command_line
191 sub parse_command_line {
192 my $command_line = shift;
193 chomp($command_line);
194 $command_line =~ s/\r//g;
196 my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
197 my ( $date, $time, $id ) = split( /\s/, $timestamp );
206 # set the rest of the keys using a hash slice
207 my $argument_names = arguments_for_command($command);
208 @command{@$argument_names} = @args;
214 =head2 arguments_for_command
216 fetches the names of the columns (and function arguments) found in the
217 .koc file for a particular command name. For instance, the C<issue>
218 command requires a C<cardnumber> and C<barcode>. In that case this
219 function returns a reference to the list C<qw( cardnumber barcode )>.
221 parameters: the command name
223 returns: listref of column names.
227 sub arguments_for_command {
230 # define the fields for this version of the file.
232 issue => [qw( cardnumber barcode )],
233 return => [qw( barcode )],
234 payment => [qw( cardnumber amount )],
237 return $format{$command};
243 $circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
244 my $branchcode = C4::Context->userenv->{branch};
245 my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
246 my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
247 my $issue = GetItemIssue( $item->{'itemnumber'} );
249 if ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
250 #warn "Item Currently Issued.";
251 my $issue = GetOpenIssue( $item->{'itemnumber'} );
253 if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
254 #warn "Item issued to this member already, renewing.";
256 C4::Circulation::AddRenewal(
257 $issue->{'borrowernumber'}, # borrowernumber
258 $item->{'itemnumber'}, # itemnumber
260 undef, # datedue - let AddRenewal calculate it automatically
261 $circ->{'date'}, # issuedate
266 title => $item->{ 'title' },
267 biblionumber => $item->{'biblionumber'},
268 barcode => $item->{ 'barcode' },
269 firstname => $borrower->{ 'firstname' },
270 surname => $borrower->{ 'surname' },
271 borrowernumber => $borrower->{'borrowernumber'},
272 cardnumber => $borrower->{'cardnumber'},
273 datetime => $circ->{ 'datetime' }
277 #warn "Item issued to a different member.";
278 #warn "Date of previous issue: $issue->{'issuedate'}";
279 #warn "Date of this issue: $circ->{'date'}";
280 my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
281 my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
283 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.
284 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
287 title => $item->{ 'title' },
288 biblionumber => $item->{'biblionumber'},
289 barcode => $item->{ 'barcode' },
290 firstname => $borrower->{ 'firstname' },
291 surname => $borrower->{ 'surname' },
292 borrowernumber => $borrower->{'borrowernumber'},
293 cardnumber => $borrower->{'cardnumber'},
294 datetime => $circ->{ 'datetime' }
297 } 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.
298 #warn "Current issue to another member is newer. Doing nothing";
299 ## This situation should only happen of the Offline Circ data is *really* old.
300 ## FIXME: write line to old_issues and statistics
303 } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
304 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
307 title => $item->{ 'title' },
308 biblionumber => $item->{'biblionumber'},
309 barcode => $item->{ 'barcode' },
310 firstname => $borrower->{ 'firstname' },
311 surname => $borrower->{ 'surname' },
312 borrowernumber => $borrower->{'borrowernumber'},
313 cardnumber => $borrower->{'cardnumber'},
314 datetime =>$circ->{ 'datetime' }
321 $circ->{'barcode'} = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
322 my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
323 #warn( Data::Dumper->Dump( [ $circ, $item ], [ qw( circ item ) ] ) );
324 my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
325 if ( $borrowernumber ) {
326 my $borrower = GetMember( 'borrowernumber' =>$borrowernumber );
327 C4::Circulation::MarkIssueReturned(
329 $item->{'itemnumber'},
336 title => $item->{ 'title' },
337 biblionumber => $item->{'biblionumber'},
338 barcode => $item->{ 'barcode' },
339 borrowernumber => $borrower->{'borrowernumber'},
340 firstname => $borrower->{'firstname'},
341 surname => $borrower->{'surname'},
342 cardnumber => $borrower->{'cardnumber'},
343 datetime => $circ->{ 'datetime' }
347 ERROR_no_borrower_from_item => 1,
348 badbarcode => $circ->{'barcode'}
355 my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
356 recordpayment( $borrower->{'borrowernumber'}, $circ->{'amount'} );
359 amount => $circ->{'amount'},
360 firstname => $borrower->{'firstname'},
361 surname => $borrower->{'surname'},
362 cardnumber => $circ->{'cardnumber'},
363 borrower => $borrower->{'borrowernumber'}
367 =head2 _get_borrowernumber_from_barcode
370 get back the borrowernumber of the patron who has it checked out.
371 undef if that can't be found
375 sub _get_borrowernumber_from_barcode {
378 return unless $barcode;
380 my $item = GetBiblioFromItemNumber( undef, $barcode );
381 return unless $item->{'itemnumber'};
383 my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
384 return unless $issue->{'borrowernumber'};
385 return $issue->{'borrowernumber'};