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>.
25 use C4::Output qw( output_html_with_http_headers );
26 use C4::Auth qw( get_template_and_user );
29 use C4::Circulation qw( barcodedecode GetOpenIssue AddRenewal AddIssue MarkIssueReturned );
30 use C4::Items qw( ModDateLastSeen );
33 use C4::BackgroundJob;
34 use Koha::UploadedFiles;
39 use Date::Calc qw( Date_to_Days );
41 use constant DEBUG => 0;
43 # this is the file version number that we're coded against.
44 my $FILE_VERSION = '1.0';
46 our $query = CGI->new;
48 my ($template, $loggedinuser, $cookie) = get_template_and_user({
49 template_name => "offline_circ/process_koc.tt",
52 flagsrequired => { circulate => "circulate_remaining_permissions" },
56 my $fileID=$query->param('uploadedfileid');
57 my $runinbackground = $query->param('runinbackground');
58 my $completedJobID = $query->param('completedJobID');
59 my %cookies = CGI::Cookie->fetch();
60 my $sessionID = $cookies{'CGISESSID'}->value;
62 our $dbh = C4::Context->dbh();
63 our @output = (); ## For storing messages to be displayed to the user
66 if ($completedJobID) {
67 my $job = C4::BackgroundJob->fetch($sessionID, $completedJobID);
68 my $results = $job->results();
69 $template->param(transactions_loaded => 1);
70 $template->param(messages => $results->{results});
72 my $upload = Koha::UploadedFiles->find( $fileID );
73 my $fh = $upload? $upload->file_handle: undef;
74 my $filename = $upload? $upload->filename: undef;
75 my @input_lines = $fh? <$fh>: ();
80 if ($runinbackground) {
81 my $job_size = scalar(@input_lines);
82 $job = C4::BackgroundJob->new($sessionID, $filename, '/cgi-bin/koha/offline_circ/process_koc.pl', $job_size);
83 my $jobID = $job->id();
88 # return job ID as JSON
90 # prevent parent exiting from
91 # destroying the kid's database handle
92 # FIXME: according to DBI doc, this may not work for Oracle
93 $dbh->{InactiveDestroy} = 1;
95 my $reply = CGI->new("");
96 print $reply->header(-type => 'text/html');
97 print '{"jobID":"' . $jobID . '"}';
99 } elsif (defined $pid) {
101 # close STDOUT to signal to Apache that
102 # we're now running in the background
106 # fork failed, so exit immediately
107 # fork failed, so exit immediately
108 warn "fork failed while attempting to run offline_circ/process_koc.pl as a background job";
112 # if we get here, we're a child that has detached
117 my $header_line = shift @input_lines;
118 my $file_info = parse_header_line($header_line);
119 if ($file_info->{'Version'} ne $FILE_VERSION) {
122 ERROR_file_version => 1,
123 upload_version => $file_info->{'Version'},
124 current_version => $FILE_VERSION
129 foreach my $line (@input_lines) {
131 my $command_line = parse_command_line($line);
133 # map command names in the file to subroutine names
134 my %dispatch_table = (
135 issue => \&kocIssueItem,
136 'return' => \&kocReturnItem,
137 payment => \&kocMakePayment,
140 # call the right sub name, passing the hashref of command_line to it.
141 if ( exists $dispatch_table{ $command_line->{'command'} } ) {
142 $dispatch_table{ $command_line->{'command'} }->($command_line);
144 warn "unknown command: '$command_line->{command}' not processed";
147 if ($runinbackground) {
152 if ($runinbackground) {
153 $job->finish({ results => \@output }) if defined($job);
155 $template->param(transactions_loaded => 1);
156 $template->param(messages => \@output);
160 output_html_with_http_headers $query, $cookie, $template->output;
164 =head2 parse_header_line
166 parses the header line from a .koc file. This is the line that
167 specifies things such as the file version, and the name and version of
168 the offline circulation tool that generated the file. See
169 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
170 for more information.
172 pass in a string containing the header line (the first line from th
175 returns a hashref containing the information from the header.
179 sub parse_header_line {
180 my $header_line = shift;
182 $header_line =~ s/\r//g;
184 my @fields = split( /\t/, $header_line );
185 my %header_info = map { split( /=/, $_ ) } @fields;
186 return \%header_info;
189 =head2 parse_command_line
193 sub parse_command_line {
194 my $command_line = shift;
195 chomp($command_line);
196 $command_line =~ s/\r//g;
198 my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
199 my ( $date, $time, $id ) = split( /\s/, $timestamp );
208 # set the rest of the keys using a hash slice
209 my $argument_names = arguments_for_command($command);
210 @command{@$argument_names} = @args;
216 =head2 arguments_for_command
218 fetches the names of the columns (and function arguments) found in the
219 .koc file for a particular command name. For instance, the C<issue>
220 command requires a C<cardnumber> and C<barcode>. In that case this
221 function returns a reference to the list C<qw( cardnumber barcode )>.
223 parameters: the command name
225 returns: listref of column names.
229 sub arguments_for_command {
232 # define the fields for this version of the file.
234 issue => [qw( cardnumber barcode )],
235 return => [qw( barcode )],
236 payment => [qw( cardnumber amount )],
239 return $format{$command};
245 $circ->{barcode} = barcodedecode( $circ->{barcode} ) if $circ->{barcode};
247 my $branchcode = C4::Context->userenv->{branch};
248 my $patron = Koha::Patrons->find( { cardnumber => $circ->{cardnumber} } );
249 my $borrower = $patron->unblessed;
250 my $item = Koha::Items->find({ barcode => $circ->{barcode} });
251 my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
252 my $biblio = $item->biblio;
254 if ( $issue ) { ## Item is currently checked out to another person.
255 #warn "Item Currently Issued.";
256 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)
258 if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
259 #warn "Item issued to this member already, renewing.";
261 C4::Circulation::AddRenewal(
262 $issue->{'borrowernumber'}, # borrowernumber
263 $item->itemnumber, # itemnumber
265 undef, # datedue - let AddRenewal calculate it automatically
266 $circ->{'date'}, # issuedate
271 title => $biblio->title,
272 biblionumber => $biblio->biblionumber,
273 barcode => $item->barcode,
274 firstname => $borrower->{ 'firstname' },
275 surname => $borrower->{ 'surname' },
276 borrowernumber => $borrower->{'borrowernumber'},
277 cardnumber => $borrower->{'cardnumber'},
278 datetime => $circ->{ 'datetime' }
282 #warn "Item issued to a different member.";
283 #warn "Date of previous issue: $issue->{'issuedate'}";
284 #warn "Date of this issue: $circ->{'date'}";
285 my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
286 my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
288 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.
289 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
292 title => $biblio->title,
293 biblionumber => $biblio->biblionumber,
294 barcode => $item->barcode,
295 firstname => $borrower->{ 'firstname' },
296 surname => $borrower->{ 'surname' },
297 borrowernumber => $borrower->{'borrowernumber'},
298 cardnumber => $borrower->{'cardnumber'},
299 datetime => $circ->{ 'datetime' }
302 } 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.
303 #warn "Current issue to another member is newer. Doing nothing";
304 ## This situation should only happen of the Offline Circ data is *really* old.
305 ## FIXME: write line to old_issues and statistics
308 } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
309 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
312 title => $biblio->title,
313 biblionumber => $biblio->biblionumber,
314 barcode => $item->barcode,
315 firstname => $borrower->{ 'firstname' },
316 surname => $borrower->{ 'surname' },
317 borrowernumber => $borrower->{'borrowernumber'},
318 cardnumber => $borrower->{'cardnumber'},
319 datetime =>$circ->{ 'datetime' }
327 $circ->{barcode} = barcodedecode( $circ->{barcode} ) if $circ->{barcode};
329 my $item = Koha::Items->find({ barcode => $circ->{barcode} });
330 my $biblio = $item->biblio;
331 my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
332 if ( $borrowernumber ) {
333 my $patron = Koha::Patrons->find( $borrowernumber );
334 C4::Circulation::MarkIssueReturned(
341 $item->onloan(undef)->store;
342 ModDateLastSeen( $item->itemnumber );
347 title => $biblio->title,
348 biblionumber => $biblio->biblionumber,
349 barcode => $item->barcode,
350 borrowernumber => $patron->borrowernumber,
351 firstname => $patron->firstname,
352 surname => $patron->surname,
353 cardnumber => $patron->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, interface => C4::Context->interface } );
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 = Koha::Items->find({ barcode => $barcode });
402 my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
403 return unless $issue;
404 return $issue->borrowernumber;