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