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