RT# 81946 Implement conf-disable_counts on Package Definitions page
[freeside.git] / FS / FS / pay_batch.pm
1 package FS::pay_batch;
2 use base qw( FS::Record );
3
4 use strict;
5 use vars qw( $DEBUG %import_info %export_info $conf );
6 use Scalar::Util qw(blessed);
7 use IO::Scalar;
8 use List::Util qw(sum);
9 use Time::Local;
10 use Text::CSV_XS;
11 use Date::Parse qw(str2time);
12 use Business::CreditCard qw( 0.35 cardtype );
13 use FS::Record qw( dbh qsearch qsearchs );
14 use FS::Conf;
15 use FS::cust_pay;
16 use FS::Log;
17 use Try::Tiny;
18
19 =head1 NAME
20
21 FS::pay_batch - Object methods for pay_batch records
22
23 =head1 SYNOPSIS
24
25   use FS::pay_batch;
26
27   $record = new FS::pay_batch \%hash;
28   $record = new FS::pay_batch { 'column' => 'value' };
29
30   $error = $record->insert;
31
32   $error = $new_record->replace($old_record);
33
34   $error = $record->delete;
35
36   $error = $record->check;
37
38 =head1 DESCRIPTION
39
40 An FS::pay_batch object represents an payment batch.  FS::pay_batch inherits
41 from FS::Record.  The following fields are currently supported:
42
43 =over 4
44
45 =item batchnum - primary key
46
47 =item agentnum - optional agent number for agent batches
48
49 =item payby - CARD or CHEK
50
51 =item status - O (Open), I (In-transit), or R (Resolved)
52
53 =item download - time when the batch was first downloaded
54
55 =item upload - time when the batch was first uploaded
56
57 =item title - unique batch identifier
58
59 =item processor_id -
60
61 =item type - batch type payents (DEBIT), or refunds (CREDIT)
62
63 For incoming batches, the combination of 'title', 'payby', and 'agentnum'
64 must be unique.
65
66 =back
67
68 =head1 METHODS
69
70 =over 4
71
72 =item new HASHREF
73
74 Creates a new batch.  To add the batch to the database, see L<"insert">.
75
76 Note that this stores the hash reference, not a distinct copy of the hash it
77 points to.  You can ask the object for a copy with the I<hash> method.
78
79 =cut
80
81 # the new method can be inherited from FS::Record, if a table method is defined
82
83 sub table { 'pay_batch'; }
84
85 =item insert
86
87 Adds this record to the database.  If there is an error, returns the error,
88 otherwise returns false.
89
90 =cut
91
92 # the insert method can be inherited from FS::Record
93
94 =item delete
95
96 Delete this record from the database.
97
98 =cut
99
100 # the delete method can be inherited from FS::Record
101
102 =item replace OLD_RECORD
103
104 Replaces the OLD_RECORD with this one in the database.  If there is an error,
105 returns the error, otherwise returns false.
106
107 =cut
108
109 # the replace method can be inherited from FS::Record
110
111 =item check
112
113 Checks all fields to make sure this is a valid batch.  If there is
114 an error, returns the error, otherwise returns false.  Called by the insert
115 and replace methods.
116
117 =cut
118
119 # the check method should currently be supplied - FS::Record contains some
120 # data checking routines
121
122 sub check {
123   my $self = shift;
124
125   my $error = 
126     $self->ut_numbern('batchnum')
127     || $self->ut_enum('payby', [ 'CARD', 'CHEK' ])
128     || $self->ut_enum('status', [ 'O', 'I', 'R' ])
129     || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
130     || $self->ut_alphan('title')
131   ;
132   return $error if $error;
133
134   if ( $self->title ) {
135     my @existing = 
136       grep { !$self->batchnum or $_->batchnum != $self->batchnum } 
137       qsearch('pay_batch', {
138           payby     => $self->payby,
139           agentnum  => $self->agentnum,
140           title     => $self->title,
141       });
142     return "Batch already exists as batchnum ".$existing[0]->batchnum
143       if @existing;
144   }
145
146   $self->SUPER::check;
147 }
148
149 =item agent
150
151 Returns the L<FS::agent> object for this batch.
152
153 =item cust_pay_batch
154
155 Returns all L<FS::cust_pay_batch> objects for this batch.
156
157 =item rebalance
158
159 =cut
160
161 sub rebalance {
162   my $self = shift;
163 }
164
165 =item set_status 
166
167 =cut
168
169 sub set_status {
170   my $self = shift;
171   $self->status(shift);
172   $self->download(time)
173     if $self->status eq 'I' && ! $self->download;
174   $self->upload(time)
175     if $self->status eq 'R' && ! $self->upload;
176   $self->replace();
177 }
178
179 # further false laziness
180
181 %import_info = %export_info = ();
182 foreach my $INC (@INC) {
183   warn "globbing $INC/FS/pay_batch/*.pm\n" if $DEBUG;
184   foreach my $file ( glob("$INC/FS/pay_batch/*.pm")) {
185     warn "attempting to load batch format from $file\n" if $DEBUG;
186     $file =~ /\/(\w+)\.pm$/;
187     next if !$1;
188     my $mod = $1;
189     my ($import, $export, $name) = 
190       eval "use FS::pay_batch::$mod; 
191            ( \\%FS::pay_batch::$mod\::import_info,
192              \\%FS::pay_batch::$mod\::export_info,
193              \$FS::pay_batch::$mod\::name)";
194     $name ||= $mod; # in case it's not defined
195     if ($@) {
196       # in FS::cdr this is a die, not a warn.  That's probably a bug.
197       warn "error using FS::pay_batch::$mod (skipping): $@\n";
198       next;
199     }
200     if(!keys(%$import)) {
201       warn "no \%import_info found in FS::pay_batch::$mod (skipping)\n";
202     }
203     else {
204       $import_info{$name} = $import;
205     }
206     if(!keys(%$export)) {
207       warn "no \%export_info found in FS::pay_batch::$mod (skipping)\n";
208     }
209     else {
210       $export_info{$name} = $export;
211     }
212   }
213 }
214
215 =item import_results OPTION => VALUE, ...
216
217 Import batch results. Can be called as an instance method, if you want to 
218 automatically adjust status on a specific batch, or a class method, if you 
219 don't know which batch(es) the results apply to.
220
221 Options are:
222
223 I<filehandle> - open filehandle of results file.
224
225 I<format> - an L<FS::pay_batch> module
226
227 I<gateway> - an L<FS::payment_gateway> object for a batch gateway.  This 
228 takes precedence over I<format>.
229
230 I<no_close> - do not try to close batches
231
232 Supported format keys (defined in the specified FS::pay_batch module) are:
233
234 I<filetype> - required, can be CSV, fixed, variable, XML
235
236 I<fields> - required list of field names for each row/line
237
238 I<formatre> - regular expression for fixed filetype
239
240 I<parse> - required for variable filetype
241
242 I<xmlkeys> - required for XML filetype
243
244 I<xmlrow> - required for XML filetype
245
246 I<begin_condition> - sub, ignore all lines before this returns true
247
248 I<end_condition> - sub, stop processing lines when this returns true
249
250 I<end_hook> - sub, runs immediately after end_condition returns true
251
252 I<skip_condition> - sub, skip lines when this returns true
253
254 I<hook> - required, sub, runs before approved/declined conditions are checked
255
256 I<approved> - required, sub, returns true when approved
257
258 I<declined> - required, sub, returns true when declined
259
260 I<close_condition> - sub, decide whether or not to close the batch
261
262 =cut
263
264 sub import_results {
265   my $self = shift;
266
267   my $param = ref($_[0]) ? shift : { @_ };
268   my $fh = $param->{'filehandle'};
269   my $job = $param->{'job'};
270   $job->update_statustext(0) if $job;
271
272   my $format = $param->{'format'};
273   my $info = $import_info{$format}
274     or die "unknown format $format";
275
276   my $conf = new FS::Conf;
277
278   my $filetype            = $info->{'filetype'};      # CSV, fixed, variable
279   my @fields              = @{ $info->{'fields'}};
280   my $formatre            = $info->{'formatre'};      # for fixed
281   my $parse               = $info->{'parse'};         # for variable
282   my @all_values;
283   my $begin_condition     = $info->{'begin_condition'};
284   my $end_condition       = $info->{'end_condition'};
285   my $end_hook            = $info->{'end_hook'};
286   my $skip_condition      = $info->{'skip_condition'};
287   my $hook                = $info->{'hook'};
288   my $approved_condition  = $info->{'approved'};
289   my $declined_condition  = $info->{'declined'};
290   my $close_condition     = $info->{'close_condition'};
291
292   my %target_batches; # batches that had at least one payment updated
293
294   my $csv = new Text::CSV_XS;
295
296   local $SIG{HUP} = 'IGNORE';
297   local $SIG{INT} = 'IGNORE';
298   local $SIG{QUIT} = 'IGNORE';
299   local $SIG{TERM} = 'IGNORE';
300   local $SIG{TSTP} = 'IGNORE';
301   local $SIG{PIPE} = 'IGNORE';
302
303   my $oldAutoCommit = $FS::UID::AutoCommit;
304   local $FS::UID::AutoCommit = 0;
305   my $dbh = dbh;
306
307   if ( ref($self) ) {
308     # if called on a specific pay_batch, check the status of that batch
309     # before continuing
310     my $reself = $self->select_for_update;
311
312     if ( $reself->status ne 'I' 
313         and !$conf->exists('batch-manual_approval') ) {
314       $dbh->rollback if $oldAutoCommit;
315       return "batchnum ". $self->batchnum. "no longer in transit";
316     }
317   } # otherwise we can't enforce this constraint. sorry.
318
319   my $total = 0;
320   my $line;
321
322   if ($filetype eq 'XML') {
323     eval "use XML::Simple";
324     die $@ if $@;
325     my @xmlkeys = @{ $info->{'xmlkeys'} };  # for XML
326     my $xmlrow  = $info->{'xmlrow'};        # also for XML
327
328     # Do everything differently.
329     my $data = XML::Simple::XMLin($fh, KeepRoot => 1);
330     my $rows = $data;
331     # $xmlrow = [ RootKey, FirstLevelKey, SecondLevelKey... ]
332     $rows = $rows->{$_} foreach( @$xmlrow );
333     if(!defined($rows)) {
334       $dbh->rollback if $oldAutoCommit;
335       return "can't find rows in XML file";
336     }
337     $rows = [ $rows ] if ref($rows) ne 'ARRAY';
338     foreach my $row (@$rows) {
339       push @all_values, [ @{$row}{@xmlkeys}, $row ];
340     }
341   }
342   else {
343     while ( defined($line=<$fh>) ) {
344
345       next if $line =~ /^\s*$/; #skip blank lines
346
347       if ($filetype eq "CSV") {
348         $csv->parse($line) or do {
349           $dbh->rollback if $oldAutoCommit;
350           return "can't parse: ". $csv->error_input();
351         };
352         push @all_values, [ $csv->fields(), $line ];
353       }elsif ($filetype eq 'fixed'){
354         my @values = ( $line =~ /$formatre/ );
355         unless (@values) {
356           $dbh->rollback if $oldAutoCommit;
357           return "can't parse: ". $line;
358         };
359         push @values, $line;
360         push @all_values, \@values;
361       }
362       elsif ($filetype eq 'variable') {
363         # no longer used
364         my @values = ( eval { $parse->($self, $line) } );
365         if( $@ ) {
366           $dbh->rollback if $oldAutoCommit;
367           return $@;
368         };
369         push @values, $line;
370         push @all_values, \@values;
371       }
372       else {
373         $dbh->rollback if $oldAutoCommit;
374         return "Unknown file type $filetype";
375       }
376     }
377   }
378
379   my $num = 0;
380   foreach (@all_values) {
381     if($job) {
382       $num++;
383       $job->update_statustext(int(100 * $num/scalar(@all_values)));
384     }
385     my @values = @$_;
386
387     my %hash;
388     my $line = pop @values;
389     foreach my $field ( @fields ) {
390       my $value = shift @values;
391       next unless $field;
392       $hash{$field} = $value;
393     }
394
395     if ( defined($begin_condition) ) {
396       if ( &{$begin_condition}(\%hash, $line) ) {
397         undef $begin_condition;
398       }
399       else {
400         next;
401       }
402     }
403
404     if ( defined($end_condition) and &{$end_condition}(\%hash, $line) ) {
405       my $error;
406       $error = &{$end_hook}(\%hash, $total, $line) if defined($end_hook);
407       if ( $error ) {
408         $dbh->rollback if $oldAutoCommit;
409         return $error;
410       }
411       last;
412     }
413
414     if ( defined($skip_condition) and &{$skip_condition}(\%hash, $line) ) {
415       next;
416     }
417
418     my $cust_pay_batch =
419       qsearchs('cust_pay_batch', { 'paybatchnum' => $hash{'paybatchnum'}+0 } );
420     unless ( $cust_pay_batch ) {
421       return "unknown paybatchnum $hash{'paybatchnum'}\n";
422     }
423     # remember that we've touched this batch
424     $target_batches{ $cust_pay_batch->batchnum } = 1;
425
426     my $custnum = $cust_pay_batch->custnum,
427     my $payby = $cust_pay_batch->payby,
428
429     &{$hook}(\%hash, $cust_pay_batch->hashref);
430
431     my $new_cust_pay_batch = new FS::cust_pay_batch { $cust_pay_batch->hash };
432
433     my $error = '';
434     if ( &{$approved_condition}(\%hash) ) {
435
436       foreach ('paid', '_date', 'payinfo') {
437         $new_cust_pay_batch->$_($hash{$_}) if $hash{$_};
438       }
439       $error = $new_cust_pay_batch->approve(%hash);
440       $total += $hash{'paid'};
441
442     } elsif ( &{$declined_condition}(\%hash) ) {
443
444       $error = $new_cust_pay_batch->decline($hash{'error_message'});;
445
446     }
447
448     if ( $error ) {
449       $dbh->rollback if $oldAutoCommit;
450       return $error;
451     }
452
453     # purge CVV when the batch is processed
454     if ( $payby =~ /^(CARD|DCRD)$/ ) {
455       my $payinfo = $hash{'payinfo'} || $cust_pay_batch->payinfo;
456       if ( ! grep { $_ eq cardtype($payinfo) }
457           $conf->config('cvv-save') ) {
458         $new_cust_pay_batch->cust_main->remove_cvv;
459       }
460
461     }
462
463   } # foreach (@all_values)
464
465   # decide whether to close batches that had payments posted
466   if ( !$param->{no_close} ) {
467     foreach my $batchnum (keys %target_batches) {
468       my $pay_batch = FS::pay_batch->by_key($batchnum);
469       my $close = 1;
470       if ( defined($close_condition) ) {
471         # Allow the module to decide whether to close the batch.
472         # $close_condition can also die() to abort the whole import.
473         $close = eval { $close_condition->($pay_batch) };
474         if ( $@ ) {
475           $dbh->rollback;
476           die $@;
477         }
478       }
479       if ( $close ) {
480         my $error = $pay_batch->set_status('R');
481         if ( $error ) {
482           $dbh->rollback if $oldAutoCommit;
483           return $error;
484         }
485       }
486     } # foreach $batchnum
487   } # if (!$param->{no_close})
488
489   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
490   '';
491
492 }
493
494 use Data::Dumper;
495 sub process_import_results {
496   my $job = shift;
497   my $param = shift;
498   $param->{'job'} = $job;
499   warn Dumper($param) if $DEBUG;
500   my $gatewaynum = delete $param->{'gatewaynum'};
501   if ( $gatewaynum ) {
502     $param->{'gateway'} = FS::payment_gateway->by_key($gatewaynum)
503       or die "gatewaynum '$gatewaynum' not found\n";
504     delete $param->{'format'}; # to avoid confusion
505   }
506
507   my $file = $param->{'uploaded_files'} or die "no files provided\n";
508   $file =~ s/^(\w+):([\.\w]+)$/$2/;
509   my $dir = '%%%FREESIDE_CACHE%%%/cache.' . $FS::UID::datasrc;
510   open( $param->{'filehandle'}, 
511         '<',
512         "$dir/$file" )
513       or die "unable to open '$file'.\n";
514   
515   my $error;
516   if ( $param->{gateway} ) {
517     $error = FS::pay_batch->import_from_gateway(%$param);
518   } else {
519     my $batchnum = delete $param->{'batchnum'} or die "no batchnum specified\n";
520     my $batch = FS::pay_batch->by_key($batchnum) or die "batchnum '$batchnum' not found\n";
521     $error = $batch->import_results($param);
522   }
523   unlink $file;
524   die $error if $error;
525 }
526
527 =item import_from_gateway [ OPTIONS ]
528
529 Import results from a L<FS::payment_gateway>, using Business::BatchPayment,
530 and apply them.  GATEWAY must use the Business::BatchPayment namespace.
531
532 This is a class method, since results can be applied to any batch.  
533 The 'batch-reconsider' option determines whether an already-approved 
534 or declined payment can have its status changed by a later import.
535
536 OPTIONS may include:
537
538 - gateway: the L<FS::payment_gateway>, required
539 - filehandle: a file name or handle to use as a data source.
540 - job: an L<FS::queue> object to update with progress messages.
541
542 =cut
543
544 sub import_from_gateway {
545   my $class = shift;
546   my %opt = @_;
547   my $gateway = $opt{'gateway'};
548   my $conf = FS::Conf->new;
549
550   # unavoidable duplication with import_batch, for now
551   local $SIG{HUP} = 'IGNORE';
552   local $SIG{INT} = 'IGNORE';
553   local $SIG{QUIT} = 'IGNORE';
554   local $SIG{TERM} = 'IGNORE';
555   local $SIG{TSTP} = 'IGNORE';
556   local $SIG{PIPE} = 'IGNORE';
557
558   my $oldAutoCommit = $FS::UID::AutoCommit;
559   local $FS::UID::AutoCommit = 0;
560   my $dbh = dbh;
561
562   my $job = delete($opt{'job'});
563   $job->update_statustext(0) if $job;
564
565   my $total = 0;
566   return "import_from_gateway requires a payment_gateway"
567     unless eval { $gateway->isa('FS::payment_gateway') };
568
569   my %proc_opt = (
570     'input' => $opt{'filehandle'}, # will do nothing if it's empty
571     # any other constructor options go here
572   );
573
574   my @item_errors;
575   my $errors_not_fatal = $conf->config('batch-errors_not_fatal');
576   if ( $errors_not_fatal ) {
577     # construct error trap
578     $proc_opt{'on_parse_error'} = sub {
579       my ($self, $line, $error) = @_;
580       push @item_errors, "  '$line'\n$error";
581     };
582   }
583
584   my $processor = $gateway->batch_processor(%proc_opt);
585
586   my @processor_ids = map { $_->processor_id } 
587                         qsearch({
588                           'table' => 'pay_batch',
589                           'hashref' => { 'status' => 'I' },
590                           'extra_sql' => q( AND processor_id != '' AND processor_id IS NOT NULL)
591                         });
592
593   my @batches = $processor->receive(@processor_ids);
594
595   my $num = 0;
596
597   my $total_items = sum( map{$_->count} @batches);
598
599   # whether to allow items to change status
600   my $reconsider = $conf->exists('batch-reconsider');
601
602   # mutex all affected batches
603   my %pay_batch_for_update;
604
605   my %bop2payby = (CC => 'CARD', ECHECK => 'CHEK');
606
607   BATCH: foreach my $batch (@batches) {
608
609     my %incoming_batch = (
610       'CARD' => {},
611       'CHEK' => {},
612     );
613
614     ITEM: foreach my $item ($batch->elements) {
615
616       my $cust_pay_batch; # the new batch entry (with status)
617       my $pay_batch; # the freeside batch it belongs to
618       my $payby; # CARD or CHEK
619       my $error;
620
621       my $paybatch = $gateway->gatewaynum .  '-' .  $gateway->gateway_module .
622         ':' . ($item->authorization || '') .
623         ':' . ($item->order_number || '');
624
625       if ( $batch->incoming ) {
626         # This is a one-way batch.
627         # Locate the customer, find an open batch correct for them,
628         # create a payment.  Don't bother creating a cust_pay_batch
629         # entry.
630         my $cust_main;
631         if ( defined($item->customer_id) 
632              and $item->customer_id =~ /^\d+$/ 
633              and $item->customer_id > 0 ) {
634
635           $cust_main = FS::cust_main->by_key($item->customer_id)
636                        || qsearchs('cust_main', 
637                          { 'agent_custid' => $item->customer_id }
638                        );
639           if ( !$cust_main ) {
640             push @item_errors, "Unknown customer_id ".$item->customer_id;
641             next ITEM;
642           }
643         }
644         else {
645           push @item_errors, "Illegal customer_id '".$item->customer_id."'";
646           next ITEM;
647         }
648         # it may also make sense to allow selecting the customer by 
649         # invoice_number, but no modules currently work that way
650
651         $payby = $bop2payby{ $item->payment_type };
652         my $agentnum = '';
653         $agentnum = $cust_main->agentnum if $conf->exists('batch-spoolagent');
654
655         # create a batch if necessary
656         $pay_batch = $incoming_batch{$payby}->{$agentnum} ||= 
657           FS::pay_batch->new({
658               status    => 'R', # pre-resolve it
659               payby     => $payby,
660               agentnum  => $agentnum,
661               upload    => time,
662               title     => $batch->batch_id,
663           });
664         if ( !$pay_batch->batchnum ) {
665           $error = $pay_batch->insert;
666           die $error if $error; # can't do anything if this fails
667         }
668
669         if ( !$item->approved ) {
670           $error ||= "payment rejected - ".$item->error_message;
671         }
672         if ( !defined($item->amount) or $item->amount <= 0 ) {
673           $error ||= "no amount in item $num";
674         }
675
676         my $payinfo;
677         if ( $item->check_number ) {
678           $payby = 'BILL'; # right?
679           $payinfo = $item->check_number;
680         } elsif ( $item->assigned_token ) {
681           $payinfo = $item->assigned_token;
682         }
683         # create the payment
684         my $cust_pay = FS::cust_pay->new(
685           {
686             custnum     => $cust_main->custnum,
687             _date       => $item->payment_date->epoch,
688             paid        => sprintf('%.2f',$item->amount),
689             payby       => $payby,
690             invnum      => $item->invoice_number,
691             batchnum    => $pay_batch->batchnum,
692             payinfo     => $payinfo,
693             gatewaynum  => $gateway->gatewaynum,
694             processor   => $gateway->gateway_module,
695             auth        => $item->authorization,
696             order_number => $item->order_number,
697           }
698         );
699         $error ||= $cust_pay->insert;
700         eval { $cust_main->apply_payments };
701         $error ||= $@;
702
703         if ( $error ) {
704           push @item_errors, 'Payment for customer '.$item->customer_id."\n$error";
705         }
706
707       } else {
708         # This is a request/reply batch.
709         # Locate the request (the 'tid' attribute is the paybatchnum).
710         my $paybatchnum = $item->tid;
711         $cust_pay_batch = FS::cust_pay_batch->by_key($paybatchnum);
712         if (!$cust_pay_batch) {
713           push @item_errors, "paybatchnum $paybatchnum not found";
714           next ITEM;
715         }
716         $payby = $cust_pay_batch->payby;
717
718         my $batchnum = $cust_pay_batch->batchnum;
719         if ( $batch->batch_id and $batch->batch_id != $batchnum ) {
720           warn "batch ID ".$batch->batch_id.
721                 " does not match batchnum ".$cust_pay_batch->batchnum."\n";
722         }
723
724         # lock the batch and check its status
725         $pay_batch = FS::pay_batch->by_key($batchnum);
726         $pay_batch_for_update{$batchnum} ||= $pay_batch->select_for_update;
727         if ( $pay_batch->status ne 'I' and !$reconsider ) {
728           $error = "batch $batchnum no longer in transit";
729         }
730
731         if ( $cust_pay_batch->status ) {
732           my $new_status = $item->approved ? 'approved' : 'declined';
733           if ( lc( $cust_pay_batch->status ) eq $new_status ) {
734             # already imported with this status, so don't touch
735             next ITEM;
736           }
737           elsif ( !$reconsider ) {
738             # then we're not allowed to change its status, so bail out
739             $error = "paybatchnum ".$item->tid.
740             " already resolved with status '". $cust_pay_batch->status . "'";
741           }
742         }
743
744         if ( $error ) {        
745           push @item_errors, "Payment for customer ".$cust_pay_batch->custnum."\n$error";
746           next ITEM;
747         }
748
749         my $new_payinfo;
750         # update payinfo, if needed
751         if ( $item->assigned_token ) {
752           $new_payinfo = $item->assigned_token;
753         } elsif ( $payby eq 'CARD' ) {
754           $new_payinfo = $item->card_number if $item->card_number;
755         } else { #$payby eq 'CHEK'
756           $new_payinfo = $item->account_number . '@' . $item->routing_code
757             if $item->account_number;
758         }
759         $cust_pay_batch->set('payinfo', $new_payinfo) if $new_payinfo;
760
761         # set "paid" pseudo-field (transfers to cust_pay) to the actual amount
762         # paid, if the batch says it's different from the amount requested
763         if ( defined $item->amount ) {
764           $cust_pay_batch->set('paid', $item->amount);
765         } else {
766           $cust_pay_batch->set('paid', $cust_pay_batch->amount);
767         }
768
769         # set payment date to when it was processed
770         $cust_pay_batch->_date($item->payment_date->epoch)
771           if $item->payment_date;
772
773         # approval status
774         if ( $item->approved ) {
775           # follow Billing_Realtime format for paybatch
776           $error = $cust_pay_batch->approve(
777             'gatewaynum'    => $gateway->gatewaynum,
778             'processor'     => $gateway->gateway_module,
779             'auth'          => $item->authorization,
780             'order_number'  => $item->order_number,
781           );
782           $total += $cust_pay_batch->paid;
783         }
784         else {
785           $error = $cust_pay_batch->decline($item->error_message,
786                                             $item->failure_status);
787         }
788
789         if ( $error ) {        
790           push @item_errors, "Payment for customer ".$cust_pay_batch->custnum."\n$error";
791           next ITEM;
792         }
793       } # $batch->incoming
794
795       $num++;
796       $job->update_statustext(int(100 * $num/( $total_items ) ),
797         'Importing batch items')
798       if $job;
799
800     } #foreach $item
801
802   } #foreach $batch (input batch, not pay_batch)
803
804   # Format an error message
805   if ( @item_errors ) {
806     my $error_text = join("\n\n", 
807       "Errors during batch import: ".scalar(@item_errors),
808       @item_errors
809     );
810     if ( $errors_not_fatal ) {
811       my $message = "Import from gateway ".$gateway->label." errors: ".$error_text;
812       my $log = FS::Log->new('FS::pay_batch::import_from_gateway');
813       $log->error($message);
814     } else {
815       # Bail out.
816       $dbh->rollback if $oldAutoCommit;
817       die $error_text;
818     }
819   }
820
821   # Auto-resolve (with brute-force error handling)
822   foreach my $pay_batch (values %pay_batch_for_update) {
823     my $error = $pay_batch->try_to_resolve;
824
825     if ( $error ) {
826       $dbh->rollback if $oldAutoCommit;
827       return $error;
828     }
829   }
830
831   $dbh->commit if $oldAutoCommit;
832   return;
833 }
834
835 =item try_to_resolve
836
837 Resolve this batch if possible.  A batch can be resolved if all of its
838 entries have status.  If the system options 'batch-auto_resolve_days'
839 and 'batch-auto_resolve_status' are set, and the batch's download date is
840 at least (batch-auto_resolve_days) before the current time, then it can
841 be auto-resolved; entries with no status will be approved or declined 
842 according to the batch-auto_resolve_status setting.
843
844 =cut
845
846 sub try_to_resolve {
847   my $self = shift;
848   my $conf = FS::Conf->new;;
849
850   return if $self->status ne 'I';
851
852   my @unresolved = qsearch('cust_pay_batch',
853     {
854       batchnum => $self->batchnum,
855       status   => ''
856     }
857   );
858
859   if ( @unresolved and $conf->exists('batch-auto_resolve_days') ) {
860     my $days = $conf->config('batch-auto_resolve_days'); # can be zero
861     # either 'approve' or 'decline'
862     my $action = $conf->config('batch-auto_resolve_status') || '';
863     return unless 
864       length($days) and 
865       length($action) and
866       time > ($self->download + 86400 * $days)
867       ;
868
869     my $error;
870     foreach my $cpb (@unresolved) {
871       if ( $action eq 'approve' ) {
872         # approve it for the full amount
873         $cpb->set('paid', $cpb->amount) unless ($cpb->paid || 0) > 0;
874         $error = $cpb->approve($self->batchnum);
875       }
876       elsif ( $action eq 'decline' ) {
877         $error = $cpb->decline('No response from processor');
878       }
879       return $error if $error;
880     }
881   } elsif ( @unresolved ) {
882     # auto resolve is not enabled, and we're not ready to resolve
883     return;
884   }
885
886   $self->set_status('R');
887 }
888
889 =item prepare_for_export
890
891 Prepare the batch to be exported.  This will:
892 - Set the status to "in transit".
893 - If batch-increment_expiration is set and this is a credit card batch,
894   increment expiration dates that are in the past.
895 - If this is the first download for this batch, adjust payment amounts to 
896   not be greater than the customer's current balance.  If the customer's 
897   balance is zero, the entry will be removed (caution: all cust_pay_batch
898   entries might be removed!)
899
900 Use this within a transaction.
901
902 =cut
903
904 sub prepare_for_export {
905   my $self = shift;
906   my $conf = FS::Conf->new;
907   my $curuser = $FS::CurrentUser::CurrentUser;
908
909   my $first_download;
910   my $status = $self->status;
911   if ($status eq 'O') {
912     $first_download = 1;
913   } elsif ($status eq 'I' && $curuser->access_right('Reprocess batches')) {
914     $first_download = 0;
915   } elsif ($status eq 'R' && 
916            $curuser->access_right('Redownload resolved batches')) {
917     $first_download = 0;
918   } else {
919     die "No pending batch.\n";
920   }
921
922   my @cust_pay_batch = sort { $a->paybatchnum <=> $b->paybatchnum } 
923                        $self->cust_pay_batch;
924   
925   # handle batch-increment_expiration option
926   if ( $self->payby eq 'CARD' ) {
927     my ($cmon, $cyear) = (localtime(time))[4,5];
928     foreach (@cust_pay_batch) {
929       my $etime = str2time($_->exp) or next;
930       my ($day, $mon, $year) = (localtime($etime))[3,4,5];
931       if( $conf->exists('batch-increment_expiration') ) {
932         $year++ while( $year < $cyear or ($year == $cyear and $mon <= $cmon) );
933         $_->exp( sprintf('%4u-%02u-%02u', $year + 1900, $mon+1, $day) );
934       }
935       my $error = $_->replace;
936       return $error if $error;
937     }
938   }
939
940   if ($first_download) { #remove or reduce entries if customer's balance changed
941
942     foreach my $cust_pay_batch (@cust_pay_batch) {
943
944       my $balance = $cust_pay_batch->cust_main->balance;
945       if ($balance <= 0) { # then don't charge this customer
946         my $error = $cust_pay_batch->unbatch_and_delete;
947         return $error if $error;
948       } elsif ($balance < $cust_pay_batch->amount) {
949         # reduce the charge to the remaining balance
950         $cust_pay_batch->amount($balance);
951         my $error = $cust_pay_batch->replace;
952         return $error if $error;
953       }
954       # else $balance >= $cust_pay_batch->amount
955     }
956
957     #need to do this after unbatch_and_delete
958     my $error = $self->set_status('I');
959     return "error updating pay_batch status: $error\n" if $error;
960
961   } #if $first_download
962
963   '';
964 }
965
966 =item export_batch [ format => FORMAT | gateway => GATEWAY ]
967
968 Export batch for processing.  FORMAT is the name of an L<FS::pay_batch> 
969 module, in which case the configuration options are in 'batchconfig-FORMAT'.
970
971 Alternatively, GATEWAY can be an L<FS::payment_gateway> object set to a
972 L<Business::BatchPayment> module.
973
974 Returns the text of the batch.  If batch contains no cust_pay_batch entries
975 (or has them all removed by L</prepare_for_export>) then the batch will be 
976 resolved and a blank string will be returned.  All other errors are fatal.
977
978 =cut
979
980 sub export_batch {
981   my $self = shift;
982   my %opt = @_;
983
984   my $conf = new FS::Conf;
985   my $batch;
986
987   my $gateway = $opt{'gateway'};
988   if ( $gateway ) {
989     # welcome to the future
990     my $fh = IO::Scalar->new(\$batch);
991     $self->export_to_gateway($gateway, 'file' => $fh);
992     return $batch;
993   }
994
995   my $format = $opt{'format'} || $conf->config('batch-default_format')
996     or die "No batch format configured\n";
997
998   my $info = $export_info{$format} or die "Format not found: '$format'\n";
999
1000   &{$info->{'init'}}($conf, $self->agentnum) if exists($info->{'init'});
1001
1002   my $oldAutoCommit = $FS::UID::AutoCommit;
1003   local $FS::UID::AutoCommit = 0;
1004   my $dbh = dbh;  
1005
1006   my $error = $self->prepare_for_export;
1007
1008   die $error if $error;
1009   my $batchtotal = 0;
1010   my $batchcount = 0;
1011
1012   my @cust_pay_batch = $self->cust_pay_batch;
1013   unless (@cust_pay_batch) {
1014     # if it's empty, just resolve the batch
1015     $self->set_status('R');
1016     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1017     return '';
1018   }
1019
1020   my $delim = exists($info->{'delimiter'}) ? $info->{'delimiter'} : "\n";
1021
1022   my $h = $info->{'header'};
1023   if (ref($h) eq 'CODE') {
1024     $batch .= &$h($self, \@cust_pay_batch). $delim;
1025   } else {
1026     $batch .= $h. $delim;
1027   }
1028
1029   foreach my $cust_pay_batch (@cust_pay_batch) {
1030     $batchcount++;
1031     $batchtotal += $cust_pay_batch->amount;
1032     $batch .=
1033     &{$info->{'row'}}($cust_pay_batch, $self, $batchcount, $batchtotal).
1034     $delim;
1035   }
1036
1037   my $f = $info->{'footer'};
1038   if (ref($f) eq 'CODE') {
1039     $batch .= &$f($self, $batchcount, $batchtotal). $delim;
1040   } else {
1041     $batch .= $f. $delim;
1042   }
1043
1044   if ($info->{'autopost'}) {
1045     my $error = &{$info->{'autopost'}}($self, $batch);
1046     if($error) {
1047       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1048       die $error;
1049     }
1050   }
1051
1052   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1053   return $batch;
1054 }
1055
1056 =item export_to_gateway GATEWAY OPTIONS
1057
1058 Given L<FS::payment_gateway> GATEWAY, export the items in this batch to 
1059 that gateway via Business::BatchPayment. OPTIONS may include:
1060
1061 - file: override the default transport and write to this file (name or handle)
1062
1063 If batch contains no cust_pay_batch entries (or has them all removed by 
1064 L</prepare_for_export>) then nothing will be transported (or written to 
1065 the override file) and the batch will be resolved.
1066
1067 =cut
1068
1069 sub export_to_gateway {
1070
1071   my ($self, $gateway, %opt) = @_;
1072   
1073   my $oldAutoCommit = $FS::UID::AutoCommit;
1074   local $FS::UID::AutoCommit = 0;
1075   my $dbh = dbh;  
1076
1077   my $error = $self->prepare_for_export;
1078   die $error if $error;
1079
1080   my %proc_opt = (
1081     'output' => $opt{'file'}, # will do nothing if it's empty
1082     # any other constructor options go here
1083   );
1084   my $processor = $gateway->batch_processor(%proc_opt);
1085
1086   my @items = map { $_->request_item } $self->cust_pay_batch;
1087   unless (@items) {
1088     # if it's empty, just resolve the batch
1089     $self->set_status('R');
1090     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1091     return '';
1092   }
1093
1094   try {
1095     my $batch = Business::BatchPayment->create(Batch =>
1096       batch_id  => $self->batchnum,
1097       items     => \@items
1098     );
1099     $processor->submit($batch);
1100
1101     if ($batch->processor_id) {
1102       $self->set('processor_id',$batch->processor_id);
1103       $self->replace;
1104     }
1105   } catch {
1106     $dbh->rollback if $oldAutoCommit;
1107     die $_;
1108   };
1109
1110   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1111   '';
1112 }
1113
1114 sub manual_approve {
1115   my $self = shift;
1116   my $date = time;
1117   my %opt = @_;
1118   my $usernum = $opt{'usernum'} || die "manual approval requires a usernum";
1119   my $conf = FS::Conf->new;
1120   return 'manual batch approval disabled' 
1121     if ( ! $conf->exists('batch-manual_approval') );
1122   return 'batch already resolved' if $self->status eq 'R';
1123   return 'batch not yet submitted' if $self->status eq 'O';
1124
1125   local $SIG{HUP} = 'IGNORE';
1126   local $SIG{INT} = 'IGNORE';
1127   local $SIG{QUIT} = 'IGNORE';
1128   local $SIG{TERM} = 'IGNORE';
1129   local $SIG{TSTP} = 'IGNORE';
1130   local $SIG{PIPE} = 'IGNORE';
1131
1132   my $oldAutoCommit = $FS::UID::AutoCommit;
1133   local $FS::UID::AutoCommit = 0;
1134   my $dbh = dbh;
1135
1136   my $payments = 0;
1137   foreach my $cust_pay_batch ( 
1138     qsearch('cust_pay_batch', { batchnum => $self->batchnum,
1139         status   => '' })
1140   ) {
1141     my $new_cust_pay_batch = new FS::cust_pay_batch { 
1142       $cust_pay_batch->hash,
1143       'paid'    => $cust_pay_batch->amount,
1144       '_date'   => $date,
1145       'usernum' => $usernum,
1146     };
1147     my $error = $new_cust_pay_batch->approve();
1148     # there are no approval options here (authorization, order_number, etc.)
1149     # because the transaction wasn't really approved
1150     if ( $error ) {
1151       $dbh->rollback;
1152       return 'paybatchnum '.$cust_pay_batch->paybatchnum.": $error";
1153     }
1154     $payments++;
1155   }
1156   $self->set_status('R');
1157   $dbh->commit;
1158   return;
1159 }
1160
1161 =item batch_download_formats
1162
1163 returns a hash of batch download formats.
1164
1165 my %download_formats = FS::pay_batch::batch_download_formats;
1166
1167 =cut
1168
1169 sub batch_download_formats {
1170
1171   my @formats = (
1172     ''              =>
1173         'Default batch mode',
1174     'NACHA'         =>
1175         '94 byte NACHA',
1176     'csv-td_canada_trust-merchant_pc_batch' =>
1177         'CSV file for TD Canada Trust Merchant PC Batch',
1178     'csv-chase_canada-E-xactBatch' =>
1179         'CSV file for Chase Canada E-xactBatch',
1180     'PAP'           =>
1181         '80 byte file for TD Canada Trust PAP Batch',
1182     'BoM'           =>
1183         'Bank of Montreal ECA batch',
1184     'ach-spiritone' =>
1185         'Spiritone ACH batch',
1186     'paymentech'    =>
1187         'XML file for Chase Paymentech',
1188     'RBC'           =>
1189         'Royal Bank of Canada PDS batch',
1190     'td_eft1464'    =>
1191         '1464 byte file for TD Commercial Banking EFT',
1192     'eft_canada'    =>
1193         'EFT Canada CSV batch',
1194     'CIBC'          =>
1195         '80 byte file for Canadian Imperial Bank of Commerce',
1196     # insert new batch formats here
1197   );
1198
1199 }
1200
1201 =item batch_download_formats
1202
1203 returns a hash of batch download formats.
1204
1205 my %download_formats = FS::pay_batch::batch_download_formats;
1206
1207 =cut
1208
1209 sub can_handle_electronic_refunds {
1210
1211   my $self = shift;
1212   my $format = shift;
1213   my $conf = new FS::Conf;
1214
1215   tie my %download_formats, 'Tie::IxHash', batch_download_formats;
1216
1217   my %paybatch_mods = (
1218     'NACHA'                                 => 'nacha',
1219     'csv-td_canada_trust-merchant_pc_batch' => 'td_canada_trust',
1220     'csv-chase_canada-E-xactBatch'          => 'chase-canada',
1221     'PAP'                                   => 'PAP',
1222     'BoM'                                   => 'BoM',
1223     'ach-spiritone'                         => 'ach_spiritone',
1224     'paymentech'                            => 'paymentech',
1225     'RBC'                                   => 'RBC',
1226     'td_eft1464'                            => 'td_eft1464',
1227     'eft_canada'                            => 'eft_canada',
1228     'CIBC'                                  => 'CIBC',
1229   );
1230
1231   %download_formats = ( $format => $download_formats{$format}, ) if $format;
1232
1233   foreach my $key (keys %download_formats) {
1234     my $mod = "FS::pay_batch::".$paybatch_mods{$key};
1235     if ($mod->can('can_handle_credits')) {
1236       return '1' if $conf->exists('batchconfig-'.$key);
1237     }
1238   }
1239
1240   return;
1241
1242 }
1243
1244 use FS::upgrade_journal;
1245 sub _upgrade_data {
1246
1247   # check if there are any pending batch refunds and no download format configured
1248   # that allows electronic refunds.
1249   unless ( FS::upgrade_journal->is_done('removed_refunds_nodownload_format') ) {
1250
1251     ## get a list of all refunds in batches.
1252     my $extrasql = " LEFT JOIN pay_batch USING ( batchnum ) WHERE cust_pay_batch.paycode = 'C' AND pay_batch.download IS NULL AND pay_batch.type = 'DEBIT' ";
1253
1254     my @batch_refunds = qsearch({
1255       'table'   => 'cust_pay_batch',
1256       'select'  => 'cust_pay_batch.*',
1257       'extra_sql' => $extrasql,
1258     });
1259
1260     my $replace_error;
1261
1262     if (@batch_refunds) {
1263       warn "found ".scalar @batch_refunds." batch refunds.\n";
1264       warn "Searching for their cust refunds...\n" if (scalar @batch_refunds > 0);
1265
1266       my $oldAutoCommit = $FS::UID::AutoCommit;
1267       local $FS::UID::AutoCommit = 0;
1268       my $dbh = dbh;
1269
1270       ## move refund to credit batch.
1271       foreach my $cust_pay_batch (@batch_refunds) {
1272         my $payby = $cust_pay_batch->payby eq "CARD" ? "CARD" : "CHEK";
1273
1274         my %pay_batch = (
1275           'status' => 'O',
1276           'payby'  => $payby,
1277           'type'   => 'CREDIT',
1278         );
1279
1280         my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
1281
1282         unless ( $pay_batch ) {
1283           $pay_batch = new FS::pay_batch \%pay_batch;
1284           my $error = $pay_batch->insert;
1285           if ( $error ) {
1286             $dbh->rollback if $oldAutoCommit;
1287             warn "error creating a $payby credit batch: $error\n";
1288           }
1289         }
1290
1291         $cust_pay_batch->batchnum($pay_batch->batchnum);
1292         $replace_error = $cust_pay_batch->replace();
1293         if ( $replace_error ) {
1294           $dbh->rollback if $oldAutoCommit;
1295           warn "Unable to move credit to a credit batch: $replace_error";
1296         }
1297         else {
1298           warn "Moved cust pay credit ".$cust_pay_batch->paybatchnum." to ".$cust_pay_batch->payby." credit batch ".$cust_pay_batch->batchnum."\n";
1299         }
1300       }
1301     } #end @batch_refunds
1302     else { warn "No batch refunds found\n"; }
1303
1304     FS::upgrade_journal->set_done('removed_refunds_nodownload_format') unless $replace_error;
1305   }
1306
1307   # Set up configuration for gateways that have a Business::BatchPayment
1308   # module.
1309   
1310   eval "use Class::MOP;";
1311   if ( $@ ) {
1312     warn "Moose/Class::MOP not available.\n$@\nSkipping pay_batch upgrade.\n";
1313     return;
1314   }
1315   my $conf = FS::Conf->new;
1316   for my $format (keys %export_info) {
1317     my $mod = "FS::pay_batch::$format";
1318     if ( $mod->can('_upgrade_gateway') 
1319         and $conf->exists("batchconfig-$format") ) {
1320
1321       local $@;
1322       my ($module, %gw_options) = $mod->_upgrade_gateway;
1323       my $gateway = FS::payment_gateway->new({
1324           gateway_namespace => 'Business::BatchPayment',
1325           gateway_module    => $module,
1326       });
1327       my $error = $gateway->insert(%gw_options);
1328       if ( $error ) {
1329         warn "Failed to migrate '$format' to a Business::BatchPayment::$module gateway:\n$error\n";
1330         next;
1331       }
1332
1333       # test whether it loads
1334       my $processor = eval { $gateway->batch_processor };
1335       if ( !$processor ) {
1336         warn "Couldn't load Business::BatchPayment module for '$format'.\n";
1337         # if not, remove it so it doesn't hang around and break things
1338         $gateway->delete;
1339       }
1340       else {
1341         # remove the batchconfig-*
1342         warn "Created Business::BatchPayment gateway '".$gateway->label.
1343              "' for '$format' batch processing.\n";
1344         $conf->delete("batchconfig-$format");
1345
1346         # and if appropriate, make it the system default
1347         for my $payby (qw(CARD CHEK)) {
1348           if ( ($conf->config("batch-fixed_format-$payby") || '') eq $format ) {
1349             warn "Setting as default for $payby.\n";
1350             $conf->set("batch-gateway-$payby", $gateway->gatewaynum);
1351             $conf->delete("batch-fixed_format-$payby");
1352           }
1353         }
1354       } # if $processor
1355     } #if can('_upgrade_gateway') and batchconfig-$format
1356   } #for $format
1357
1358   '';
1359 }
1360
1361 =back
1362
1363 =head1 BUGS
1364
1365 status is somewhat redundant now that download and upload exist
1366
1367 =head1 SEE ALSO
1368
1369 L<FS::Record>, schema.html from the base documentation.
1370
1371 =cut
1372
1373 1;
1374