FS/FS/payinfo_Mixin.pm

   1 package FS::payinfo_Mixin;
   2
   3 use strict;
   4 use Business::CreditCard;
   5 use FS::payby;
   6 use FS::Record qw(qsearch);
   7 use FS::UID qw(driver_name);
   8 use FS::Cursor;
   9 use Time::Local qw(timelocal);
  10
  11 # allow_closed_replace only relevant to cust_pay/cust_refund, for upgrade tokenizing
  12 use vars qw( $ignore_masked_payinfo $allow_closed_replace );
  13
  14 =head1 NAME
  15
  16 FS::payinfo_Mixin - Mixin class for records in tables that contain payinfo.
  17
  18 =head1 SYNOPSIS
  19
  20 package FS::some_table;
  21 use vars qw(@ISA);
  22 @ISA = qw( FS::payinfo_Mixin FS::Record );
  23
  24 =head1 DESCRIPTION
  25
  26 This is a mixin class for records that contain payinfo.
  27
  28 =head1 FIELDS
  29
  30 =over 4
  31
  32 =item payby
  33
  34 The following payment types (payby) are supported:
  35
  36 For Customers (cust_main):
  37 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
  38 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
  39 'LECB' (Phone bill billing), 'BILL' (billing), 'COMP' (free), or
  40 'PREPAY' (special billing type: applies a credit and sets billing type to I<BILL> - see L<FS::prepay_credit>)
  41
  42 For Refunds (cust_refund):
  43 'CARD' (credit cards), 'CHEK' (electronic check/ACH),
  44 'LECB' (Phone bill billing), 'BILL' (billing), 'CASH' (cash),
  45 'WEST' (Western Union), 'MCRD' (Manual credit card), 'MCHK' (Manual electronic
  46 check), 'CBAK' Chargeback, or 'COMP' (free)
  47
  48
  49 For Payments (cust_pay):
  50 'CARD' (credit cards), 'CHEK' (electronic check/ACH),
  51 'LECB' (phone bill billing), 'BILL' (billing), 'PREP' (prepaid card),
  52 'CASH' (cash), 'WEST' (Western Union), 'MCRD' (Manual credit card), 'MCHK'
  53 (Manual electronic check), 'PPAL' (PayPal)
  54 'COMP' (free) is depricated as a payment type in cust_pay
  55
  56 =cut
  57
  58 =item payinfo
  59
  60 Payment information (payinfo) can be one of the following types:
  61
  62 Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username)
  63 prepayment identifier (see L<FS::prepay_credit>), PayPal transaction ID
  64
  65 =cut
  66
  67 sub payinfo {
  68   my($self,$payinfo) = @_;
  69
  70   if ( defined($payinfo) ) {
  71     $self->paymask($self->mask_payinfo) unless $self->getfield('paymask') || $self->tokenized; #make sure old mask is set
  72     $self->setfield('payinfo', $payinfo);
  73     $self->paymask($self->mask_payinfo) unless $self->tokenized($payinfo); #remask unless tokenizing
  74   } else {
  75     $self->getfield('payinfo');
  76   }
  77 }
  78
  79 =item paycvv
  80
  81 Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
  82
  83 =cut
  84
  85 #this prevents encrypting empty values on insert?
  86 sub paycvv {
  87   my($self,$paycvv) = @_;
  88   # This is only allowed in cust_payby (formerly cust_main)
  89   #  It shouldn't be stored longer than necessary to run the first transaction
  90   if ( defined($paycvv) ) {
  91     $self->setfield('paycvv', $paycvv);
  92   } else {
  93     $self->getfield('paycvv');
  94   }
  95 }
  96
  97 =item paymask
  98
  99 =cut
 100
 101 sub paymask {
 102   my($self, $paymask) = @_;
 103
 104   if ( defined($paymask) ) {
 105     $self->setfield('paymask', $paymask);
 106   } else {
 107     $self->getfield('paymask') || $self->mask_payinfo;
 108   }
 109 }
 110
 111 =back
 112
 113 =head1 METHODS
 114
 115 =over 4
 116
 117 =item mask_payinfo [ PAYBY, PAYINFO ]
 118
 119 This method converts the payment info (credit card, bank account, etc.) into a
 120 masked string.
 121
 122 Optionally, an arbitrary payby and payinfo can be passed.
 123
 124 =cut
 125
 126 sub mask_payinfo {
 127   my $self = shift;
 128   my $payby   = scalar(@_) ? shift : $self->payby;
 129   my $payinfo = scalar(@_) ? shift : $self->payinfo;
 130
 131   # Check to see if it's encrypted...
 132   if ( ref($self) && $self->is_encrypted($payinfo) ) {
 133     return 'N/A';
 134   } elsif ( $self->tokenized($payinfo) || $payinfo eq 'N/A' ) { #token
 135     return 'N/A (tokenized)'; #?
 136   } else { # if not, mask it...
 137
 138     if ($payby eq 'CARD' || $payby eq 'DCRD') {
 139                                                 #|| $payby eq 'MCRD') {
 140                                                 #MCRD isn't a card in payinfo,
 141                                                 #its a record of an _offline_
 142                                                 #card
 143
 144       # Credit Cards
 145
 146       # special handling for Local Isracards: always show last 4
 147       if ( $payinfo =~ /^(\d{8,9})$/ ) {
 148
 149         return 'x'x(length($payinfo)-4).
 150                substr($payinfo,(length($payinfo)-4));
 151
 152       }
 153
 154       my $conf = new FS::Conf;
 155       my $mask_method = $conf->config('card_masking_method') || 'first6last4';
 156       $mask_method =~ /^first(\d+)last(\d+)$/
 157         or die "can't parse card_masking_method $mask_method";
 158       my($first, $last) = ($1, $2);
 159
 160       return substr($payinfo,0,$first).
 161              'x'x(length($payinfo)-$first-$last).
 162              substr($payinfo,(length($payinfo)-$last));
 163
 164     } elsif ($payby eq 'CHEK' || $payby eq 'DCHK' ) {
 165
 166       # Checks (Show last 2 @ bank)
 167       my( $account, $aba ) = split('@', $payinfo );
 168       return 'x'x(length($account)-2).
 169              substr($account,(length($account)-2)).
 170              ( length($aba) ? "@".$aba : '');
 171
 172     } elsif ($payby eq 'EDI') {
 173       # EDI.
 174       # These numbers have been seen anywhere from 8 to 30 digits, and
 175       # possibly more.  Lacking any better idea I'm going to mask all but
 176       # the last 4 digits.
 177       return 'x' x (length($payinfo) - 4) . substr($payinfo, -4);
 178
 179     } else { # Tie up loose ends
 180       return $payinfo;
 181     }
 182   }
 183   #die "shouldn't be reached";
 184 }
 185
 186 =item payinfo_check
 187
 188 Checks payby and payinfo.
 189
 190 =cut
 191
 192 sub payinfo_check {
 193   my $self = shift;
 194
 195   FS::payby->can_payby($self->table, $self->payby)
 196     or return "Illegal payby: ". $self->payby;
 197
 198   if ( $self->payby eq 'CARD' && ! $self->is_encrypted($self->payinfo) ) {
 199
 200     # see parallel checks in cust_payby::check & cust_payby::check_payinfo_cardtype
 201     if ( $self->tokenized ) {
 202       if ( $self->paymask =~ /^\d+x/ ) {
 203         $self->set('paycardtype', cardtype($self->paymask));
 204       } else {
 205         $self->set('paycardtype', '');
 206         #return "paycardtype required ".
 207         #       "(can't derive from a token and no paymask w/prefix provided)";
 208       }
 209     } else {
 210       $self->set('paycardtype', cardtype($self->payinfo));
 211     }
 212
 213     if ( $ignore_masked_payinfo and $self->mask_payinfo eq $self->payinfo ) {
 214       # allow it
 215     } else {
 216       my $payinfo = $self->payinfo;
 217       $payinfo =~ s/\D//g;
 218       $self->payinfo($payinfo);
 219       if ( $self->payinfo ) {
 220         $self->payinfo =~ /^(\d{13,16}|\d{8,9})$/
 221           or return "Illegal (mistyped?) credit card number (payinfo)";
 222         $self->payinfo($1);
 223         validate($self->payinfo) or return "Illegal credit card number";
 224         return "Unknown card type" if $self->paycardtype eq "Unknown";
 225       } else {
 226         $self->payinfo('N/A'); #??? re-masks card
 227       }
 228     }
 229
 230   } else {
 231
 232     if ( $self->payby eq 'CARD' && $self->paymask =~ /^\d+x/  ) {
 233       # if we can't decrypt the card, at least detect the cardtype
 234       $self->set('paycardtype', cardtype($self->paymask));
 235     } else {
 236       $self->set('paycardtype', '');
 237       # return "paycardtype required ".
 238       #        "(can't derive from a token and no paymask w/prefix provided)";
 239     }
 240
 241     if ( $self->is_encrypted($self->payinfo) ) {
 242       #something better?  all it would cause is a decryption error anyway?
 243       my $error = $self->ut_anything('payinfo');
 244       return $error if $error;
 245     } else {
 246       my $error = $self->ut_textn('payinfo');
 247       return $error if $error;
 248     }
 249   }
 250
 251   return '';
 252 }
 253
 254 =item payby_payinfo_pretty [ LOCALE ]
 255
 256 Returns payment method and information (suitably masked, if applicable) as
 257 a human-readable string, such as:
 258
 259   Card #54xxxxxxxxxxxx32
 260
 261 or
 262
 263   Check #119006
 264
 265 =cut
 266
 267 sub payby_payinfo_pretty {
 268   my $self = shift;
 269   my $locale = shift;
 270   my $lh = FS::L10N->get_handle($locale);
 271   if ( $self->payby eq 'CARD' ) {
 272     if ($self->paymask =~ /tokenized/) {
 273       $lh->maketext('Tokenized Card');
 274     } else {
 275       $lh->maketext('Card #') . $self->paymask;
 276     }
 277   } elsif ( $self->payby eq 'CHEK' ) {
 278
 279     #false laziness w/view/cust_main/payment_history.html::translate_payinfo
 280     my( $account, $aba ) = split('@', $self->paymask );
 281
 282     if ( $aba =~ /^(\d{5})\.(\d{3})$/ ) { #blame canada
 283       my($branch, $routing) = ($1, $2);
 284       $lh->maketext("Routing [_1], Branch [_2], Acct [_3]",
 285                      $routing, $branch, $account);
 286     } else {
 287       $lh->maketext("Routing [_1], Acct [_2]", $aba, $account);
 288     }
 289
 290   } elsif ( $self->payby eq 'BILL' ) {
 291     $lh->maketext('Check #') . $self->payinfo;
 292   } elsif ( $self->payby eq 'PREP' ) {
 293     $lh->maketext('Prepaid card #') . $self->payinfo;
 294   } elsif ( $self->payby eq 'CASH' ) {
 295     $lh->maketext('Cash') . ' ' . $self->payinfo;
 296   } elsif ( $self->payby eq 'WEST' ) {
 297     # does Western Union localize their name?
 298     $lh->maketext('Western Union');
 299   } elsif ( $self->payby eq 'MCRD' ) {
 300     $lh->maketext('Manual credit card');
 301   } elsif ( $self->payby eq 'MCHK' ) {
 302     $lh->maketext('Manual electronic check');
 303   } elsif ( $self->payby eq 'EDI' ) {
 304     $lh->maketext('EDI') . ' ' . $self->paymask;
 305   } elsif ( $self->payby eq 'PPAL' ) {
 306     $lh->maketext('PayPal transaction#') . $self->order_number;
 307   } else {
 308     $self->payby. ' '. $self->payinfo;
 309   }
 310 }
 311
 312 =item payinfo_used [ PAYINFO ]
 313
 314 Returns 1 if there's an existing payment using this payinfo.  This can be
 315 used to set the 'recurring payment' flag required by some processors.
 316
 317 =cut
 318
 319 sub payinfo_used {
 320   my $self = shift;
 321   my $payinfo = shift || $self->payinfo;
 322   my %hash = (
 323     'custnum' => $self->custnum,
 324     'payby'   => $self->payby,
 325   );
 326
 327   return 1
 328   if qsearch('cust_pay', { %hash, 'payinfo' => $payinfo } )
 329   || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo } )
 330   ;
 331
 332   return 0;
 333 }
 334
 335 =item display_status
 336
 337 For transactions that have both 'status' and 'failure_status', shows the
 338 status in a single, display-friendly string.
 339
 340 =cut
 341
 342 sub display_status {
 343   my $self = shift;
 344   my %status = (
 345     'done'        => 'Approved',
 346     'expired'     => 'Card Expired',
 347     'stolen'      => 'Lost/Stolen',
 348     'pickup'      => 'Pick Up Card',
 349     'nsf'         => 'Insufficient Funds',
 350     'inactive'    => 'Inactive Account',
 351     'blacklisted' => 'Blacklisted',
 352     'declined'    => 'Declined',
 353     'approved'    => 'Approved',
 354   );
 355   if ( $self->failure_status ) {
 356     return $status{$self->failure_status};
 357   } else {
 358     return $status{$self->status};
 359   }
 360 }
 361
 362 =item paydate_monthyear
 363
 364 Returns a two-element list consisting of the month and year of this customer's
 365 paydate (credit card expiration date for CARD customers)
 366
 367 =cut
 368
 369 sub paydate_monthyear {
 370   my $self = shift;
 371   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
 372     ( $2, $1 );
 373   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
 374     ( $1, $3 );
 375   } else {
 376     ('', '');
 377   }
 378 }
 379
 380 =item paydate_epoch
 381
 382 Returns the exact time in seconds corresponding to the payment method
 383 expiration date.  For CARD/DCRD customers this is the end of the month;
 384 for others (COMP is the only other payby that uses paydate) it's the start.
 385 Returns 0 if the paydate is empty or set to the far future.
 386
 387 =cut
 388
 389 sub paydate_epoch {
 390   my $self = shift;
 391   my ($month, $year) = $self->paydate_monthyear;
 392   return 0 if !$year or $year >= 2037;
 393   if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
 394     $month++;
 395     if ( $month == 13 ) {
 396       $month = 1;
 397       $year++;
 398     }
 399     return timelocal(0,0,0,1,$month-1,$year) - 1;
 400   }
 401   else {
 402     return timelocal(0,0,0,1,$month-1,$year);
 403   }
 404 }
 405
 406 =item paydate_epoch_sql
 407
 408 Class method.  Returns an SQL expression to obtain the payment expiration date
 409 as a number of seconds.
 410
 411 =cut
 412
 413 # Special expiration date behavior for non-CARD/DCRD customers has been
 414 # carefully preserved.  Do we really use that?
 415 sub paydate_epoch_sql {
 416   my $class = shift;
 417   my $table = $class->table;
 418   my ($case1, $case2);
 419   if ( driver_name eq 'Pg' ) {
 420     $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
 421     $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
 422   }
 423   elsif ( lc(driver_name) eq 'mysql' ) {
 424     $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
 425     $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
 426   }
 427   else { return '' }
 428   return "CASE WHEN $table.payby IN('CARD','DCRD')
 429   THEN ($case1)
 430   ELSE ($case2)
 431   END"
 432 }
 433
 434 =item upgrade_set_cardtype
 435
 436 Find all records with a credit card payment type and no paycardtype, and
 437 replace them in order to set their paycardtype.
 438
 439 This method actually just starts a queue job.
 440
 441 =cut
 442
 443 sub upgrade_set_cardtype {
 444   my $class = shift;
 445   my $table = $class->table or die "upgrade_set_cardtype needs a table";
 446
 447   if ( ! FS::upgrade_journal->is_done("${table}__set_cardtype") ) {
 448     my $job = FS::queue->new({ job => 'FS::payinfo_Mixin::process_set_cardtype' });
 449     my $error = $job->insert($table);
 450     die $error if $error;
 451     FS::upgrade_journal->set_done("${table}__set_cardtype");
 452   }
 453 }
 454
 455 sub process_set_cardtype {
 456   my $table = shift;
 457
 458   # assign cardtypes to CARD/DCRDs that need them; check_payinfo_cardtype
 459   # will do this. ignore any problems with the cards.
 460   local $ignore_masked_payinfo = 1;
 461   my $search = FS::Cursor->new({
 462     table     => $table,
 463     extra_sql => q[ WHERE payby IN('CARD','DCRD') AND paycardtype IS NULL ],
 464   });
 465   while (my $record = $search->fetch) {
 466     my $error = $record->replace;
 467     die $error if $error;
 468   }
 469 }
 470
 471 =item tokenized [ PAYINFO ]
 472
 473 Returns true if object payinfo is tokenized
 474
 475 Optionally, an arbitrary payby and payinfo can be passed.
 476
 477 =cut
 478
 479 sub tokenized {
 480   my $self = shift;
 481   my $payinfo = scalar(@_) ? shift : $self->payinfo;
 482   return 0 unless $payinfo; #avoid uninitialized value error
 483   $payinfo =~ /^99\d{14}$/;
 484 }
 485
 486 =back
 487
 488 =head1 BUGS
 489
 490 =head1 SEE ALSO
 491
 492 L<FS::payby>, L<FS::Record>
 493
 494 =cut
 495
 496 1;
 497