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   my $cust_pay = new FS::cust_pay ( {
 332       'custnum'   => $new->custnum,
 333       'payby'     => $new->payby,
 334       'payinfo'   => $new->payinfo || $old->payinfo,
 335       'paymask'   => $new->mask_payinfo,
 336       'paid'      => $new->paid,
 337       '_date'     => $new->_date,
 338       'usernum'   => $new->usernum,
 339       'batchnum'  => $new->batchnum,
 340       'gatewaynum'    => $opt{'gatewaynum'},
 341       'processor'     => $opt{'processor'},
 342       'auth'          => $opt{'auth'},
 343       'order_number'  => $opt{'order_number'}
 344     } );
 345
 346   $error = $cust_pay->insert;
 347   if ( $error ) {
 348     return "error inserting payment for paybatchnum $paybatchnum: $error\n";
 349   }
 350   $cust_pay->cust_main->apply_payments;
 351   return;
 352 }
 353
 354 =item decline [ REASON ]
 355
 356 Decline this payment.  This will replace the existing record with the
 357 same paybatchnum, set its status to 'Declined', and run collection events
 358 as appropriate.  This should only be called from the batch import process.
 359
 360 REASON is a string description of the decline reason, defaulting to
 361 'Returned payment'.
 362
 363 =cut
 364
 365 sub decline {
 366   my $new = shift;
 367   my $reason = shift || 'Returned payment';
 368   #my $conf = new FS::Conf;
 369
 370   my $paybatchnum = $new->paybatchnum;
 371   my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
 372     or return "cannot decline, paybatchnum $paybatchnum not found";
 373   if ( $old->status ) {
 374     # Handle the case where payments are rejected after the batch has been
 375     # approved.  FS::pay_batch::import_results won't allow results to be
 376     # imported to a closed batch unless batch-manual_approval is enabled,
 377     # so we don't check it here.
 378 #    if ( $conf->exists('batch-manual_approval') and
 379     if ( lc($old->status) eq 'approved' ) {
 380       # Void the payment
 381       my $cust_pay = qsearchs('cust_pay', {
 382           custnum  => $new->custnum,
 383           batchnum => $new->batchnum
 384         });
 385       # these should all be migrated over, but if it's not found, look for
 386       # batchnum in the 'paybatch' field also
 387       $cust_pay ||= qsearchs('cust_pay', {
 388           custnum  => $new->custnum,
 389           paybatch => $new->batchnum
 390         });
 391       if ( !$cust_pay ) {
 392         # should never happen...
 393         return "failed to revoke paybatchnum $paybatchnum, payment not found";
 394       }
 395       $cust_pay->void($reason);
 396     }
 397     else {
 398       # normal case: refuse to do anything
 399       return "cannot decline paybatchnum $paybatchnum, already resolved ('".$old->status."')";
 400     }
 401   } # !$old->status
 402   $new->status('Declined');
 403   $new->error_message($reason);
 404   my $error = $new->replace($old);
 405   if ( $error ) {
 406     return "error declining 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   my $recurring;
 463   if ( $cust_main->status =~ /^active|suspended|ordered$/ ) {
 464     if ( $self->payinfo_used ) {
 465       $recurring = 'S'; # subsequent
 466     } else {
 467       $recurring = 'F'; # first use
 468     }
 469   } else {
 470     $recurring = 'N'; # non-recurring
 471   }
 472
 473   Business::BatchPayment->create(Item =>
 474     # required
 475     action      => 'payment',
 476     tid         => $self->paybatchnum,
 477     amount      => $self->amount,
 478
 479     # customer info
 480     customer_id => $self->custnum,
 481     first_name  => $cust_main->first,
 482     last_name   => $cust_main->last,
 483     company     => $cust_main->company,
 484     address     => $location->address1,
 485     ( map { $_ => $location->$_ } qw(address2 city state country zip) ),
 486
 487     invoice_number  => $self->invnum,
 488     recurring_billing => $recurring,
 489     %payment,
 490   );
 491 }
 492
 493 =item process_unbatch_and_delete
 494
 495 L</unbatch_and_delete> run as a queued job, accepts I<$job> and I<$param>.
 496
 497 =cut
 498
 499 sub process_unbatch_and_delete {
 500   my ($job, $param) = @_;
 501   $param = thaw(decode_base64($param));
 502   my $self = qsearchs('cust_pay_batch',{ 'paybatchnum' => scalar($param->{'paybatchnum'}) })
 503     or die 'Could not find paybatchnum ' . $param->{'paybatchnum'};
 504   my $error = $self->unbatch_and_delete;
 505   die $error if $error;
 506   return '';
 507 }
 508
 509 =item unbatch_and_delete
 510
 511 May only be called on a record with an empty status and an associated
 512 L<FS::pay_batch> with a status of 'O' (not yet in transit.)  Deletes all associated
 513 records from L<FS::cust_bill_pay_batch> and then deletes this record.
 514 If there is an error, returns the error, otherwise returns false.
 515
 516 =cut
 517
 518 sub unbatch_and_delete {
 519   my $self = shift;
 520
 521   return 'Cannot unbatch a cust_pay_batch with status ' . $self->status
 522     if $self->status;
 523
 524   my $pay_batch = qsearchs('pay_batch',{ 'batchnum' => $self->batchnum })
 525     or return 'Cannot find associated pay_batch record';
 526
 527   return 'Cannot unbatch from a pay_batch with status ' . $pay_batch->status
 528     if $pay_batch->status ne 'O';
 529
 530   local $SIG{HUP} = 'IGNORE';
 531   local $SIG{INT} = 'IGNORE';
 532   local $SIG{QUIT} = 'IGNORE';
 533   local $SIG{TERM} = 'IGNORE';
 534   local $SIG{TSTP} = 'IGNORE';
 535   local $SIG{PIPE} = 'IGNORE';
 536
 537   my $oldAutoCommit = $FS::UID::AutoCommit;
 538   local $FS::UID::AutoCommit = 0;
 539   my $dbh = dbh;
 540
 541   # have not generated actual payments yet, so should be safe to delete
 542   foreach my $cust_bill_pay_batch (
 543     qsearch('cust_bill_pay_batch',{ 'paybatchnum' => $self->paybatchnum })
 544   ) {
 545     my $error = $cust_bill_pay_batch->delete;
 546     if ( $error ) {
 547       $dbh->rollback if $oldAutoCommit;
 548       return $error;
 549     }
 550   }
 551
 552   my $error = $self->delete;
 553   if ( $error ) {
 554     $dbh->rollback if $oldAutoCommit;
 555     return $error;
 556   }
 557
 558   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 559   '';
 560
 561 }
 562
 563 =back
 564
 565 =head1 BUGS
 566
 567 There should probably be a configuration file with a list of allowed credit
 568 card types.
 569
 570 =head1 SEE ALSO
 571
 572 L<FS::cust_main>, L<FS::Record>
 573
 574 =cut
 575
 576 1;
 577