Merge remote branch 'kc/new/for-3.4/enh_bulkmarcimport' into kcmaster
[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-community.org/wiki/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     $header_line =~ s/\r//g;
180
181     my @fields = split( /\t/, $header_line );
182     my %header_info = map { split( /=/, $_ ) } @fields;
183     return \%header_info;
184 }
185
186 =head3 parse_command_line
187
188 =cut
189
190 sub parse_command_line {
191     my $command_line = shift;
192     chomp($command_line);
193     $command_line =~ s/\r//g;
194     
195     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
196     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
197
198     my %command = (
199         date    => $date,
200         time    => $time,
201         id      => $id,
202         command => $command,
203     );
204
205     # set the rest of the keys using a hash slice
206     my $argument_names = arguments_for_command($command);
207     @command{@$argument_names} = @args;
208
209     return \%command;
210
211 }
212
213 =head3 arguments_for_command
214
215 fetches the names of the columns (and function arguments) found in the
216 .koc file for a particular command name. For instance, the C<issue>
217 command requires a C<cardnumber> and C<barcode>. In that case this
218 function returns a reference to the list C<qw( cardnumber barcode )>.
219
220 parameters: the command name
221
222 returns: listref of column names.
223
224 =cut
225
226 sub arguments_for_command {
227     my $command = shift;
228
229     # define the fields for this version of the file.
230     my %format = (
231         issue   => [qw( cardnumber barcode )],
232         return  => [qw( barcode )],
233         payment => [qw( cardnumber amount )],
234     );
235
236     return $format{$command};
237 }
238
239 sub kocIssueItem {
240   my $circ = shift;
241
242   $circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
243   my $branchcode = C4::Context->userenv->{branch};
244   my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
245   my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
246   my $issue = GetItemIssue( $item->{'itemnumber'} );
247
248   my $issuingrule = GetIssuingRule( $borrower->{ 'categorycode' }, $item->{ 'itemtype' }, $branchcode );
249   my $issuelength = $issuingrule->{ 'issuelength' };
250   my ( $year, $month, $day ) = split( /-/, $circ->{'date'} );
251   ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, $issuelength );
252   my $date_due = sprintf("%04d-%02d-%02d", $year, $month, $day);
253
254   if ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
255 #warn "Item Currently Issued.";
256     my $issue = GetOpenIssue( $item->{'itemnumber'} );
257     
258     if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
259 #warn "Item issued to this member already, renewing.";
260     
261     my $date_due_object = C4::Dates->new($date_due ,'iso');
262     C4::Circulation::AddRenewal(
263         $issue->{'borrowernumber'},    # borrowernumber
264         $item->{'itemnumber'},         # itemnumber
265         undef,                         # branch
266         $date_due_object,              # datedue
267         $circ->{'date'},               # issuedate
268     ) unless ($DEBUG);
269
270       push( @output, { renew => 1,
271     title => $item->{ 'title' },
272     biblionumber => $item->{'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' }
279     } );
280
281     } else {
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'} );
287       
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         my $date_due_object = C4::Dates->new($date_due ,'iso');
290         C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due_object ) unless ( DEBUG );
291         push( @output, { issue => 1,
292     title => $item->{ 'title' },
293     biblionumber => $item->{'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' }
300     } );
301
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
306       }
307     
308     }
309   } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
310       my $date_due_object = C4::Dates->new($date_due ,'iso');
311       C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due_object ) unless ( DEBUG );
312     push( @output, { issue => 1,
313     title => $item->{ 'title' },
314     biblionumber => $item->{'biblionumber'},
315     barcode => $item->{ 'barcode' },
316     firstname => $borrower->{ 'firstname' },
317     surname => $borrower->{ 'surname' },
318     borrowernumber => $borrower->{'borrowernumber'},
319     cardnumber => $borrower->{'cardnumber'},
320     datetime =>$circ->{ 'datetime' }
321     } );
322          }  
323 }
324
325 sub kocReturnItem {
326   my ( $circ ) = @_;
327   $circ->{'barcode'} = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
328   my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
329   #warn( Data::Dumper->Dump( [ $circ, $item ], [ qw( circ item ) ] ) );
330   my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
331   if ( $borrowernumber ) {
332   my $borrower = GetMember( 'borrowernumber' =>$borrowernumber );
333     C4::Circulation::MarkIssueReturned( $borrowernumber,
334                                       $item->{'itemnumber'},
335                                       undef,
336                                       $circ->{'date'} );
337   
338   push( @output, { return => 1,
339     title => $item->{ 'title' },
340     biblionumber => $item->{'biblionumber'},
341     barcode => $item->{ 'barcode' },
342     borrowernumber => $borrower->{'borrowernumber'},
343     firstname => $borrower->{'firstname'},
344     surname => $borrower->{'surname'},
345     cardnumber => $borrower->{'cardnumber'},
346     datetime => $circ->{ 'datetime' }
347     } ); 
348   } else {
349     push( @output, { ERROR_no_borrower_from_item => 1,
350     badbarcode => $circ->{'barcode'}
351     } );
352   
353   }
354
355 }
356
357 sub kocMakePayment {
358   my ( $circ ) = @_;
359   my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
360   recordpayment( $borrower->{'borrowernumber'}, $circ->{'amount'} );
361   push( @output, { payment => 1,
362     amount => $circ->{'amount'},
363     firstname => $borrower->{'firstname'},
364     surname => $borrower->{'surname'},
365     cardnumber => $circ->{'cardnumber'},
366     borrower => $borrower->{'borrowernumber'}
367     } );
368 }
369
370 =head3 _get_borrowernumber_from_barcode
371
372 pass in a barcode
373 get back the borrowernumber of the patron who has it checked out.
374 undef if that can't be found
375
376 =cut
377
378 sub _get_borrowernumber_from_barcode {
379     my $barcode = shift;
380
381     return unless $barcode;
382
383     my $item = GetBiblioFromItemNumber( undef, $barcode );
384     return unless $item->{'itemnumber'};
385     
386     my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
387     return unless $issue->{'borrowernumber'};
388     return $issue->{'borrowernumber'};
389     
390 }