FS/FS/cust_pay_batch.pm

   1 package FS::cust_pay_batch;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   5 use Carp qw( confess );
   6 use Business::CreditCard 0.28;
   7 use FS::Record qw(dbh qsearch qsearchs);
   8 use FS::payinfo_Mixin;
   9 use FS::cust_main;
  10 use FS::cust_bill;
  11
  12 @ISA = qw( FS::payinfo_Mixin FS::cust_main_Mixin FS::Record );
  13
  14 # 1 is mostly method/subroutine entry and options
  15 # 2 traces progress of some operations
  16 # 3 is even more information including possibly sensitive data
  17 $DEBUG = 0;
  18
  19 #@encrypted_fields = ('payinfo');
  20 sub nohistory_fields { ('payinfo'); }
  21
  22 =head1 NAME
  23
  24 FS::cust_pay_batch - Object methods for batch cards
  25
  26 =head1 SYNOPSIS
  27
  28   use FS::cust_pay_batch;
  29
  30   $record = new FS::cust_pay_batch \%hash;
  31   $record = new FS::cust_pay_batch { 'column' => 'value' };
  32
  33   $error = $record->insert;
  34
  35   $error = $new_record->replace($old_record);
  36
  37   $error = $record->delete;
  38
  39   $error = $record->check;
  40
  41   #deprecated# $error = $record->retriable;
  42
  43 =head1 DESCRIPTION
  44
  45 An FS::cust_pay_batch object represents a credit card transaction ready to be
  46 batched (sent to a processor).  FS::cust_pay_batch inherits from FS::Record.
  47 Typically called by the collect method of an FS::cust_main object.  The
  48 following fields are currently supported:
  49
  50 =over 4
  51
  52 =item paybatchnum - primary key (automatically assigned)
  53
  54 =item batchnum - indentifies group in batch
  55
  56 =item payby - CARD/CHEK/LECB/BILL/COMP
  57
  58 =item payinfo
  59
  60 =item exp - card expiration
  61
  62 =item amount
  63
  64 =item invnum - invoice
  65
  66 =item custnum - customer
  67
  68 =item payname - name on card
  69
  70 =item first - name
  71
  72 =item last - name
  73
  74 =item address1
  75
  76 =item address2
  77
  78 =item city
  79
  80 =item state
  81
  82 =item zip
  83
  84 =item country
  85
  86 =item status - 'Approved' or 'Declined'
  87
  88 =item error_message - the error returned by the gateway if any
  89
  90 =back
  91
  92 =head1 METHODS
  93
  94 =over 4
  95
  96 =item new HASHREF
  97
  98 Creates a new record.  To add the record to the database, see L<"insert">.
  99
 100 Note that this stores the hash reference, not a distinct copy of the hash it
 101 points to.  You can ask the object for a copy with the I<hash> method.
 102
 103 =cut
 104
 105 sub table { 'cust_pay_batch'; }
 106
 107 =item insert
 108
 109 Adds this record to the database.  If there is an error, returns the error,
 110 otherwise returns false.
 111
 112 =item delete
 113
 114 Delete this record from the database.  If there is an error, returns the error,
 115 otherwise returns false.
 116
 117 =item replace OLD_RECORD
 118
 119 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 120 returns the error, otherwise returns false.
 121
 122 =item check
 123
 124 Checks all fields to make sure this is a valid transaction.  If there is
 125 an error, returns the error, otherwise returns false.  Called by the insert
 126 and replace methods.
 127
 128 =cut
 129
 130 sub check {
 131   my $self = shift;
 132
 133   my $error =
 134       $self->ut_numbern('paybatchnum')
 135     || $self->ut_numbern('trancode') #deprecated
 136     || $self->ut_money('amount')
 137     || $self->ut_number('invnum')
 138     || $self->ut_number('custnum')
 139     || $self->ut_text('address1')
 140     || $self->ut_textn('address2')
 141     || $self->ut_text('city')
 142     || $self->ut_textn('state')
 143   ;
 144
 145   return $error if $error;
 146
 147   $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
 148   $self->setfield('last',$1);
 149
 150   $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name";
 151   $self->first($1);
 152
 153   $error = $self->payinfo_check();
 154   return $error if $error;
 155
 156   if ( $self->exp eq '' ) {
 157     return "Expiration date required"
 158       unless $self->payby =~ /^(CHEK|DCHK|LECB|WEST)$/;
 159     $self->exp('');
 160   } else {
 161     if ( $self->exp =~ /^(\d{4})[\/\-](\d{1,2})[\/\-](\d{1,2})$/ ) {
 162       $self->exp("$1-$2-$3");
 163     } elsif ( $self->exp =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
 164       if ( length($2) == 4 ) {
 165         $self->exp("$2-$1-01");
 166       } elsif ( $2 > 98 ) { #should pry change to check for "this year"
 167         $self->exp("19$2-$1-01");
 168       } else {
 169         $self->exp("20$2-$1-01");
 170       }
 171     } else {
 172       return "Illegal expiration date";
 173     }
 174   }
 175
 176   if ( $self->payname eq '' ) {
 177     $self->payname( $self->first. " ". $self->getfield('last') );
 178   } else {
 179     $self->payname =~ /^([\w \,\.\-\']+)$/
 180       or return "Illegal billing name";
 181     $self->payname($1);
 182   }
 183
 184   #we have lots of old zips in there... don't hork up batch results cause of em
 185   $self->zip =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
 186     or return "Illegal zip: ". $self->zip;
 187   $self->zip($1);
 188
 189   $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
 190   $self->country($1);
 191
 192   #$error = $self->ut_zip('zip', $self->country);
 193   #return $error if $error;
 194
 195   #check invnum, custnum, ?
 196
 197   $self->SUPER::check;
 198 }
 199
 200 =item cust_main
 201
 202 Returns the customer (see L<FS::cust_main>) for this batched credit card
 203 payment.
 204
 205 =cut
 206
 207 sub cust_main {
 208   my $self = shift;
 209   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 210 }
 211
 212 =item expmmyy
 213
 214 Returns the credit card expiration date in MMYY format.  If this is a
 215 CHEK payment, returns an empty string.
 216
 217 =cut
 218
 219 sub expmmyy {
 220   my $self = shift;
 221   if ( $self->payby eq 'CARD' ) {
 222     $self->get('exp') =~ /^(\d{4})-(\d{2})-(\d{2})$/;
 223     return sprintf('%02u%02u', $2, ($1 % 100));
 224   }
 225   else {
 226     return '';
 227   }
 228 }
 229
 230 =item pay_batch
 231
 232 Returns the payment batch this payment belongs to (L<FS::pay_batch).
 233
 234 =cut
 235
 236 sub pay_batch {
 237   my $self = shift;
 238   FS::pay_batch->by_key($self->batchnum);
 239 }
 240
 241 #you know what, screw this in the new world of events.  we should be able to
 242 #get the event defs to retry (remove once.pm condition, add every.pm) without
 243 #mucking about with statuses of previous cust_event records.  right?
 244 #
 245 #=item retriable
 246 #
 247 #Marks the corresponding event (see L<FS::cust_bill_event>) for this batched
 248 #credit card payment as retriable.  Useful if the corresponding financial
 249 #institution account was declined for temporary reasons and/or a manual
 250 #retry is desired.
 251 #
 252 #Implementation details: For the named customer's invoice, changes the
 253 #statustext of the 'done' (without statustext) event to 'retriable.'
 254 #
 255 #=cut
 256
 257 sub retriable {
 258
 259   confess "deprecated method cust_pay_batch->retriable called; try removing ".
 260           "the once condition and adding an every condition?";
 261
 262   my $self = shift;
 263
 264   local $SIG{HUP} = 'IGNORE';        #Hmm
 265   local $SIG{INT} = 'IGNORE';
 266   local $SIG{QUIT} = 'IGNORE';
 267   local $SIG{TERM} = 'IGNORE';
 268   local $SIG{TSTP} = 'IGNORE';
 269   local $SIG{PIPE} = 'IGNORE';
 270
 271   my $oldAutoCommit = $FS::UID::AutoCommit;
 272   local $FS::UID::AutoCommit = 0;
 273   my $dbh = dbh;
 274
 275   my $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
 276     or return "event $self->eventnum references nonexistant invoice $self->invnum";
 277
 278   warn "cust_pay_batch->retriable working with self of " . $self->paybatchnum . " and invnum of " . $self->invnum;
 279   my @cust_bill_event =
 280     sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
 281       grep {
 282         $_->part_bill_event->eventcode =~ /\$cust_bill->batch_card/
 283           && $_->status eq 'done'
 284           && ! $_->statustext
 285         }
 286       $cust_bill->cust_bill_event;
 287   # complain loudly if scalar(@cust_bill_event) > 1 ?
 288   my $error = $cust_bill_event[0]->retriable;
 289   if ($error ) {
 290     # gah, even with transactions.
 291     $dbh->commit if $oldAutoCommit; #well.
 292     return "error marking invoice event retriable: $error";
 293   }
 294   '';
 295 }
 296
 297 =item approve OPTIONS
 298
 299 Approve this payment.  This will replace the existing record with the
 300 same paybatchnum, set its status to 'Approved', and generate a payment
 301 record (L<FS::cust_pay>).  This should only be called from the batch
 302 import process.
 303
 304 OPTIONS may contain "gatewaynum", "processor", "auth", and "order_number".
 305
 306 =cut
 307
 308 sub approve {
 309   # to break up the Big Wall of Code that is import_results
 310   my $new = shift;
 311   my %opt = @_;
 312   my $paybatchnum = $new->paybatchnum;
 313   my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
 314     or return "cannot approve, paybatchnum $paybatchnum not found";
 315   # leave these restrictions in place until TD EFT is converted over
 316   # to B::BP
 317   return "cannot approve paybatchnum $paybatchnum, already resolved ('".$old->status."')"
 318     if $old->status;
 319   $new->status('Approved');
 320   my $error = $new->replace($old);
 321   if ( $error ) {
 322     return "error approving paybatchnum $paybatchnum: $error\n";
 323   }
 324   my $cust_pay = new FS::cust_pay ( {
 325       'custnum'   => $new->custnum,
 326       'payby'     => $new->payby,
 327       'payinfo'   => $new->payinfo || $old->payinfo,
 328       'paid'      => $new->paid,
 329       '_date'     => $new->_date,
 330       'usernum'   => $new->usernum,
 331       'batchnum'  => $new->batchnum,
 332       'gatewaynum'    => $opt{'gatewaynum'},
 333       'processor'     => $opt{'processor'},
 334       'auth'          => $opt{'auth'},
 335       'order_number'  => $opt{'order_number'}
 336     } );
 337
 338   $error = $cust_pay->insert;
 339   if ( $error ) {
 340     return "error inserting payment for paybatchnum $paybatchnum: $error\n";
 341   }
 342   $cust_pay->cust_main->apply_payments;
 343   return;
 344 }
 345
 346 =item decline [ REASON ]
 347
 348 Decline this payment.  This will replace the existing record with the
 349 same paybatchnum, set its status to 'Declined', and run collection events
 350 as appropriate.  This should only be called from the batch import process.
 351
 352 REASON is a string description of the decline reason, defaulting to
 353 'Returned payment'.
 354
 355 =cut
 356
 357 sub decline {
 358   my $new = shift;
 359   my $reason = shift || 'Returned payment';
 360   #my $conf = new FS::Conf;
 361
 362   my $paybatchnum = $new->paybatchnum;
 363   my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
 364     or return "cannot decline, paybatchnum $paybatchnum not found";
 365   if ( $old->status ) {
 366     # Handle the case where payments are rejected after the batch has been
 367     # approved.  FS::pay_batch::import_results won't allow results to be
 368     # imported to a closed batch unless batch-manual_approval is enabled,
 369     # so we don't check it here.
 370 #    if ( $conf->exists('batch-manual_approval') and
 371     if ( lc($old->status) eq 'approved' ) {
 372       # Void the payment
 373       my $cust_pay = qsearchs('cust_pay', {
 374           custnum  => $new->custnum,
 375           batchnum => $new->batchnum
 376         });
 377       # these should all be migrated over, but if it's not found, look for
 378       # batchnum in the 'paybatch' field also
 379       $cust_pay ||= qsearchs('cust_pay', {
 380           custnum  => $new->custnum,
 381           paybatch => $new->batchnum
 382         });
 383       if ( !$cust_pay ) {
 384         # should never happen...
 385         return "failed to revoke paybatchnum $paybatchnum, payment not found";
 386       }
 387       $cust_pay->void($reason);
 388     }
 389     else {
 390       # normal case: refuse to do anything
 391       return "cannot decline paybatchnum $paybatchnum, already resolved ('".$old->status."')";
 392     }
 393   } # !$old->status
 394   $new->status('Declined');
 395   $new->error_message($reason);
 396   my $error = $new->replace($old);
 397   if ( $error ) {
 398     return "error declining paybatchnum $paybatchnum: $error\n";
 399   }
 400   my $due_cust_event = $new->cust_main->due_cust_event(
 401     'eventtable'  => 'cust_pay_batch',
 402     'objects'     => [ $new ],
 403   );
 404   if ( !ref($due_cust_event) ) {
 405     return $due_cust_event;
 406   }
 407   # XXX breaks transaction integrity
 408   foreach my $cust_event (@$due_cust_event) {
 409     next unless $cust_event->test_conditions;
 410     if ( my $error = $cust_event->do_event() ) {
 411       return $error;
 412     }
 413   }
 414   return;
 415 }
 416
 417 =item request_item [ OPTIONS ]
 418
 419 Returns a L<Business::BatchPayment::Item> object for this batch payment
 420 entry.  This can be submitted to a processor.
 421
 422 OPTIONS can be a list of key/values to append to the attributes.  The most
 423 useful case of this is "process_date" to set a processing date based on the
 424 date the batch is being submitted.
 425
 426 =cut
 427
 428 sub request_item {
 429   local $@;
 430   my $self = shift;
 431
 432   eval "use Business::BatchPayment;";
 433   die "couldn't load Business::BatchPayment: $@" if $@;
 434
 435   my $cust_main = $self->cust_main;
 436   my $location = $cust_main->bill_location;
 437   my $pay_batch = $self->pay_batch;
 438
 439   my %payment;
 440   $payment{payment_type} = FS::payby->payby2bop( $pay_batch->payby );
 441   if ( $payment{payment_type} eq 'CC' ) {
 442     $payment{card_number} = $self->payinfo,
 443     $payment{expiration}  = $self->expmmyy,
 444   } elsif ( $payment{payment_type} eq 'ECHECK' ) {
 445     $self->payinfo =~ /(\d+)@(\d+)/; # or else what?
 446     $payment{account_number} = $1;
 447     $payment{routing_code} = $2;
 448     $payment{account_type} = $cust_main->paytype;
 449     # XXX what if this isn't their regular payment method?
 450   } else {
 451     die "unsupported BatchPayment method: ".$pay_batch->payby;
 452   }
 453
 454   Business::BatchPayment->create(Item =>
 455     # required
 456     action      => 'payment',
 457     tid         => $self->paybatchnum,
 458     amount      => $self->amount,
 459
 460     # customer info
 461     customer_id => $self->custnum,
 462     first_name  => $cust_main->first,
 463     last_name   => $cust_main->last,
 464     company     => $cust_main->company,
 465     address     => $location->address1,
 466     ( map { $_ => $location->$_ } qw(address2 city state country zip) ),
 467
 468     invoice_number  => $self->invnum,
 469     %payment,
 470   );
 471 }
 472
 473 =back
 474
 475 =head1 BUGS
 476
 477 There should probably be a configuration file with a list of allowed credit
 478 card types.
 479
 480 =head1 SEE ALSO
 481
 482 L<FS::cust_main>, L<FS::Record>
 483
 484 =cut
 485
 486 1;
 487