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