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;
41 use Date::Calc qw( Add_Delta_Days Date_to_Days );
43 use constant DEBUG => 0;
45 # this is the file version number that we're coded against.
46 my $FILE_VERSION = '1.0';
48 our $query = CGI->new;
50 my ($template, $loggedinuser, $cookie) = get_template_and_user({
51 template_name => "offline_circ/process_koc.tt",
55 flagsrequired => { circulate => "circulate_remaining_permissions" },
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;
65 our $dbh = C4::Context->dbh();
66 our @output = (); ## For storing messages to be displayed to the user
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});
75 my $upload = Koha::Upload->new->get({ id => $fileID, filehandle => 1 });
76 my $fh = $upload->{fh};
77 my $filename = $upload->{name};
78 my @input_lines = <$fh>;
82 if ($runinbackground) {
83 my $job_size = scalar(@input_lines);
84 $job = C4::BackgroundJob->new($sessionID, $filename, '/cgi-bin/koha/offline_circ/process_koc.pl', $job_size);
85 my $jobID = $job->id();
90 # return job ID as JSON
92 # prevent parent exiting from
93 # destroying the kid's database handle
94 # FIXME: according to DBI doc, this may not work for Oracle
95 $dbh->{InactiveDestroy} = 1;
97 my $reply = CGI->new("");
98 print $reply->header(-type => 'text/html');
99 print '{"jobID":"' . $jobID . '"}';
101 } elsif (defined $pid) {
103 # close STDOUT to signal to Apache that
104 # we're now running in the background
108 # fork failed, so exit immediately
109 # fork failed, so exit immediately
110 warn "fork failed while attempting to run offline_circ/process_koc.pl as a background job";
114 # if we get here, we're a child that has detached
119 my $header_line = shift @input_lines;
120 my $file_info = parse_header_line($header_line);
121 if ($file_info->{'Version'} ne $FILE_VERSION) {
124 ERROR_file_version => 1,
125 upload_version => $file_info->{'Version'},
126 current_version => $FILE_VERSION
131 foreach my $line (@input_lines) {
133 my $command_line = parse_command_line($line);
135 # map command names in the file to subroutine names
136 my %dispatch_table = (
137 issue => \&kocIssueItem,
138 'return' => \&kocReturnItem,
139 payment => \&kocMakePayment,
142 # call the right sub name, passing the hashref of command_line to it.
143 if ( exists $dispatch_table{ $command_line->{'command'} } ) {
144 $dispatch_table{ $command_line->{'command'} }->($command_line);
146 warn "unknown command: '$command_line->{command}' not processed";
149 if ($runinbackground) {
154 if ($runinbackground) {
155 $job->finish({ results => \@output }) if defined($job);
157 $template->param(transactions_loaded => 1);
158 $template->param(messages => \@output);
162 output_html_with_http_headers $query, $cookie, $template->output;
166 =head2 parse_header_line
168 parses the header line from a .koc file. This is the line that
169 specifies things such as the file version, and the name and version of
170 the offline circulation tool that generated the file. See
171 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
172 for more information.
174 pass in a string containing the header line (the first line from th
177 returns a hashref containing the information from the header.
181 sub parse_header_line {
182 my $header_line = shift;
184 $header_line =~ s/\r//g;
186 my @fields = split( /\t/, $header_line );
187 my %header_info = map { split( /=/, $_ ) } @fields;
188 return \%header_info;
191 =head2 parse_command_line
195 sub parse_command_line {
196 my $command_line = shift;
197 chomp($command_line);
198 $command_line =~ s/\r//g;
200 my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
201 my ( $date, $time, $id ) = split( /\s/, $timestamp );
210 # set the rest of the keys using a hash slice
211 my $argument_names = arguments_for_command($command);
212 @command{@$argument_names} = @args;
218 =head2 arguments_for_command
220 fetches the names of the columns (and function arguments) found in the
221 .koc file for a particular command name. For instance, the C<issue>
222 command requires a C<cardnumber> and C<barcode>. In that case this
223 function returns a reference to the list C<qw( cardnumber barcode )>.
225 parameters: the command name
227 returns: listref of column names.
231 sub arguments_for_command {
234 # define the fields for this version of the file.
236 issue => [qw( cardnumber barcode )],
237 return => [qw( barcode )],
238 payment => [qw( cardnumber amount )],
241 return $format{$command};
247 $circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
248 my $branchcode = C4::Context->userenv->{branch};
249 my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
250 my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
251 my $issue = GetItemIssue( $item->{'itemnumber'} );
253 if ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
254 #warn "Item Currently Issued.";
255 my $issue = GetOpenIssue( $item->{'itemnumber'} );
257 if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
258 #warn "Item issued to this member already, renewing.";
260 C4::Circulation::AddRenewal(
261 $issue->{'borrowernumber'}, # borrowernumber
262 $item->{'itemnumber'}, # itemnumber
264 undef, # datedue - let AddRenewal calculate it automatically
265 $circ->{'date'}, # issuedate
270 title => $item->{ 'title' },
271 biblionumber => $item->{'biblionumber'},
272 barcode => $item->{ 'barcode' },
273 firstname => $borrower->{ 'firstname' },
274 surname => $borrower->{ 'surname' },
275 borrowernumber => $borrower->{'borrowernumber'},
276 cardnumber => $borrower->{'cardnumber'},
277 datetime => $circ->{ 'datetime' }
281 #warn "Item issued to a different member.";
282 #warn "Date of previous issue: $issue->{'issuedate'}";
283 #warn "Date of this issue: $circ->{'date'}";
284 my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
285 my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
287 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.
288 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
291 title => $item->{ 'title' },
292 biblionumber => $item->{'biblionumber'},
293 barcode => $item->{ 'barcode' },
294 firstname => $borrower->{ 'firstname' },
295 surname => $borrower->{ 'surname' },
296 borrowernumber => $borrower->{'borrowernumber'},
297 cardnumber => $borrower->{'cardnumber'},
298 datetime => $circ->{ 'datetime' }
301 } 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.
302 #warn "Current issue to another member is newer. Doing nothing";
303 ## This situation should only happen of the Offline Circ data is *really* old.
304 ## FIXME: write line to old_issues and statistics
307 } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
308 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
311 title => $item->{ 'title' },
312 biblionumber => $item->{'biblionumber'},
313 barcode => $item->{ 'barcode' },
314 firstname => $borrower->{ 'firstname' },
315 surname => $borrower->{ 'surname' },
316 borrowernumber => $borrower->{'borrowernumber'},
317 cardnumber => $borrower->{'cardnumber'},
318 datetime =>$circ->{ 'datetime' }
325 $circ->{'barcode'} = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
326 my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
327 #warn( Data::Dumper->Dump( [ $circ, $item ], [ qw( circ item ) ] ) );
328 my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
329 if ( $borrowernumber ) {
330 my $borrower = GetMember( 'borrowernumber' => $borrowernumber );
331 C4::Circulation::MarkIssueReturned(
333 $item->{'itemnumber'},
336 $borrower->{'privacy'}
339 ModItem({ onloan => undef }, $item->{'biblionumber'}, $item->{'itemnumber'});
340 ModDateLastSeen( $item->{'itemnumber'} );
344 title => $item->{ 'title' },
345 biblionumber => $item->{'biblionumber'},
346 barcode => $item->{ 'barcode' },
347 borrowernumber => $borrower->{'borrowernumber'},
348 firstname => $borrower->{'firstname'},
349 surname => $borrower->{'surname'},
350 cardnumber => $borrower->{'cardnumber'},
351 datetime => $circ->{ 'datetime' }
355 ERROR_no_borrower_from_item => 1,
356 badbarcode => $circ->{'barcode'}
364 my $cardnumber = $circ->{cardnumber};
365 my $amount = $circ->{amount};
367 my $patron = Koha::Borrowers->find( { cardnumber => $cardnumber } );
369 Koha::Account->new( { patron_id => $patron->id } )
370 ->pay( { amount => $amount } );
375 amount => $circ->{'amount'},
376 firstname => $patron->firstname,
377 surname => $patron->surname,
378 cardnumber => $patron->cardnumber,
379 borrower => $patron->id,
383 =head2 _get_borrowernumber_from_barcode
386 get back the borrowernumber of the patron who has it checked out.
387 undef if that can't be found
391 sub _get_borrowernumber_from_barcode {
394 return unless $barcode;
396 my $item = GetBiblioFromItemNumber( undef, $barcode );
397 return unless $item->{'itemnumber'};
399 my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
400 return unless $issue->{'borrowernumber'};
401 return $issue->{'borrowernumber'};