Fix for Bug 5689 - System preference notifications are not translatable
[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 =head1 FUNCTIONS
162
163 =head2 parse_header_line
164
165 parses the header line from a .koc file. This is the line that
166 specifies things such as the file version, and the name and version of
167 the offline circulation tool that generated the file. See
168 L<http://wiki.koha-community.org/wiki/Koha_offline_circulation_file_format>
169 for more information.
170
171 pass in a string containing the header line (the first line from th
172 file).
173
174 returns a hashref containing the information from the header.
175
176 =cut
177
178 sub parse_header_line {
179     my $header_line = shift;
180     chomp($header_line);
181     $header_line =~ s/\r//g;
182
183     my @fields = split( /\t/, $header_line );
184     my %header_info = map { split( /=/, $_ ) } @fields;
185     return \%header_info;
186 }
187
188 =head2 parse_command_line
189
190 =cut
191
192 sub parse_command_line {
193     my $command_line = shift;
194     chomp($command_line);
195     $command_line =~ s/\r//g;
196     
197     my ( $timestamp, $command, @args ) = split( /\t/, $command_line );
198     my ( $date,      $time,    $id )   = split( /\s/, $timestamp );
199
200     my %command = (
201         date    => $date,
202         time    => $time,
203         id      => $id,
204         command => $command,
205     );
206
207     # set the rest of the keys using a hash slice
208     my $argument_names = arguments_for_command($command);
209     @command{@$argument_names} = @args;
210
211     return \%command;
212
213 }
214
215 =head2 arguments_for_command
216
217 fetches the names of the columns (and function arguments) found in the
218 .koc file for a particular command name. For instance, the C<issue>
219 command requires a C<cardnumber> and C<barcode>. In that case this
220 function returns a reference to the list C<qw( cardnumber barcode )>.
221
222 parameters: the command name
223
224 returns: listref of column names.
225
226 =cut
227
228 sub arguments_for_command {
229     my $command = shift;
230
231     # define the fields for this version of the file.
232     my %format = (
233         issue   => [qw( cardnumber barcode )],
234         return  => [qw( barcode )],
235         payment => [qw( cardnumber amount )],
236     );
237
238     return $format{$command};
239 }
240
241 sub kocIssueItem {
242   my $circ = shift;
243
244   $circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
245   my $branchcode = C4::Context->userenv->{branch};
246   my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
247   my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
248   my $issue = GetItemIssue( $item->{'itemnumber'} );
249
250   my $issuingrule = GetIssuingRule( $borrower->{ 'categorycode' }, $item->{ 'itemtype' }, $branchcode );
251   my $issuelength = $issuingrule->{ 'issuelength' };
252   my ( $year, $month, $day ) = split( /-/, $circ->{'date'} );
253   ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, $issuelength );
254   my $date_due = sprintf("%04d-%02d-%02d", $year, $month, $day);
255
256   if ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
257 #warn "Item Currently Issued.";
258     my $issue = GetOpenIssue( $item->{'itemnumber'} );
259     
260     if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
261 #warn "Item issued to this member already, renewing.";
262     
263     my $date_due_object = C4::Dates->new($date_due ,'iso');
264     C4::Circulation::AddRenewal(
265         $issue->{'borrowernumber'},    # borrowernumber
266         $item->{'itemnumber'},         # itemnumber
267         undef,                         # branch
268         $date_due_object,              # datedue
269         $circ->{'date'},               # issuedate
270     ) unless ($DEBUG);
271
272       push( @output, { renew => 1,
273     title => $item->{ 'title' },
274     biblionumber => $item->{'biblionumber'},
275     barcode => $item->{ 'barcode' },
276     firstname => $borrower->{ 'firstname' },
277     surname => $borrower->{ 'surname' },
278     borrowernumber => $borrower->{'borrowernumber'},
279     cardnumber => $borrower->{'cardnumber'},
280     datetime => $circ->{ 'datetime' }
281     } );
282
283     } else {
284 #warn "Item issued to a different member.";
285 #warn "Date of previous issue: $issue->{'issuedate'}";
286 #warn "Date of this issue: $circ->{'date'}";
287       my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
288       my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
289       
290       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.
291         my $date_due_object = C4::Dates->new($date_due ,'iso');
292         C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due_object ) unless ( DEBUG );
293         push( @output, { issue => 1,
294     title => $item->{ 'title' },
295     biblionumber => $item->{'biblionumber'},
296     barcode => $item->{ 'barcode' },
297     firstname => $borrower->{ 'firstname' },
298     surname => $borrower->{ 'surname' },
299     borrowernumber => $borrower->{'borrowernumber'},
300     cardnumber => $borrower->{'cardnumber'},
301     datetime => $circ->{ 'datetime' }
302     } );
303
304       } 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.
305 #warn "Current issue to another member is newer. Doing nothing";
306         ## This situation should only happen of the Offline Circ data is *really* old.
307         ## FIXME: write line to old_issues and statistics
308       }
309     
310     }
311   } else { ## Item is not checked out to anyone at the moment, go ahead and issue it
312       my $date_due_object = C4::Dates->new($date_due ,'iso');
313       C4::Circulation::AddIssue( $borrower, $circ->{'barcode'}, $date_due_object ) unless ( DEBUG );
314     push( @output, { issue => 1,
315     title => $item->{ 'title' },
316     biblionumber => $item->{'biblionumber'},
317     barcode => $item->{ 'barcode' },
318     firstname => $borrower->{ 'firstname' },
319     surname => $borrower->{ 'surname' },
320     borrowernumber => $borrower->{'borrowernumber'},
321     cardnumber => $borrower->{'cardnumber'},
322     datetime =>$circ->{ 'datetime' }
323     } );
324          }  
325 }
326
327 sub kocReturnItem {
328   my ( $circ ) = @_;
329   $circ->{'barcode'} = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));
330   my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
331   #warn( Data::Dumper->Dump( [ $circ, $item ], [ qw( circ item ) ] ) );
332   my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );
333   if ( $borrowernumber ) {
334   my $borrower = GetMember( 'borrowernumber' =>$borrowernumber );
335     C4::Circulation::MarkIssueReturned( $borrowernumber,
336                                       $item->{'itemnumber'},
337                                       undef,
338                                       $circ->{'date'} );
339   
340   push( @output, { return => 1,
341     title => $item->{ 'title' },
342     biblionumber => $item->{'biblionumber'},
343     barcode => $item->{ 'barcode' },
344     borrowernumber => $borrower->{'borrowernumber'},
345     firstname => $borrower->{'firstname'},
346     surname => $borrower->{'surname'},
347     cardnumber => $borrower->{'cardnumber'},
348     datetime => $circ->{ 'datetime' }
349     } ); 
350   } else {
351     push( @output, { ERROR_no_borrower_from_item => 1,
352     badbarcode => $circ->{'barcode'}
353     } );
354   
355   }
356
357 }
358
359 sub kocMakePayment {
360   my ( $circ ) = @_;
361   my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
362   recordpayment( $borrower->{'borrowernumber'}, $circ->{'amount'} );
363   push( @output, { payment => 1,
364     amount => $circ->{'amount'},
365     firstname => $borrower->{'firstname'},
366     surname => $borrower->{'surname'},
367     cardnumber => $circ->{'cardnumber'},
368     borrower => $borrower->{'borrowernumber'}
369     } );
370 }
371
372 =head2 _get_borrowernumber_from_barcode
373
374 pass in a barcode
375 get back the borrowernumber of the patron who has it checked out.
376 undef if that can't be found
377
378 =cut
379
380 sub _get_borrowernumber_from_barcode {
381     my $barcode = shift;
382
383     return unless $barcode;
384
385     my $item = GetBiblioFromItemNumber( undef, $barcode );
386     return unless $item->{'itemnumber'};
387     
388     my $issue = C4::Circulation::GetItemIssue( $item->{'itemnumber'} );
389     return unless $issue->{'borrowernumber'};
390     return $issue->{'borrowernumber'};
391     
392 }