Merge commit 'pianohacker-koha/prefs-submit' into master
[koha.git] / offline_circ / process_koc.pl
1 #!/usr/bin/perl
2
3 # 2008 Kyle Hall <kyle.m.hall@gmail.com>
4
5 # This file is part of Koha.
6 #
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
10 # version.
11 #
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.
15 #
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
19 #
20
21 use strict;
22 use warnings;
23
24 use CGI;
25 use C4::Output;
26 use C4::Auth;
27 use C4::Koha;
28 use C4::Context;
29 use C4::Biblio;
30 use C4::Accounts;
31 use C4::Circulation;
32 use C4::Members;
33 use C4::Stats;
34 use C4::UploadedFile;
35 use C4::BackgroundJob;
36
37 use Date::Calc qw( Add_Delta_Days Date_to_Days );
38
39 use constant DEBUG => 0;
40
41 # this is the file version number that we're coded against.
42 my $FILE_VERSION = '1.0';
43
44 our $query = CGI->new;
45
46 my ($template, $loggedinuser, $cookie)
47   = get_template_and_user( { template_name => "offline_circ/process_koc.tmpl",
48                                 query => $query,
49                                 type => "intranet",
50                                 authnotrequired => 0,
51                                  flagsrequired   => { circulate => "circulate_remaining_permissions" },
52                                 });
53
54
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;
60 ## 'Local' globals.
61 our $dbh = C4::Context->dbh();
62 our @output = (); ## For storing messages to be displayed to the user
63
64
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});
70 } elsif ($fileID) {
71     my $uploaded_file = C4::UploadedFile->fetch($sessionID, $fileID);
72     my $fh = $uploaded_file->fh();
73     my @input_lines = <$fh>;
74   
75     my $filename = $uploaded_file->name(); 
76     my $job = undef;
77
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();
82
83         # fork off
84         if (my $pid = fork) {
85             # parent
86             # return job ID as JSON
87
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;
92
93             my $reply = CGI->new("");
94             print $reply->header(-type => 'text/html');
95             print "{ jobID: '$jobID' }";
96             exit 0;
97         } elsif (defined $pid) {
98             # child
99             # close STDOUT to signal to Apache that
100             # we're now running in the background
101             close STDOUT;
102             close STDERR;
103         } else {
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";
107             exit 0;
108         }
109
110         # if we get here, we're a child that has detached
111         # itself from Apache
112
113     }     
114
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
122       } );
123     }
124     
125     
126     my $i = 0;
127     foreach  my $line (@input_lines)  {
128     
129         $i++;
130         my $command_line = parse_command_line($line);
131         
132         # map command names in the file to subroutine names
133         my %dispatch_table = (
134             issue     => \&kocIssueItem,
135             'return'  => \&kocReturnItem,
136             payment   => \&kocMakePayment,
137         );
138
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);
142         } else {
143             warn "unknown command: '$command_line->{command}' not processed";
144         }
145
146         if ($runinbackground) {
147             $job->progress($i);
148         }
149     }
150
151     if ($runinbackground) {
152         $job->finish({ results => \@output }) if defined($job);
153     } else {
154         $template->param(transactions_loaded => 1);
155         $template->param(messages => \@output);
156     }
157 }
158
159 output_html_with_http_headers $query, $cookie, $template->output;
160
161 =head3 parse_header_line
162
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.
168
169 pass in a string containing the header line (the first line from th
170 file).
171
172 returns a hashref containing the information from the header.
173
174 =cut
175
176 sub parse_header_line {
177     my $header_line = shift;
178     chomp($header_line);
179
180     my @fields = split( /\t/, $header_line );
181     my %header_info = map { split( /=/, $_ ) } @fields;
182     return \%header_info;
183 }
184
185 =head3 parse_command_line
186
187 =cut
188
189 sub parse_command_line {
190     my $command_line = shift;
191     chomp($command_line);
192
193     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
194     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
195
196     my %command = (
197         date    => $date,
198         time    => $time,
199         id      => $id,
200         command => $command,
201     );
202
203     # set the rest of the keys using a hash slice
204     my $argument_names = arguments_for_command($command);
205     @command{@$argument_names} = @args;
206
207     return \%command;
208
209 }
210
211 =head3 arguments_for_command
212
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 )>.
217
218 parameters: the command name
219
220 returns: listref of column names.
221
222 =cut
223
224 sub arguments_for_command {
225     my $command = shift;
226
227     # define the fields for this version of the file.
228     my %format = (
229         issue   => [qw( cardnumber barcode )],
230         return  => [qw( barcode )],
231         payment => [qw( cardnumber amount )],
232     );
233
234     return $format{$command};
235 }
236
237 sub kocIssueItem {
238   my $circ = shift;
239
240   $circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
241   my $branchcode = C4::Context->userenv->{branch};
242   my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
243   my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
244   my $issue = GetItemIssue( $item->{'itemnumber'} );
245
246   my $issuingrule = GetIssuingRule( $borrower->{ 'categorycode' }, $item->{ 'itemtype' }, $branchcode );
247   my $issuelength = $issuingrule->{ 'issuelength' };
248   my ( $year, $month, $day ) = split( /-/, $circ->{'date'} );
249   ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, $issuelength );
250   my $date_due = sprintf("%04d-%02d-%02d", $year, $month, $day);
251   
252   if ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
253 #warn "Item Currently Issued.";
254     my $issue = GetOpenIssue( $item->{'itemnumber'} );
255
256     if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
257 #warn "Item issued to this member already, renewing.";
258     
259     my $date_due_object = C4::Dates->new($date_due ,'iso');
260     C4::Circulation::AddRenewal(
261         $issue->{'borrowernumber'},    # borrowernumber
262         $item->{'itemnumber'},         # itemnumber
263         undef,                         # branch
264         $date_due_object,              # datedue
265         $circ->{'date'},               # issuedate
266     ) unless ($DEBUG);
267
268       push( @output, { renew => 1,
269     title => $item->{ 'title' },
270     biblionumber => $item->{'biblionumber'},
271     barcode => $item->{ 'barcode' },
272     firstname => $borrower->{ 'firstname' },
273     surname => $borrower->{ 'surname' },
274     borrowernumber => $borrower->{'borrowernumber'},
275     cardnumber => $borrower->{'cardnumber'},
276     datetime => $circ->{ 'datetime' }
277     } );
278
279     } else {
280 #warn "Item issued to a different member.";
281 #warn "Date of previous issue: $issue->{'issuedate'}";
282 #warn "Date of this issue: $circ->{'date'}";
283       my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
284       my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
285       
286       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.
287         my $date_due_object = C4::Dates->new($date_due ,'iso');
288         C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due_object ) unless ( DEBUG );
289         push( @output, { issue => 1,
290     title => $item->{ 'title' },
291     biblionumber => $item->{'biblionumber'},
292     barcode => $item->{ 'barcode' },
293     firstname => $borrower->{ 'firstname' },
294     surname => $borrower->{ 'surname' },
295     borrowernumber => $borrower->{'borrowernumber'},
296     cardnumber => $borrower->{'cardnumber'},
297     datetime => $circ->{ 'datetime' }
298     } );
299
300       } 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.
301 #warn "Current issue to another member is newer. Doing nothing";
302         ## This situation should only happen of the Offline Circ data is *really* old.
303         ## FIXME: write line to old_issues and statistics
304       }
305     
306     }
307   } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
308       my $date_due_object = C4::Dates->new($date_due ,'iso');
309       C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due_object ) unless ( DEBUG );
310     push( @output, { issue => 1,
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' }
319     } );
320          }  
321 }
322
323 sub kocReturnItem {
324   my ( $circ ) = @_;
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( $borrowernumber,
332                                       $item->{'itemnumber'},
333                                       undef,
334                                       $circ->{'date'} );
335   
336   push( @output, { return => 1,
337     title => $item->{ 'title' },
338     biblionumber => $item->{'biblionumber'},
339     barcode => $item->{ 'barcode' },
340     borrowernumber => $borrower->{'borrowernumber'},
341     firstname => $borrower->{'firstname'},
342     surname => $borrower->{'surname'},
343     cardnumber => $borrower->{'cardnumber'},
344     datetime => $circ->{ 'datetime' }
345     } ); 
346   } else {
347     push( @output, { ERROR_no_borrower_from_item => 1,
348     badbarcode => $circ->{'barcode'}
349     } );
350   
351   }
352
353 }
354
355 sub kocMakePayment {
356   my ( $circ ) = @_;
357   my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
358   recordpayment( $borrower->{'borrowernumber'}, $circ->{'amount'} );
359   push( @output, { payment => 1,
360     amount => $circ->{'amount'},
361     firstname => $borrower->{'firstname'},
362     surname => $borrower->{'surname'},
363     cardnumber => $circ->{'cardnumber'},
364     borrower => $borrower->{'borrowernumber'}
365     } );
366 }
367
368 =head3 _get_borrowernumber_from_barcode
369
370 pass in a barcode
371 get back the borrowernumber of the patron who has it checked out.
372 undef if that can't be found
373
374 =cut
375
376 sub _get_borrowernumber_from_barcode {
377     my $barcode = shift;
378
379     return unless $barcode;
380
381     my $item = GetBiblioFromItemNumber( undef, $barcode );
382     return unless $item->{'itemnumber'};
383     
384     my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
385     return unless $issue->{'borrowernumber'};
386     return $issue->{'borrowernumber'};
387     
388 }