FS/FS/cust_pay_batch.pm

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