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 'cud-upload' && $fileID ) {
61 my $upload = Koha::UploadedFiles->find( $fileID );
62 my $fh = $upload? $upload->file_handle: undef;
63 my $filename = $upload? $upload->filename: undef;
64 my @input_lines = $fh? <$fh>: ();
67 my $header_line = shift @input_lines;
68 my $file_info = parse_header_line($header_line);
69 if ($file_info->{'Version'} ne $FILE_VERSION) {
72 ERROR_file_version => 1,
73 upload_version => $file_info->{'Version'},
74 current_version => $FILE_VERSION
79 foreach my $line (@input_lines) {
81 my $command_line = parse_command_line($line);
83 # map command names in the file to subroutine names
84 my %dispatch_table = (
85 issue => \&kocIssueItem,
86 'return' => \&kocReturnItem,
87 payment => \&kocMakePayment,
90 # call the right sub name, passing the hashref of command_line to it.
91 if ( exists $dispatch_table{ $command_line->{'command'} } ) {
92 $dispatch_table{ $command_line->{'command'} }->($command_line);
94 warn "unknown command: '$command_line->{command}' not processed";
98 $template->param(transactions_loaded => 1);
99 $template->param(messages => \@output);
102 output_html_with_http_headers $query, $cookie, $template->output;
106 =head2 parse_header_line
108 parses the header line from a .koc file. This is the line that
109 specifies things such as the file version, and the name and version of
110 the offline circulation tool that generated the file. See
111 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
112 for more information.
114 pass in a string containing the header line (the first line from th
117 returns a hashref containing the information from the header.
121 sub parse_header_line {
122 my $header_line = shift;
124 $header_line =~ s/\r//g;
126 my @fields = split( /\t/, $header_line );
127 my %header_info = map { split( /=/, $_ ) } @fields;
128 return \%header_info;
131 =head2 parse_command_line
135 sub parse_command_line {
136 my $command_line = shift;
137 chomp($command_line);
138 $command_line =~ s/\r//g;
140 my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
141 my ( $date, $time, $id ) = split( /\s/, $timestamp );
150 # set the rest of the keys using a hash slice
151 my $argument_names = arguments_for_command($command);
152 @command{@$argument_names} = @args;
158 =head2 arguments_for_command
160 fetches the names of the columns (and function arguments) found in the
161 .koc file for a particular command name. For instance, the C<issue>
162 command requires a C<cardnumber> and C<barcode>. In that case this
163 function returns a reference to the list C<qw( cardnumber barcode )>.
165 parameters: the command name
167 returns: listref of column names.
171 sub arguments_for_command {
174 # define the fields for this version of the file.
176 issue => [qw( cardnumber barcode )],
177 return => [qw( barcode )],
178 payment => [qw( cardnumber amount )],
181 return $format{$command};
187 $circ->{barcode} = barcodedecode( $circ->{barcode} ) if $circ->{barcode};
189 my $branchcode = C4::Context->userenv->{branch};
190 my $patron = Koha::Patrons->find( { cardnumber => $circ->{cardnumber} } );
191 my $item = Koha::Items->find({ barcode => $circ->{barcode} });
192 my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
193 my $biblio = $item->biblio;
195 if ( $issue ) { ## Item is currently checked out to another person.
196 #warn "Item Currently Issued.";
198 if ( $issue->borrowernumber eq $patron->borrowernumber ) { ## Issued to this person already, renew it.
199 #warn "Item issued to this member already, renewing.";
201 C4::Circulation::AddRenewal(
203 borrowernumber => $issue->borrowernumber,
204 itemnumber => $item->itemnumber,
205 lastreneweddate => $circ->{'date'},
211 title => $biblio->title,
212 biblionumber => $biblio->biblionumber,
213 barcode => $item->barcode,
214 firstname => $patron->firstname,
215 surname => $patron->surname,
216 borrowernumber => $patron->borrowernumber,
217 cardnumber => $patron->cardnumber,
218 datetime => $circ->datetime
222 #warn "Item issued to a different member.";
223 #warn "Date of previous issue: $issue->issuedate";
224 #warn "Date of this issue: $circ->{'date'}";
225 my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->issuedate );
226 my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
228 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.
229 C4::Circulation::AddIssue( $patron, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
232 title => $biblio->title,
233 biblionumber => $biblio->biblionumber,
234 barcode => $item->barcode,
235 firstname => $patron->firstname,
236 surname => $patron->surname,
237 borrowernumber => $patron->borrowernumber,
238 cardnumber => $patron->cardnumber,
239 datetime => $circ->datetime
242 } 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.
243 #warn "Current issue to another member is newer. Doing nothing";
244 ## This situation should only happen of the Offline Circ data is *really* old.
245 ## FIXME: write line to old_issues and statistics
248 } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
249 C4::Circulation::AddIssue( $patron, $circ->{'barcode'}, undef, undef, $circ->{'date'} ) unless ( DEBUG );
252 title => $biblio->title,
253 biblionumber => $biblio->biblionumber,
254 barcode => $item->barcode,
255 firstname => $patron->firstname,
256 surname => $patron->surname,
257 borrowernumber => $patron->borrowernumber,
258 cardnumber => $patron->cardnumber,
259 datetime =>$circ->datetime
267 $circ->{barcode} = barcodedecode( $circ->{barcode} ) if $circ->{barcode};
269 my $item = Koha::Items->find({ barcode => $circ->{barcode} });
270 my $biblio = $item->biblio;
271 my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
272 if ( $borrowernumber ) {
273 my $patron = Koha::Patrons->find( $borrowernumber );
274 C4::Circulation::MarkIssueReturned(
281 $item->onloan(undef)->store;
282 ModDateLastSeen( $item->itemnumber );
287 title => $biblio->title,
288 biblionumber => $biblio->biblionumber,
289 barcode => $item->barcode,
290 borrowernumber => $patron->borrowernumber,
291 firstname => $patron->firstname,
292 surname => $patron->surname,
293 cardnumber => $patron->cardnumber,
294 datetime => $circ->{'datetime'}
298 ERROR_no_borrower_from_item => 1,
299 badbarcode => $circ->{'barcode'}
307 my $cardnumber = $circ->{cardnumber};
308 my $amount = $circ->{amount};
310 my $patron = Koha::Patrons->find( { cardnumber => $cardnumber } );
312 Koha::Account->new( { patron_id => $patron->id } )
313 ->pay( { amount => $amount, interface => C4::Context->interface } );
318 amount => $circ->{'amount'},
319 firstname => $patron->firstname,
320 surname => $patron->surname,
321 cardnumber => $patron->cardnumber,
322 borrower => $patron->id,
326 =head2 _get_borrowernumber_from_barcode
329 get back the borrowernumber of the patron who has it checked out.
330 undef if that can't be found
334 sub _get_borrowernumber_from_barcode {
337 return unless $barcode;
339 my $item = Koha::Items->find({ barcode => $barcode });
342 my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );
343 return unless $issue;
344 return $issue->borrowernumber;