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 $error =
 134       $self->ut_numbern('paybatchnum')
 135     || $self->ut_numbern('trancode') #deprecated
 136     || $self->ut_money('amount')
 137     || $self->ut_number('invnum')
 138     || $self->ut_number('custnum')
 139     || $self->ut_text('address1')
 140     || $self->ut_textn('address2')
 141     || $self->ut_text('city')
 142     || $self->ut_textn('state')
 143   ;
 144
 145   return $error if $error;
 146
 147   $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
 148   $self->setfield('last',$1);
 149
 150   $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name";
 151   $self->first($1);
 152
 153   $error = $self->payinfo_check();
 154   return $error if $error;
 155
 156   if ( $self->exp eq '' ) {
 157     return "Expiration date required"
 158       unless $self->payby =~ /^(CHEK|DCHK|LECB|WEST)$/;
 159     $self->exp('');
 160   } else {
 161     if ( $self->exp =~ /^(\d{4})[\/\-](\d{1,2})[\/\-](\d{1,2})$/ ) {
 162       $self->exp("$1-$2-$3");
 163     } elsif ( $self->exp =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
 164       if ( length($2) == 4 ) {
 165         $self->exp("$2-$1-01");
 166       } elsif ( $2 > 98 ) { #should pry change to check for "this year"
 167         $self->exp("19$2-$1-01");
 168       } else {
 169         $self->exp("20$2-$1-01");
 170       }
 171     } else {
 172       return "Illegal expiration date";
 173     }
 174   }
 175
 176   if ( $self->payname eq '' ) {
 177     $self->payname( $self->first. " ". $self->getfield('last') );
 178   } else {
 179     $self->payname =~ /^([\w \,\.\-\']+)$/
 180       or return "Illegal billing name";
 181     $self->payname($1);
 182   }
 183
 184   #we have lots of old zips in there... don't hork up batch results cause of em
 185   $self->zip =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
 186     or return "Illegal zip: ". $self->zip;
 187   $self->zip($1);
 188
 189   $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
 190   $self->country($1);
 191
 192   #$error = $self->ut_zip('zip', $self->country);
 193   #return $error if $error;
 194
 195   #check invnum, custnum, ?
 196
 197   $self->SUPER::check;
 198 }
 199
 200 =item cust_main
 201
 202 Returns the customer (see L<FS::cust_main>) for this batched credit card
 203 payment.
 204
 205 =cut
 206
 207 sub cust_main {
 208   my $self = shift;
 209   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 210 }
 211
 212 =item pay_batch
 213
 214 Returns the payment batch this payment belongs to (L<FS::pay_batch).
 215
 216 =cut
 217
 218 sub pay_batch {
 219   my $self = shift;
 220   FS::pay_batch->by_key($self->batchnum);
 221 }
 222
 223 #you know what, screw this in the new world of events.  we should be able to
 224 #get the event defs to retry (remove once.pm condition, add every.pm) without
 225 #mucking about with statuses of previous cust_event records.  right?
 226 #
 227 #=item retriable
 228 #
 229 #Marks the corresponding event (see L<FS::cust_bill_event>) for this batched
 230 #credit card payment as retriable.  Useful if the corresponding financial
 231 #institution account was declined for temporary reasons and/or a manual
 232 #retry is desired.
 233 #
 234 #Implementation details: For the named customer's invoice, changes the
 235 #statustext of the 'done' (without statustext) event to 'retriable.'
 236 #
 237 #=cut
 238
 239 sub retriable {
 240
 241   confess "deprecated method cust_pay_batch->retriable called; try removing ".
 242           "the once condition and adding an every condition?";
 243
 244   my $self = shift;
 245
 246   local $SIG{HUP} = 'IGNORE';        #Hmm
 247   local $SIG{INT} = 'IGNORE';
 248   local $SIG{QUIT} = 'IGNORE';
 249   local $SIG{TERM} = 'IGNORE';
 250   local $SIG{TSTP} = 'IGNORE';
 251   local $SIG{PIPE} = 'IGNORE';
 252
 253   my $oldAutoCommit = $FS::UID::AutoCommit;
 254   local $FS::UID::AutoCommit = 0;
 255   my $dbh = dbh;
 256
 257   my $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
 258     or return "event $self->eventnum references nonexistant invoice $self->invnum";
 259
 260   warn "cust_pay_batch->retriable working with self of " . $self->paybatchnum . " and invnum of " . $self->invnum;
 261   my @cust_bill_event =
 262     sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
 263       grep {
 264         $_->part_bill_event->eventcode =~ /\$cust_bill->batch_card/
 265           && $_->status eq 'done'
 266           && ! $_->statustext
 267         }
 268       $cust_bill->cust_bill_event;
 269   # complain loudly if scalar(@cust_bill_event) > 1 ?
 270   my $error = $cust_bill_event[0]->retriable;
 271   if ($error ) {
 272     # gah, even with transactions.
 273     $dbh->commit if $oldAutoCommit; #well.
 274     return "error marking invoice event retriable: $error";
 275   }
 276   '';
 277 }
 278
 279 =item approve PAYBATCH
 280
 281 Approve this payment.  This will replace the existing record with the
 282 same paybatchnum, set its status to 'Approved', and generate a payment
 283 record (L<FS::cust_pay>).  This should only be called from the batch
 284 import process.
 285
 286 =cut
 287
 288 sub approve {
 289   # to break up the Big Wall of Code that is import_results
 290   my $new = shift;
 291   my $paybatch = shift;
 292   my $paybatchnum = $new->paybatchnum;
 293   my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
 294     or return "paybatchnum $paybatchnum not found";
 295   return "paybatchnum $paybatchnum already resolved ('".$old->status."')"
 296     if $old->status;
 297   $new->status('Approved');
 298   my $error = $new->replace($old);
 299   if ( $error ) {
 300     return "error updating status of paybatchnum $paybatchnum: $error\n";
 301   }
 302   my $cust_pay = new FS::cust_pay ( {
 303       'custnum'   => $new->custnum,
 304       'payby'     => $new->payby,
 305       'paybatch'  => $paybatch,
 306       'payinfo'   => $new->payinfo || $old->payinfo,
 307       'paid'      => $new->paid,
 308       '_date'     => $new->_date,
 309       'usernum'   => $new->usernum,
 310       'batchnum'  => $new->batchnum,
 311     } );
 312   $error = $cust_pay->insert;
 313   if ( $error ) {
 314     return "error inserting payment for paybatchnum $paybatchnum: $error\n";
 315   }
 316   $cust_pay->cust_main->apply_payments;
 317   return;
 318 }
 319
 320 =item decline [ REASON ]
 321
 322 Decline this payment.  This will replace the existing record with the
 323 same paybatchnum, set its status to 'Declined', and run collection events
 324 as appropriate.  This should only be called from the batch import process.
 325
 326 REASON is a string description of the decline reason, defaulting to
 327 'Returned payment'.
 328
 329 =cut
 330
 331 sub decline {
 332   my $new = shift;
 333   my $reason = shift || 'Returned payment';
 334   #my $conf = new FS::Conf;
 335
 336   my $paybatchnum = $new->paybatchnum;
 337   my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
 338     or return "paybatchnum $paybatchnum not found";
 339   if ( $old->status ) {
 340     # Handle the case where payments are rejected after the batch has been
 341     # approved.  FS::pay_batch::import_results won't allow results to be
 342     # imported to a closed batch unless batch-manual_approval is enabled,
 343     # so we don't check it here.
 344 #    if ( $conf->exists('batch-manual_approval') and
 345     if ( lc($old->status) eq 'approved' ) {
 346       # Void the payment
 347       my $cust_pay = qsearchs('cust_pay', {
 348           custnum  => $new->custnum,
 349           batchnum => $new->batchnum
 350         });
 351       # pre-3.0 style
 352       $cust_pay ||= qsearchs('cust_pay', {
 353           custnum  => $new->custnum,
 354           paybatch => $new->batchnum
 355         });
 356       if ( !$cust_pay ) {
 357         # should never happen...
 358         return "failed to revoke paybatchnum $paybatchnum, payment not found";
 359       }
 360       $cust_pay->void($reason);
 361     }
 362     else {
 363       # normal case: refuse to do anything
 364       return "paybatchnum $paybatchnum already resolved ('".$old->status."')";
 365     }
 366   } # !$old->status
 367   $new->status('Declined');
 368   $new->error_message($reason);
 369   my $error = $new->replace($old);
 370   if ( $error ) {
 371     return "error updating status of paybatchnum $paybatchnum: $error\n";
 372   }
 373   my $due_cust_event = $new->cust_main->due_cust_event(
 374     'eventtable'  => 'cust_pay_batch',
 375     'objects'     => [ $new ],
 376   );
 377   if ( !ref($due_cust_event) ) {
 378     return $due_cust_event;
 379   }
 380   # XXX breaks transaction integrity
 381   foreach my $cust_event (@$due_cust_event) {
 382     next unless $cust_event->test_conditions;
 383     if ( my $error = $cust_event->do_event() ) {
 384       return $error;
 385     }
 386   }
 387   return;
 388 }
 389
 390 =back
 391
 392 =head1 BUGS
 393
 394 There should probably be a configuration file with a list of allowed credit
 395 card types.
 396
 397 =head1 SEE ALSO
 398
 399 L<FS::cust_main>, L<FS::Record>
 400
 401 =cut
 402
 403 1;
 404