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
  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|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 }
 250
 251 =item approve OPTIONS
 252
 253 Approve this payment.  This will replace the existing record with the
 254 same paybatchnum, set its status to 'Approved', and generate a payment
 255 record (L<FS::cust_pay>).  This should only be called from the batch
 256 import process.
 257
 258 OPTIONS may contain "gatewaynum", "processor", "auth", and "order_number".
 259
 260 =cut
 261
 262 sub approve {
 263   # to break up the Big Wall of Code that is import_results
 264   my $new = shift;
 265   my %opt = @_;
 266   my $paybatchnum = $new->paybatchnum;
 267   my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
 268     or return "cannot approve, paybatchnum $paybatchnum not found";
 269   # leave these restrictions in place until TD EFT is converted over
 270   # to B::BP
 271   return "cannot approve paybatchnum $paybatchnum, already resolved ('".$old->status."')"
 272     if $old->status;
 273   $new->status('Approved');
 274   my $error = $new->replace($old);
 275   if ( $error ) {
 276     return "error approving paybatchnum $paybatchnum: $error\n";
 277   }
 278   my $cust_pay = new FS::cust_pay ( {
 279       'custnum'   => $new->custnum,
 280       'payby'     => $new->payby,
 281       'payinfo'   => $new->payinfo || $old->payinfo,
 282       'paid'      => $new->paid,
 283       '_date'     => $new->_date,
 284       'usernum'   => $new->usernum,
 285       'batchnum'  => $new->batchnum,
 286       'gatewaynum'    => $opt{'gatewaynum'},
 287       'processor'     => $opt{'processor'},
 288       'auth'          => $opt{'auth'},
 289       'order_number'  => $opt{'order_number'}
 290     } );
 291
 292   $error = $cust_pay->insert;
 293   if ( $error ) {
 294     return "error inserting payment for paybatchnum $paybatchnum: $error\n";
 295   }
 296   $cust_pay->cust_main->apply_payments;
 297   return;
 298 }
 299
 300 =item decline [ REASON [ STATUS ] ]
 301
 302 Decline this payment.  This will replace the existing record with the
 303 same paybatchnum, set its status to 'Declined', and run collection events
 304 as appropriate.  This should only be called from the batch import process.
 305
 306 REASON is a string description of the decline reason, defaulting to
 307 'Returned payment', and will go into the "error_message" field.
 308
 309 STATUS is a normalized failure status defined by L<Business::BatchPayment>,
 310 and will go into the "failure_status" field.
 311
 312 =cut
 313
 314 sub decline {
 315   my $new = shift;
 316   my $reason = shift || 'Returned payment';
 317   my $failure_status = shift || '';
 318   #my $conf = new FS::Conf;
 319
 320   my $paybatchnum = $new->paybatchnum;
 321   my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
 322     or return "cannot decline, paybatchnum $paybatchnum not found";
 323   if ( $old->status ) {
 324     # Handle the case where payments are rejected after the batch has been
 325     # approved.  FS::pay_batch::import_results won't allow results to be
 326     # imported to a closed batch unless batch-manual_approval is enabled,
 327     # so we don't check it here.
 328 #    if ( $conf->exists('batch-manual_approval') and
 329     if ( lc($old->status) eq 'approved' ) {
 330       # Void the payment
 331       my $cust_pay = qsearchs('cust_pay', {
 332           custnum  => $new->custnum,
 333           batchnum => $new->batchnum
 334         });
 335       # these should all be migrated over, but if it's not found, look for
 336       # batchnum in the 'paybatch' field also
 337       $cust_pay ||= qsearchs('cust_pay', {
 338           custnum  => $new->custnum,
 339           paybatch => $new->batchnum
 340         });
 341       if ( !$cust_pay ) {
 342         # should never happen...
 343         return "failed to revoke paybatchnum $paybatchnum, payment not found";
 344       }
 345       $cust_pay->void($reason);
 346     }
 347     elsif ( lc($old->status) eq 'declined' ) {
 348       # batch files from RBC can have multiple lines for one decline
 349       # if this causes problems elsewhere, try hacking pay_batch/RBC.pm instead
 350       return '';
 351     }
 352     else {
 353       # normal case: refuse to do anything
 354       # should never happen...only statuses are approved or declined
 355       return "cannot decline paybatchnum $paybatchnum, already resolved ('".$old->status."')";
 356     }
 357   } # !$old->status
 358   $new->status('Declined');
 359   $new->error_message($reason);
 360   $new->failure_status($failure_status);
 361   my $error = $new->replace($old);
 362   if ( $error ) {
 363     return "error declining paybatchnum $paybatchnum: $error\n";
 364   }
 365   my $due_cust_event = $new->cust_main->due_cust_event(
 366     'eventtable'  => 'cust_pay_batch',
 367     'objects'     => [ $new ],
 368   );
 369   if ( !ref($due_cust_event) ) {
 370     return $due_cust_event;
 371   }
 372   # XXX breaks transaction integrity
 373   foreach my $cust_event (@$due_cust_event) {
 374     next unless $cust_event->test_conditions;
 375     if ( my $error = $cust_event->do_event() ) {
 376       return $error;
 377     }
 378   }
 379   return;
 380 }
 381
 382 =item request_item [ OPTIONS ]
 383
 384 Returns a L<Business::BatchPayment::Item> object for this batch payment
 385 entry.  This can be submitted to a processor.
 386
 387 OPTIONS can be a list of key/values to append to the attributes.  The most
 388 useful case of this is "process_date" to set a processing date based on the
 389 date the batch is being submitted.
 390
 391 =cut
 392
 393 sub request_item {
 394   local $@;
 395   my $self = shift;
 396
 397   eval "use Business::BatchPayment;";
 398   die "couldn't load Business::BatchPayment: $@" if $@;
 399
 400   my $cust_main = $self->cust_main;
 401   my $location = $cust_main->bill_location;
 402   my $pay_batch = $self->pay_batch;
 403
 404   my %payment;
 405   $payment{payment_type} = FS::payby->payby2bop( $pay_batch->payby );
 406   if ( $payment{payment_type} eq 'CC' ) {
 407     $payment{card_number} = $self->payinfo,
 408     $payment{expiration}  = $self->expmmyy,
 409   } elsif ( $payment{payment_type} eq 'ECHECK' ) {
 410     $self->payinfo =~ /(\d+)@(\d+)/; # or else what?
 411     $payment{account_number} = $1;
 412     $payment{routing_code} = $2;
 413     $payment{account_type} = $cust_main->paytype;
 414     # XXX what if this isn't their regular payment method?
 415   } else {
 416     die "unsupported BatchPayment method: ".$pay_batch->payby;
 417   }
 418
 419   Business::BatchPayment->create(Item =>
 420     # required
 421     action      => 'payment',
 422     tid         => $self->paybatchnum,
 423     amount      => $self->amount,
 424
 425     # customer info
 426     customer_id => $self->custnum,
 427     first_name  => $cust_main->first,
 428     last_name   => $cust_main->last,
 429     company     => $cust_main->company,
 430     address     => $location->address1,
 431     ( map { $_ => $location->$_ } qw(address2 city state country zip) ),
 432
 433     invoice_number  => $self->invnum,
 434     %payment,
 435   );
 436 }
 437
 438 =back
 439
 440 =head1 BUGS
 441
 442 There should probably be a configuration file with a list of allowed credit
 443 card types.
 444
 445 =head1 SEE ALSO
 446
 447 L<FS::cust_main>, L<FS::Record>
 448
 449 =cut
 450
 451 1;
 452