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 =head1 NAME
  20
  21 FS::cust_pay_batch - Object methods for batch cards
  22
  23 =head1 SYNOPSIS
  24
  25   use FS::cust_pay_batch;
  26
  27   $record = new FS::cust_pay_batch \%hash;
  28   $record = new FS::cust_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   #deprecated# $error = $record->retriable;
  39
  40 =head1 DESCRIPTION
  41
  42 An FS::cust_pay_batch object represents a credit card transaction ready to be
  43 batched (sent to a processor).  FS::cust_pay_batch inherits from FS::Record.
  44 Typically called by the collect method of an FS::cust_main object.  The
  45 following fields are currently supported:
  46
  47 =over 4
  48
  49 =item paybatchnum - primary key (automatically assigned)
  50
  51 =item batchnum - indentifies group in batch
  52
  53 =item payby - CARD/CHEK/LECB/BILL/COMP
  54
  55 =item payinfo
  56
  57 =item exp - card expiration
  58
  59 =item amount
  60
  61 =item invnum - invoice
  62
  63 =item custnum - customer
  64
  65 =item payname - name on card
  66
  67 =item first - name
  68
  69 =item last - name
  70
  71 =item address1
  72
  73 =item address2
  74
  75 =item city
  76
  77 =item state
  78
  79 =item zip
  80
  81 =item country
  82
  83 =item status - 'Approved' or 'Declined'
  84
  85 =item error_message - the error returned by the gateway if any
  86
  87 =item failure_status - the normalized L<Business::BatchPayment> failure
  88 status, 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 "paybatchnum $paybatchnum not found";
 315   # leave these restrictions in place until TD EFT is converted over
 316   # to B::BP
 317   return "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 updating status of 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 [ STATUS ] ]
 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', and will go into the "error_message" field.
 354
 355 STATUS is a normalized failure status defined by L<Business::BatchPayment>,
 356 and will go into the "failure_status" field.
 357
 358 =cut
 359
 360 sub decline {
 361   my $new = shift;
 362   my $reason = shift || 'Returned payment';
 363   my $failure_status = shift || '';
 364   #my $conf = new FS::Conf;
 365
 366   my $paybatchnum = $new->paybatchnum;
 367   my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
 368     or return "paybatchnum $paybatchnum not found";
 369   if ( $old->status ) {
 370     # Handle the case where payments are rejected after the batch has been
 371     # approved.  FS::pay_batch::import_results won't allow results to be
 372     # imported to a closed batch unless batch-manual_approval is enabled,
 373     # so we don't check it here.
 374 #    if ( $conf->exists('batch-manual_approval') and
 375     if ( lc($old->status) eq 'approved' ) {
 376       # Void the payment
 377       my $cust_pay = qsearchs('cust_pay', {
 378           custnum  => $new->custnum,
 379           batchnum => $new->batchnum
 380         });
 381       # these should all be migrated over, but if it's not found, look for
 382       # batchnum in the 'paybatch' field also
 383       $cust_pay ||= qsearchs('cust_pay', {
 384           custnum  => $new->custnum,
 385           paybatch => $new->batchnum
 386         });
 387       if ( !$cust_pay ) {
 388         # should never happen...
 389         return "failed to revoke paybatchnum $paybatchnum, payment not found";
 390       }
 391       $cust_pay->void($reason);
 392     }
 393     else {
 394       # normal case: refuse to do anything
 395       return "paybatchnum $paybatchnum already resolved ('".$old->status."')";
 396     }
 397   } # !$old->status
 398   $new->status('Declined');
 399   $new->error_message($reason);
 400   $new->failure_status($failure_status);
 401   my $error = $new->replace($old);
 402   if ( $error ) {
 403     return "error updating status of paybatchnum $paybatchnum: $error\n";
 404   }
 405   my $due_cust_event = $new->cust_main->due_cust_event(
 406     'eventtable'  => 'cust_pay_batch',
 407     'objects'     => [ $new ],
 408   );
 409   if ( !ref($due_cust_event) ) {
 410     return $due_cust_event;
 411   }
 412   # XXX breaks transaction integrity
 413   foreach my $cust_event (@$due_cust_event) {
 414     next unless $cust_event->test_conditions;
 415     if ( my $error = $cust_event->do_event() ) {
 416       return $error;
 417     }
 418   }
 419   return;
 420 }
 421
 422 =item request_item [ OPTIONS ]
 423
 424 Returns a L<Business::BatchPayment::Item> object for this batch payment
 425 entry.  This can be submitted to a processor.
 426
 427 OPTIONS can be a list of key/values to append to the attributes.  The most
 428 useful case of this is "process_date" to set a processing date based on the
 429 date the batch is being submitted.
 430
 431 =cut
 432
 433 sub request_item {
 434   local $@;
 435   my $self = shift;
 436
 437   eval "use Business::BatchPayment;";
 438   die "couldn't load Business::BatchPayment: $@" if $@;
 439
 440   my $cust_main = $self->cust_main;
 441   my $location = $cust_main->bill_location;
 442   my $pay_batch = $self->pay_batch;
 443
 444   my %payment;
 445   $payment{payment_type} = FS::payby->payby2bop( $pay_batch->payby );
 446   if ( $payment{payment_type} eq 'CC' ) {
 447     $payment{card_number} = $self->payinfo,
 448     $payment{expiration}  = $self->expmmyy,
 449   } elsif ( $payment{payment_type} eq 'ECHECK' ) {
 450     $self->payinfo =~ /(\d+)@(\d+)/; # or else what?
 451     $payment{account_number} = $1;
 452     $payment{routing_code} = $2;
 453     $payment{account_type} = $cust_main->paytype;
 454     # XXX what if this isn't their regular payment method?
 455   } else {
 456     die "unsupported BatchPayment method: ".$pay_batch->payby;
 457   }
 458
 459   Business::BatchPayment->create(Item =>
 460     # required
 461     action      => 'payment',
 462     tid         => $self->paybatchnum,
 463     amount      => $self->amount,
 464
 465     # customer info
 466     customer_id => $self->custnum,
 467     first_name  => $cust_main->first,
 468     last_name   => $cust_main->last,
 469     company     => $cust_main->company,
 470     address     => $location->address1,
 471     ( map { $_ => $location->$_ } qw(address2 city state country zip) ),
 472
 473     invoice_number  => $self->invnum,
 474     %payment,
 475   );
 476 }
 477
 478 =back
 479
 480 =head1 BUGS
 481
 482 There should probably be a configuration file with a list of allowed credit
 483 card types.
 484
 485 =head1 SEE ALSO
 486
 487 L<FS::cust_main>, L<FS::Record>
 488
 489 =cut
 490
 491 1;
 492