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)
47 = get_template_and_user( { 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) {
118 push( @output, { message => 1,
119 ERROR_file_version => 1,
120 upload_version => $file_info->{'Version'},
121 current_version => $FILE_VERSION
127 foreach my $line (@input_lines) {
130 my $command_line = parse_command_line($line);
132 # map command names in the file to subroutine names
133 my %dispatch_table = (
134 issue => \&kocIssueItem,
135 'return' => \&kocReturnItem,
136 payment => \&kocMakePayment,
139 # call the right sub name, passing the hashref of command_line to it.
140 if ( exists $dispatch_table{ $command_line->{'command'} } ) {
141 $dispatch_table{ $command_line->{'command'} }->($command_line);
143 warn "unknown command: '$command_line->{command}' not processed";
146 if ($runinbackground) {
151 if ($runinbackground) {
152 $job->finish({ results => \@output }) if defined($job);
154 $template->param(transactions_loaded => 1);
155 $template->param(messages => \@output);
159 output_html_with_http_headers $query, $cookie, $template->output;
161 =head3 parse_header_line
163 parses the header line from a .koc file. This is the line that
164 specifies things such as the file version, and the name and version of
165 the offline circulation tool that generated the file. See
166 L<http://wiki.koha.org/doku.php?id=koha_offline_circulation_file_format>
167 for more information.
169 pass in a string containing the header line (the first line from th
172 returns a hashref containing the information from the header.
176 sub parse_header_line {
177 my $header_line = shift;
180 my @fields = split( /\t/, $header_line );
181 my %header_info = map { split( /=/, $_ ) } @fields;
182 return \%header_info;
185 =head3 parse_command_line
189 sub parse_command_line {
190 my $command_line = shift;
191 chomp($command_line);
193 my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
194 my ( $date, $time, $id ) = split( /\s/, $timestamp );
203 # set the rest of the keys using a hash slice
204 my $argument_names = arguments_for_command($command);
205 @command{@$argument_names} = @args;
211 =head3 arguments_for_command
213 fetches the names of the columns (and function arguments) found in the
214 .koc file for a particular command name. For instance, the C<issue>
215 command requires a C<cardnumber> and C<barcode>. In that case this
216 function returns a reference to the list C<qw( cardnumber barcode )>.
218 parameters: the command name
220 returns: listref of column names.
224 sub arguments_for_command {
227 # define the fields for this version of the file.
229 issue => [qw( cardnumber barcode )],
230 return => [qw( barcode )],
231 payment => [qw( cardnumber amount )],
234 return $format{$command};
240 my $branchcode = C4::Context->userenv->{branch};
241 my $borrower = GetMember( $circ->{ 'cardnumber' }, 'cardnumber' );
242 my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
243 my $issue = GetItemIssue( $item->{'itemnumber'} );
245 my $issuingrule = GetIssuingRule( $borrower->{ 'categorycode' }, $item->{ 'itemtype' }, $branchcode );
246 my $issuelength = $issuingrule->{ 'issuelength' };
247 my ( $year, $month, $day ) = split( /-/, $circ->{'date'} );
248 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, $issuelength );
249 my $date_due = sprintf("%04d-%02d-%02d", $year, $month, $day);
251 if ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
252 #warn "Item Currently Issued.";
253 my $issue = GetOpenIssue( $item->{'itemnumber'} );
255 if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
256 #warn "Item issued to this member already, renewing.";
258 my $date_due_object = C4::Dates->new($date_due ,'iso');
259 C4::Circulation::AddRenewal(
260 $issue->{'borrowernumber'}, # borrowernumber
261 $item->{'itemnumber'}, # itemnumber
263 $date_due_object, # datedue
264 $circ->{'date'}, # issuedate
267 push( @output, { renew => 1,
268 title => $item->{ 'title' },
269 biblionumber => $item->{'biblionumber'},
270 barcode => $item->{ 'barcode' },
271 firstname => $borrower->{ 'firstname' },
272 surname => $borrower->{ 'surname' },
273 borrowernumber => $borrower->{'borrowernumber'},
274 cardnumber => $borrower->{'cardnumber'},
275 datetime => $circ->{ 'datetime' }
279 #warn "Item issued to a different member.";
280 #warn "Date of previous issue: $issue->{'issuedate'}";
281 #warn "Date of this issue: $circ->{'date'}";
282 my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
283 my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
285 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.
286 my $date_due_object = C4::Dates->new($date_due ,'iso');
287 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due_object ) unless ( DEBUG );
288 push( @output, { issue => 1,
289 title => $item->{ 'title' },
290 biblionumber => $item->{'biblionumber'},
291 barcode => $item->{ 'barcode' },
292 firstname => $borrower->{ 'firstname' },
293 surname => $borrower->{ 'surname' },
294 borrowernumber => $borrower->{'borrowernumber'},
295 cardnumber => $borrower->{'cardnumber'},
296 datetime => $circ->{ 'datetime' }
299 } 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.
300 #warn "Current issue to another member is newer. Doing nothing";
301 ## This situation should only happen of the Offline Circ data is *really* old.
302 ## FIXME: write line to old_issues and statistics
306 } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
307 my $date_due_object = C4::Dates->new($date_due ,'iso');
308 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due_object ) unless ( DEBUG );
309 push( @output, { issue => 1,
310 title => $item->{ 'title' },
311 biblionumber => $item->{'biblionumber'},
312 barcode => $item->{ 'barcode' },
313 firstname => $borrower->{ 'firstname' },
314 surname => $borrower->{ 'surname' },
315 borrowernumber => $borrower->{'borrowernumber'},
316 cardnumber => $borrower->{'cardnumber'},
317 datetime =>$circ->{ 'datetime' }
324 my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
325 #warn( Data::Dumper->Dump( [ $circ, $item ], [ qw( circ item ) ] ) );
326 my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
327 if ( $borrowernumber ) {
328 my $borrower = GetMember( $borrowernumber, 'borrowernumber' );
329 C4::Circulation::MarkIssueReturned( $borrowernumber,
330 $item->{'itemnumber'},
334 push( @output, { return => 1,
335 title => $item->{ 'title' },
336 biblionumber => $item->{'biblionumber'},
337 barcode => $item->{ 'barcode' },
338 borrowernumber => $borrower->{'borrowernumber'},
339 firstname => $borrower->{'firstname'},
340 surname => $borrower->{'surname'},
341 cardnumber => $borrower->{'cardnumber'},
342 datetime => $circ->{ 'datetime' }
345 push( @output, { ERROR_no_borrower_from_item => 1,
346 badbarcode => $circ->{'barcode'}
355 my $borrower = GetMember( $circ->{ 'cardnumber' }, 'cardnumber' );
356 recordpayment( $borrower->{'borrowernumber'}, $circ->{'amount'} );
357 push( @output, { payment => 1,
358 amount => $circ->{'amount'},
359 firstname => $borrower->{'firstname'},
360 surname => $borrower->{'surname'},
361 cardnumber => $circ->{'cardnumber'},
362 borrower => $borrower->{'borrowernumber'}
366 =head3 _get_borrowernumber_from_barcode
369 get back the borrowernumber of the patron who has it checked out.
370 undef if that can't be found
374 sub _get_borrowernumber_from_barcode {
377 return unless $barcode;
379 my $item = GetBiblioFromItemNumber( undef, $barcode );
380 return unless $item->{'itemnumber'};
382 my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
383 return unless $issue->{'borrowernumber'};
384 return $issue->{'borrowernumber'};