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