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