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