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 );
28 use C4::Circulation qw( barcodedecode AddRenewal AddIssue MarkIssueReturned );
29 use C4::Items qw( ModDateLastSeen );
30 use Koha::UploadedFiles;
35 use Date::Calc qw( Date_to_Days );
37 use constant DEBUG => 0;
39 # this is the file version number that we're coded against.
40 my $FILE_VERSION = '1.0';
42 our $query = CGI->new;
44 my ($template, $loggedinuser, $cookie) = get_template_and_user({
45 template_name => "offline_circ/process_koc.tt",
48 flagsrequired => { circulate => "circulate_remaining_permissions" },
52 my $fileID=$query->param('uploadedfileid');
53 my $op = $query->param('op') || q{};
54 my %cookies = CGI::Cookie->fetch();
55 my $sessionID = $cookies{'CGISESSID'}->value;
57 our $dbh = C4::Context->dbh();
58 our @output = (); ## For storing messages to be displayed to the user
60 if ( $op eq 'add_to_queue' ) {
61 $template->param(transactions_loaded => 1);
63 my $upload = Koha::UploadedFiles->find( $fileID );
64 my $fh = $upload? $upload->file_handle: undef;
65 my $filename = $upload? $upload->filename: undef;
66 my @input_lines = $fh? <$fh>: ();
69 my $header_line = shift @input_lines;
70 my $file_info = parse_header_line($header_line);
71 if ($file_info->{'Version'} ne $FILE_VERSION) {
74 ERROR_file_version => 1,
75 upload_version => $file_info->{'Version'},
76 current_version => $FILE_VERSION
81 foreach my $line (@input_lines) {
83 my $command_line = parse_command_line($line);
85 # map command names in the file to subroutine names
86 my %dispatch_table = (
87 issue => \&kocIssueItem,
88 'return' => \&kocReturnItem,
89 payment => \&kocMakePayment,
92 # call the right sub name, passing the hashref of command_line to it.
93 if ( exists $dispatch_table{ $command_line->{'command'} } ) {
94 $dispatch_table{ $command_line->{'command'} }->($command_line);
96 warn "unknown command: '$command_line->{command}' not processed";
100 $template->param(transactions_loaded => 1);
101 $template->param(messages => \@output);
104 output_html_with_http_headers $query, $cookie, $template->output;
108 =head2 parse_header_line
110 parses the header line from a .koc file. This is the line that
111 specifies things such as the file version, and the name and version of
112 the offline circulation tool that generated the file. See
113 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
114 for more information.
116 pass in a string containing the header line (the first line from th
119 returns a hashref containing the information from the header.
123 sub parse_header_line {
124 my $header_line = shift;
126 $header_line =~ s/\r//g;
128 my @fields = split( /\t/, $header_line );
129 my %header_info = map { split( /=/, $_ ) } @fields;
130 return \%header_info;
133 =head2 parse_command_line
137 sub parse_command_line {
138 my $command_line = shift;
139 chomp($command_line);
140 $command_line =~ s/\r//g;
142 my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
143 my ( $date, $time, $id ) = split( /\s/, $timestamp );
152 # set the rest of the keys using a hash slice
153 my $argument_names = arguments_for_command($command);
154 @command{@$argument_names} = @args;
160 =head2 arguments_for_command
162 fetches the names of the columns (and function arguments) found in the
163 .koc file for a particular command name. For instance, the C<issue>
164 command requires a C<cardnumber> and C<barcode>. In that case this
165 function returns a reference to the list C<qw( cardnumber barcode )>.
167 parameters: the command name
169 returns: listref of column names.
173 sub arguments_for_command {
176 # define the fields for this version of the file.
178 issue => [qw( cardnumber barcode )],
179 return => [qw( barcode )],
180 payment => [qw( cardnumber amount )],
183 return $format{$command};
189 $circ->{barcode} = barcodedecode( $circ->{barcode} ) if $circ->{barcode};
191 my $branchcode = C4::Context->userenv->{branch};
192 my $patron = Koha::Patrons->find( { cardnumber => $circ->{cardnumber} } );
193 my $borrower = $patron->unblessed;
194 my $item = Koha::Items->find({ barcode => $circ->{barcode} });
195 my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
196 my $biblio = $item->biblio;
198 if ( $issue ) { ## Item is currently checked out to another person.
199 #warn "Item Currently Issued.";
201 if ( $issue->borrowernumber eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
202 #warn "Item issued to this member already, renewing.";
204 C4::Circulation::AddRenewal(
206 borrowernumber => $issue->borrowernumber,
207 itemnumber => $item->itemnumber,
208 lastreneweddate => $circ->{'date'},
214 title => $biblio->title,
215 biblionumber => $biblio->biblionumber,
216 barcode => $item->barcode,
217 firstname => $borrower->{ 'firstname' },
218 surname => $borrower->{ 'surname' },
219 borrowernumber => $borrower->{'borrowernumber'},
220 cardnumber => $borrower->{'cardnumber'},
221 datetime => $circ->{ 'datetime' }
225 #warn "Item issued to a different member.";
226 #warn "Date of previous issue: $issue->issuedate";
227 #warn "Date of this issue: $circ->{'date'}";
228 my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->issuedate );
229 my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
231 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.
232 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
235 title => $biblio->title,
236 biblionumber => $biblio->biblionumber,
237 barcode => $item->barcode,
238 firstname => $borrower->{ 'firstname' },
239 surname => $borrower->{ 'surname' },
240 borrowernumber => $borrower->{'borrowernumber'},
241 cardnumber => $borrower->{'cardnumber'},
242 datetime => $circ->{ 'datetime' }
245 } 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.
246 #warn "Current issue to another member is newer. Doing nothing";
247 ## This situation should only happen of the Offline Circ data is *really* old.
248 ## FIXME: write line to old_issues and statistics
251 } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
252 C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
255 title => $biblio->title,
256 biblionumber => $biblio->biblionumber,
257 barcode => $item->barcode,
258 firstname => $borrower->{ 'firstname' },
259 surname => $borrower->{ 'surname' },
260 borrowernumber => $borrower->{'borrowernumber'},
261 cardnumber => $borrower->{'cardnumber'},
262 datetime =>$circ->{ 'datetime' }
270 $circ->{barcode} = barcodedecode( $circ->{barcode} ) if $circ->{barcode};
272 my $item = Koha::Items->find({ barcode => $circ->{barcode} });
273 my $biblio = $item->biblio;
274 my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
275 if ( $borrowernumber ) {
276 my $patron = Koha::Patrons->find( $borrowernumber );
277 C4::Circulation::MarkIssueReturned(
284 $item->onloan(undef)->store;
285 ModDateLastSeen( $item->itemnumber );
290 title => $biblio->title,
291 biblionumber => $biblio->biblionumber,
292 barcode => $item->barcode,
293 borrowernumber => $patron->borrowernumber,
294 firstname => $patron->firstname,
295 surname => $patron->surname,
296 cardnumber => $patron->cardnumber,
297 datetime => $circ->{'datetime'}
301 ERROR_no_borrower_from_item => 1,
302 badbarcode => $circ->{'barcode'}
310 my $cardnumber = $circ->{cardnumber};
311 my $amount = $circ->{amount};
313 my $patron = Koha::Patrons->find( { cardnumber => $cardnumber } );
315 Koha::Account->new( { patron_id => $patron->id } )
316 ->pay( { amount => $amount, interface => C4::Context->interface } );
321 amount => $circ->{'amount'},
322 firstname => $patron->firstname,
323 surname => $patron->surname,
324 cardnumber => $patron->cardnumber,
325 borrower => $patron->id,
329 =head2 _get_borrowernumber_from_barcode
332 get back the borrowernumber of the patron who has it checked out.
333 undef if that can't be found
337 sub _get_borrowernumber_from_barcode {
340 return unless $barcode;
342 my $item = Koha::Items->find({ barcode => $barcode });
345 my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
346 return unless $issue;
347 return $issue->borrowernumber;