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