FS/FS/cust_payby.pm

   1 package FS::cust_payby;
   2 use base qw( FS::payinfo_Mixin FS::cust_main_Mixin FS::Record );
   3
   4 use strict;
   5 use Scalar::Util qw( blessed );
   6 use Digest::SHA qw( sha512_base64 );
   7 use Business::CreditCard qw( validate cardtype );
   8 use FS::UID qw( dbh );
   9 use FS::Msgcat qw( gettext );
  10 use FS::Misc qw( card_types );
  11 use FS::Record; #qw( qsearch qsearchs );
  12 use FS::payby;
  13 use FS::cust_main;
  14 use FS::banned_pay;
  15
  16 our @encrypted_fields = ('payinfo', 'paycvv');
  17 sub nohistory_fields { ('payinfo', 'paycvv'); }
  18
  19 our $ignore_expired_card = 0;
  20 our $ignore_banned_card = 0;
  21 our $ignore_invalid_card = 0;
  22 our $ignore_cardtype = 0;
  23
  24 our $conf;
  25 install_callback FS::UID sub {
  26   $conf = new FS::Conf;
  27   #yes, need it for stuff below (prolly should be cached)
  28   $ignore_invalid_card = $conf->exists('allow_invalid_cards');
  29 };
  30
  31 =head1 NAME
  32
  33 FS::cust_payby - Object methods for cust_payby records
  34
  35 =head1 SYNOPSIS
  36
  37   use FS::cust_payby;
  38
  39   $record = new FS::cust_payby \%hash;
  40   $record = new FS::cust_payby { 'column' => 'value' };
  41
  42   $error = $record->insert;
  43
  44   $error = $new_record->replace($old_record);
  45
  46   $error = $record->delete;
  47
  48   $error = $record->check;
  49
  50 =head1 DESCRIPTION
  51
  52 An FS::cust_payby object represents customer stored payment information.
  53 FS::cust_payby inherits from FS::Record.  The following fields are currently
  54 supported:
  55
  56 =over 4
  57
  58 =item custpaybynum
  59
  60 primary key
  61
  62 =item custnum
  63
  64 custnum
  65
  66 =item weight
  67
  68 weight
  69
  70 =item payby
  71
  72 payby
  73
  74 =item payinfo
  75
  76 payinfo
  77
  78 =item paycvv
  79
  80 paycvv
  81
  82 =item paymask
  83
  84 paymask
  85
  86 =item paydate
  87
  88 paydate
  89
  90 =item paystart_month
  91
  92 paystart_month
  93
  94 =item paystart_year
  95
  96 paystart_year
  97
  98 =item payissue
  99
 100 payissue
 101
 102 =item payname
 103
 104 payname
 105
 106 =item paystate
 107
 108 paystate
 109
 110 =item paytype
 111
 112 paytype
 113
 114 =item payip
 115
 116 payip
 117
 118 =item paycardtype
 119
 120 The credit card type (deduced from the card number).
 121
 122 =back
 123
 124 =head1 METHODS
 125
 126 =over 4
 127
 128 =item new HASHREF
 129
 130 Creates a new record.  To add the record to the database, see L<"insert">.
 131
 132 Note that this stores the hash reference, not a distinct copy of the hash it
 133 points to.  You can ask the object for a copy with the I<hash> method.
 134
 135 =cut
 136
 137 # the new method can be inherited from FS::Record, if a table method is defined
 138
 139 sub table { 'cust_payby'; }
 140
 141 =item insert
 142
 143 Adds this record to the database.  If there is an error, returns the error,
 144 otherwise returns false.
 145
 146 =cut
 147
 148 sub insert {
 149   my $self = shift;
 150
 151   local $SIG{HUP} = 'IGNORE';
 152   local $SIG{INT} = 'IGNORE';
 153   local $SIG{QUIT} = 'IGNORE';
 154   local $SIG{TERM} = 'IGNORE';
 155   local $SIG{TSTP} = 'IGNORE';
 156   local $SIG{PIPE} = 'IGNORE';
 157
 158   my $oldAutoCommit = $FS::UID::AutoCommit;
 159   local $FS::UID::AutoCommit = 0;
 160   my $dbh = dbh;
 161
 162   my $error =  $self->check_payinfo_cardtype if $self->payby =~/^(CARD|DCRD)$/;
 163   $self->SUPER::insert unless $error;
 164
 165   if ( $error ) {
 166     $dbh->rollback if $oldAutoCommit;
 167     return $error;
 168   }
 169
 170   if ( $self->payby =~ /^(CARD|CHEK)$/ ) {
 171     # new auto card/check info, want to retry realtime_ invoice events
 172     #  (new customer?  that's okay, they won't have any)
 173     my $error = $self->cust_main->retry_realtime;
 174     if ( $error ) {
 175       $dbh->rollback if $oldAutoCommit;
 176       return $error;
 177     }
 178   }
 179
 180   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 181   '';
 182
 183 }
 184
 185 =item delete
 186
 187 Delete this record from the database.
 188
 189 =item replace OLD_RECORD
 190
 191 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 192 returns the error, otherwise returns false.
 193
 194 =cut
 195
 196 sub replace {
 197   my $self = shift;
 198
 199   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 200               ? shift
 201               : $self->replace_old;
 202
 203   if ( $self->payby =~ /^(CARD|DCRD)$/
 204        && (    $self->payinfo =~ /xx/
 205             || $self->payinfo =~ /^\s*N\/A\s+\(tokenized\)\s*$/
 206           )
 207      )
 208   {
 209
 210     $self->payinfo($old->payinfo);
 211
 212   } elsif ( $self->payby =~ /^(CHEK|DCHK)$/ && $self->payinfo =~ /xx/ ) {
 213     #fix for #3085 "edit of customer's routing code only surprisingly causes
 214     #nothing to happen...
 215     # this probably won't do the right thing when we don't have the
 216     # public key (can't actually get the real $old->payinfo)
 217     my($new_account, $new_aba) = split('@', $self->payinfo);
 218     my($old_account, $old_aba) = split('@', $old->payinfo);
 219     $new_account = $old_account if $new_account =~ /xx/;
 220     $new_aba     = $old_aba     if $new_aba     =~ /xx/;
 221     $self->payinfo($new_account.'@'.$new_aba);
 222   }
 223
 224   # only unmask paycvv if payinfo stayed the same
 225   if ( $self->payby =~ /^(CARD|DCRD)$/ and $self->paycvv =~ /^\s*[\*x]+\s*$/ ) {
 226     if ( $old->payinfo eq $self->payinfo
 227          && $old->paymask eq $self->paymask
 228     ) {
 229       $self->paycvv($old->paycvv);
 230     } else {
 231       $self->paycvv('');
 232     }
 233   }
 234
 235   local($ignore_expired_card) = 1
 236     if $old->payby  =~ /^(CARD|DCRD)$/
 237     && $self->payby =~ /^(CARD|DCRD)$/
 238     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
 239
 240   local($ignore_banned_card) = 1
 241     if (    $old->payby  =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
 242          || $old->payby  =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
 243     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
 244
 245   if (    $self->payby =~ /^(CARD|DCRD)$/
 246        && $old->payinfo ne $self->payinfo
 247        && $old->paymask ne $self->paymask )
 248   {
 249     my $error = $self->check_payinfo_cardtype;
 250     return $error if $error;
 251
 252     if ( $conf->exists('business-onlinepayment-verification') ) {
 253       $error = $self->verify;
 254     } else {
 255       $error = $self->tokenize;
 256     }
 257     return $error if $error;
 258
 259   }
 260
 261   local $SIG{HUP} = 'IGNORE';
 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 $error = $self->SUPER::replace($old);
 273   if ( $error ) {
 274     $dbh->rollback if $oldAutoCommit;
 275     return $error;
 276   }
 277
 278   if ( $self->payby =~ /^(CARD|CHEK)$/
 279        && ( ( $self->get('payinfo') ne $old->get('payinfo')
 280               && !$self->tokenized
 281             )
 282             || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
 283           )
 284      )
 285   {
 286
 287     # card/check/lec info has changed, want to retry realtime_ invoice events
 288     my $error = $self->cust_main->retry_realtime;
 289     if ( $error ) {
 290       $dbh->rollback if $oldAutoCommit;
 291       return $error;
 292     }
 293   }
 294
 295   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 296   '';
 297
 298 }
 299
 300 =item check
 301
 302 Checks all fields to make sure this is a valid record.  If there is
 303 an error, returns the error, otherwise returns false.  Called by the insert
 304 and replace methods.
 305
 306 =cut
 307
 308 sub check {
 309   my $self = shift;
 310
 311   my $error =
 312     $self->ut_numbern('custpaybynum')
 313     || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
 314     || $self->ut_numbern('weight')
 315     #encrypted #|| $self->ut_textn('payinfo')
 316     #encrypted #|| $self->ut_textn('paycvv')
 317 #    || $self->ut_textn('paymask') #XXX something
 318     || $self->ut_numbern('paystart_month')
 319     || $self->ut_numbern('paystart_year')
 320     || $self->ut_numbern('payissue')
 321 #    || $self->ut_textn('payname') #XXX something
 322     || $self->ut_alphan('paystate')
 323     || $self->ut_textn('paytype')
 324     || $self->ut_ipn('payip')
 325   ;
 326   return $error if $error;
 327
 328   ### from cust_main
 329
 330   FS::payby->can_payby($self->table, $self->payby)
 331     or return "Illegal payby: ". $self->payby;
 332
 333   # If it is encrypted and the private key is not availaible then we can't
 334   # check the credit card.
 335   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
 336
 337   # Need some kind of global flag to accept invalid cards, for testing
 338   # on scrubbed data.
 339   #XXX if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
 340
 341   # In this block: detect card type; reject credit card / account numbers that
 342   # are impossible or banned; reject other payment features (date, CVV length)
 343   # that are inappropriate for the card type.
 344   # However, if the payinfo is encrypted then just detect card type and assume
 345   # the other checks were already done.
 346
 347   if ( !$ignore_invalid_card &&
 348     $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
 349
 350     my $payinfo = $self->payinfo;
 351     $payinfo =~ s/\D//g;
 352     $payinfo =~ /^(\d{13,19}|\d{8,9})$/
 353       or return gettext('invalid_card'); #. ": ". $self->payinfo;
 354     $payinfo = $1;
 355     $self->payinfo($payinfo);
 356     validate($payinfo)
 357       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 358
 359     # see parallel checks in check_payinfo_cardtype & payinfo_Mixin::payinfo_check
 360     my $cardtype = $self->paycardtype;
 361     if ( $self->tokenized ) {
 362       $self->set('is_tokenized', 'Y'); #so we don't try to do it again
 363       if ( $self->paymask =~ /^\d+x/ ) {
 364         $cardtype = cardtype($self->paymask);
 365       } else {
 366         #return "paycardtype required ".
 367         #       "(can't derive from a token and no paymask w/prefix provided)"
 368         #  unless $cardtype;
 369       }
 370     } else {
 371       $cardtype = cardtype($self->payinfo);
 372     }
 373
 374     return gettext('unknown_card_type') if $cardtype eq "Unknown";
 375
 376     $self->set('paycardtype', $cardtype);
 377
 378     unless ( $ignore_banned_card ) {
 379       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
 380       if ( $ban ) {
 381         if ( $ban->bantype eq 'warn' ) {
 382           #or others depending on value of $ban->reason ?
 383           return '_duplicate_card'.
 384                  ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
 385                  ' until '.         time2str('%a %h %o at %r', $ban->_end_date).
 386                  ' (ban# '. $ban->bannum. ')'
 387             unless $self->override_ban_warn;
 388         } else {
 389           return 'Banned credit card: banned on '.
 390                  time2str('%a %h %o at %r', $ban->_date).
 391                  ' by '. $ban->otaker.
 392                  ' (ban# '. $ban->bannum. ')';
 393         }
 394       }
 395     }
 396
 397     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
 398       if ( $cardtype eq 'American Express card' ) {
 399         $self->paycvv =~ /^(\d{4})$/
 400           or return "CVV2 (CID) for American Express cards is four digits.";
 401         $self->paycvv($1);
 402       } else {
 403         $self->paycvv =~ /^(\d{3})$/
 404           or return "CVV2 (CVC2/CID) is three digits.";
 405         $self->paycvv($1);
 406       }
 407     } else {
 408       $self->paycvv('');
 409     }
 410
 411     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
 412
 413       return "Start date or issue number is required for $cardtype cards"
 414         unless $self->paystart_month && $self->paystart_year or $self->payissue;
 415
 416       return "Start month must be between 1 and 12"
 417         if $self->paystart_month
 418            and $self->paystart_month < 1 || $self->paystart_month > 12;
 419
 420       return "Start year must be 1990 or later"
 421         if $self->paystart_year
 422            and $self->paystart_year < 1990;
 423
 424       return "Issue number must be beween 1 and 99"
 425         if $self->payissue
 426           and $self->payissue < 1 || $self->payissue > 99;
 427
 428     } else {
 429       $self->paystart_month('');
 430       $self->paystart_year('');
 431       $self->payissue('');
 432     }
 433
 434   } elsif ( !$ignore_invalid_card &&
 435     $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
 436
 437     my $payinfo = $self->payinfo;
 438     $payinfo =~ s/[^\d\@\.]//g;
 439     if ( $conf->config('echeck-country') eq 'CA' ) {
 440       $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
 441         or return 'invalid echeck account@branch.bank';
 442       $payinfo = "$1\@$2.$3";
 443     } elsif ( $conf->config('echeck-country') eq 'US' ) {
 444       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
 445       $payinfo = "$1\@$2";
 446     } else {
 447       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
 448       $payinfo = "$1\@$2";
 449     }
 450     $self->payinfo($payinfo);
 451     $self->paycvv('');
 452
 453     unless ( $ignore_banned_card ) {
 454       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
 455       if ( $ban ) {
 456         if ( $ban->bantype eq 'warn' ) {
 457           #or others depending on value of $ban->reason ?
 458           return '_duplicate_ach' unless $self->override_ban_warn;
 459         } else {
 460           return 'Banned ACH account: banned on '.
 461                  time2str('%a %h %o at %r', $ban->_date).
 462                  ' by '. $ban->otaker.
 463                  ' (ban# '. $ban->bannum. ')';
 464         }
 465       }
 466     }
 467
 468   } elsif ( $self->payby =~ /^CARD|DCRD$/ and $self->paymask ) {
 469     # either ignoring invalid cards, or we can't decrypt the payinfo, but
 470     # try to detect the card type anyway. this never returns failure, so
 471     # the contract of $ignore_invalid_cards is maintained.
 472     $self->set('paycardtype', cardtype($self->paymask));
 473   } else {
 474     $self->set('paycardtype', '');
 475   }
 476
 477 #  } elsif ( $self->payby eq 'PREPAY' ) {
 478 #
 479 #    my $payinfo = $self->payinfo;
 480 #    $payinfo =~ s/\W//g; #anything else would just confuse things
 481 #    $self->payinfo($payinfo);
 482 #    $error = $self->ut_alpha('payinfo');
 483 #    return "Illegal prepayment identifier: ". $self->payinfo if $error;
 484 #    return "Unknown prepayment identifier"
 485 #      unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 486 #    $self->paycvv('');
 487
 488   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
 489
 490     $self->paydate('');
 491
 492   } elsif ( $self->payby =~ /^(CARD|DCRD)$/ ) {
 493
 494     # shouldn't payinfo_check do this?
 495     # (except we don't ever call payinfo_check from here)
 496     return "Expiration date required"
 497       if $self->paydate eq '' || $self->paydate eq '-';
 498
 499     my( $m, $y );
 500     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
 501       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
 502     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
 503       ( $m, $y ) = ( $2, "19$1" );
 504     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
 505       ( $m, $y ) = ( $3, "20$2" );
 506     } else {
 507       return "Illegal expiration date: ". $self->paydate;
 508     }
 509     $m = sprintf('%02d',$m);
 510     $self->paydate("$y-$m-01");
 511     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
 512     return gettext('expired_card')
 513       if #XXX !$import
 514       #&&
 515          !$ignore_expired_card
 516       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
 517
 518   }
 519
 520   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
 521        ( ! $conf->exists('require_cardname')
 522          || $self->payby !~ /^(CARD|DCRD)$/  )
 523   ) {
 524     $self->payname( $self->first. " ". $self->getfield('last') );
 525   } else {
 526
 527     if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
 528       $self->payname =~ /^([\w \,\.\-\']*)$/
 529         or return gettext('illegal_name'). " payname: ". $self->payname;
 530       $self->payname($1);
 531     } else {
 532       $self->payname =~ /^([\w \,\.\-\'\&]*)$/
 533         or return gettext('illegal_name'). " payname: ". $self->payname;
 534       $self->payname($1);
 535     }
 536
 537   }
 538
 539   if ( ! $self->custpaybynum ) {
 540     if ($conf->exists('business-onlinepayment-verification')) {
 541       $error = $self->verify;
 542     } else {
 543       $error = $self->tokenize;
 544     }
 545     return $error if $error;
 546   }
 547
 548   $error = $self->ut_daten('paydate');
 549   return $error if $error;
 550
 551   $self->SUPER::check;
 552 }
 553
 554 sub check_payinfo_cardtype {
 555   my $self = shift;
 556
 557   return '' if $ignore_cardtype;
 558
 559   return '' unless $self->payby =~ /^(CARD|CHEK)$/;
 560
 561   my $payinfo = $self->payinfo;
 562   $payinfo =~ s/\D//g;
 563
 564   # see parallel checks in cust_payby::check & payinfo_Mixin::payinfo_check
 565   if ( $self->tokenized($payinfo) ) {
 566     $self->set('is_tokenized', 'Y'); #so we don't try to do it again
 567     if ( $self->paymask =~ /^\d+x/ ) {
 568       $self->set('paycardtype', cardtype($self->paymask));
 569     } else {
 570       $self->set('paycardtype', '');
 571       #return "paycardtype required ".
 572       #       "(can't derive from a token and no paymask w/prefix provided)";
 573     }
 574     return '';
 575   }
 576
 577   my %bop_card_types = map { $_=>1 } values %{ card_types() };
 578   my $cardtype = cardtype($payinfo);
 579   $self->set('paycardtype', $cardtype);
 580
 581   return "$cardtype not accepted" unless $bop_card_types{$cardtype};
 582
 583   '';
 584
 585 }
 586
 587 sub _banned_pay_hashref {
 588   my $self = shift;
 589
 590   my %payby2ban = (
 591     'CARD' => 'CARD',
 592     'DCRD' => 'CARD',
 593     'CHEK' => 'CHEK',
 594     'DCHK' => 'CHEK'
 595   );
 596
 597   {
 598     'payby'   => $payby2ban{$self->payby},
 599     'payinfo' => $self->payinfo,
 600     #don't ever *search* on reason! #'reason'  =>
 601   };
 602 }
 603
 604 sub _new_banned_pay_hashref {
 605   my $self = shift;
 606   my $hr = $self->_banned_pay_hashref;
 607   $hr->{payinfo_hash} = 'SHA512';
 608   $hr->{payinfo} = sha512_base64($hr->{payinfo});
 609   $hr;
 610 }
 611
 612 =item paydate_mon_year
 613
 614 Returns a two element list consisting of the paydate month and year.
 615
 616 =cut
 617
 618 sub paydate_mon_year {
 619   my $self = shift;
 620
 621   my $date = $self->paydate; # || '12-2037';
 622
 623   #false laziness w/elements/select-month_year.html
 624   if ( $date  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #PostgreSQL date format
 625     ( $2, $1 );
 626   } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
 627     ( $1, $3 );
 628   } else {
 629     warn "unrecognized expiration date format: $date";
 630     ( '', '' );
 631   }
 632
 633 }
 634
 635 =item label
 636
 637 Returns a one line text label for this payment type.
 638
 639 =cut
 640
 641 my %weight = (
 642   1 => 'Primary',
 643   2 => 'Secondary',
 644   3 => 'Tertiary',
 645   4 => 'Fourth',
 646   5 => 'Fifth',
 647   6 => 'Sixth',
 648   7 => 'Seventh',
 649 );
 650
 651 sub label {
 652   my $self = shift;
 653
 654   my $name = $self->payby =~ /^(CARD|DCRD)$/
 655               && $self->paycardtype || FS::payby->shortname($self->payby);
 656
 657   ( $self->payby =~ /^(CARD|CHEK)$/  ? $weight{$self->weight}. ' automatic '
 658                                      : 'Manual '
 659   ).
 660   "$name: ". $self->paymask.
 661   ( $self->payby =~ /^(CARD|DCRD)$/
 662       ? ' Exp '. join('/', $self->paydate_mon_year)
 663       : ''
 664   );
 665
 666 }
 667
 668 =item realtime_bop
 669
 670 Runs a L<realtime_bop|FS::cust_main::Billing_Realtime::realtime_bop> transaction on this card
 671
 672 =cut
 673
 674 sub realtime_bop {
 675   my( $self, %opt ) = @_;
 676
 677   $self->cust_main->realtime_bop({
 678     %opt,
 679     'cust_payby' => $self,
 680   });
 681
 682 }
 683
 684 =item tokenize
 685
 686 Runs a L<realtime_tokenize|FS::cust_main::Billing_Realtime::realtime_tokenize> transaction on this card
 687
 688 =cut
 689
 690 sub tokenize {
 691   my $self = shift;
 692   return '' unless $self->payby =~ /^(CARD|DCRD)$/;
 693
 694   $self->cust_main->realtime_tokenize({
 695     'cust_payby' => $self,
 696   });
 697
 698 }
 699
 700 =item verify
 701
 702 Runs a L<realtime_verify_bop|FS::cust_main::Billing_Realtime/realtime_verify_bop> transaction on this card
 703
 704 =cut
 705
 706 sub verify {
 707   my $self = shift;
 708   return '' unless $self->payby =~ /^(CARD|DCRD)$/;
 709
 710   $self->cust_main->realtime_verify_bop({
 711     'cust_payby' => $self,
 712   });
 713
 714 }
 715
 716 =item paytypes
 717
 718 Returns a list of valid values for the paytype field (bank account type for
 719 electronic check payment).
 720
 721 =cut
 722
 723 sub paytypes {
 724   #my $class = shift;
 725
 726   ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
 727 }
 728
 729 =item cgi_cust_payby_fields
 730
 731 Returns the field names used in the web interface (including some pseudo-fields).
 732
 733 =cut
 734
 735 sub cgi_cust_payby_fields {
 736   #my $class = shift;
 737   [qw( payby payinfo paydate_month paydate_year paycvv payname weight
 738        payinfo1 payinfo2 payinfo3 paytype paystate payname_CHEK )];
 739 }
 740
 741 =item cgi_hash_callback HASHREF OLD
 742
 743 Subroutine (not a class or object method).  Processes a hash reference
 744 of web interface contet (transfers the data from pseudo-fields to real fields).
 745
 746 If OLD object is passed, also preserves locationnum, paystart_month, paystart_year,
 747 payissue and payip.  If the new field is blank but the old is not, the old field
 748 will be preserved.
 749
 750 =cut
 751
 752 sub cgi_hash_callback {
 753   my $hashref = shift;
 754   my $old = shift;
 755
 756   my %noauto = (
 757     'CARD' => 'DCRD',
 758     'CHEK' => 'DCHK',
 759   );
 760   # the payby selector gives the choice of CARD or CHEK (or others, but
 761   # those are the ones with auto and on-demand versions). if the user didn't
 762   # choose a weight, then they mean DCRD/DCHK.
 763   $hashref->{payby} = $noauto{$hashref->{payby}}
 764     if ! $hashref->{weight} && exists $noauto{$hashref->{payby}};
 765
 766   if ( $hashref->{payby} =~ /^(CHEK|DCHK)$/ ) {
 767
 768     unless ( grep $hashref->{$_}, qw(payinfo1 payinfo2 payinfo3 payname_CHEK)) {
 769       %$hashref = ();
 770       return;
 771     }
 772
 773     $hashref->{payinfo} = $hashref->{payinfo1}. '@';
 774     $hashref->{payinfo} .= $hashref->{payinfo3}.'.'
 775       if $conf->config('echeck-country') eq 'CA';
 776     $hashref->{payinfo} .= $hashref->{'payinfo2'};
 777
 778     $hashref->{payname} = $hashref->{'payname_CHEK'};
 779
 780   } elsif ( $hashref->{payby} =~ /^(CARD|DCRD)$/ ) {
 781
 782     unless ( grep $hashref->{$_}, qw( payinfo paycvv payname ) ) {
 783       %$hashref = ();
 784       return;
 785     }
 786
 787   }
 788
 789   $hashref->{paydate}= $hashref->{paydate_month}. '-'. $hashref->{paydate_year};
 790
 791   if ($old) {
 792     foreach my $field ( qw(locationnum paystart_month paystart_year payissue payip) ) {
 793       next if $hashref->{$field};
 794       next unless $old->get($field);
 795       $hashref->{$field} = $old->get($field);
 796     }
 797   }
 798
 799 }
 800
 801 =item search_sql
 802
 803 Class method.
 804
 805 Returns a qsearch hash expression to search for parameters specified in HASHREF.
 806 Valid paramters are:
 807
 808 =over 4
 809
 810 =item payby
 811
 812 listref
 813
 814 =item paydate_year
 815
 816 =item paydate_month
 817
 818
 819 =back
 820
 821 =cut
 822
 823 sub search_sql {
 824   my ($class, $params) = @_;
 825
 826   my @where = ();
 827   my $orderby;
 828
 829   # initialize these to prevent warnings
 830   $params = {
 831     'paydate_year'  => '',
 832     %$params
 833   };
 834
 835   ###
 836   # payby
 837   ###
 838
 839   if ( $params->{'payby'} ) {
 840
 841     my @payby = ref( $params->{'payby'} )
 842                   ? @{ $params->{'payby'} }
 843                   :  ( $params->{'payby'} );
 844
 845     @payby = grep /^([A-Z]{4})$/, @payby;
 846     my $in_payby = 'IN(' . join(',', map {"'$_'"} @payby) . ')';
 847     push @where, "cust_payby.payby $in_payby"
 848       if @payby;
 849   }
 850
 851   ###
 852   # paydate_year / paydate_month
 853   ###
 854
 855   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
 856     my $year = $1;
 857     $params->{'paydate_month'} =~ /^(\d\d?)$/
 858       or die "paydate_year without paydate_month?";
 859     my $month = $1;
 860
 861     push @where,
 862       'cust_payby.paydate IS NOT NULL',
 863       "cust_payby.paydate != ''",
 864       "CAST(cust_payby.paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
 865 ;
 866   }
 867   ##
 868   # setup queries, subs, etc. for the search
 869   ##
 870
 871   $orderby ||= 'ORDER BY custnum';
 872
 873   # here is the agent virtualization
 874   push @where,
 875     $FS::CurrentUser::CurrentUser->agentnums_sql(table => 'cust_main');
 876
 877   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
 878
 879   my $addl_from = ' LEFT JOIN cust_main USING ( custnum ) ';
 880   # always make address fields available in results
 881   for my $pre ('bill_', 'ship_') {
 882     $addl_from .=
 883       ' LEFT JOIN cust_location AS '.$pre.'location '.
 884       'ON (cust_main.'.$pre.'locationnum = '.$pre.'location.locationnum) ';
 885   }
 886   # always make referral available in results
 887   #   (maybe we should be using FS::UI::Web::join_cust_main instead?)
 888   $addl_from .= ' LEFT JOIN (select refnum, referral from part_referral) AS part_referral_x ON (cust_main.refnum = part_referral_x.refnum) ';
 889
 890   my $count_query = "SELECT COUNT(*) FROM cust_payby $addl_from $extra_sql";
 891
 892   my @select = ( 'cust_payby.*',
 893                  #'cust_main.custnum',
 894                  # there's a good chance that we'll need these
 895                  'cust_main.bill_locationnum',
 896                  'cust_main.ship_locationnum',
 897                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
 898                );
 899
 900   my $select = join(', ', @select);
 901
 902   my $sql_query = {
 903     'table'         => 'cust_payby',
 904     'select'        => $select,
 905     'addl_from'     => $addl_from,
 906     'hashref'       => {},
 907     'extra_sql'     => $extra_sql,
 908     'order_by'      => $orderby,
 909     'count_query'   => $count_query,
 910   };
 911   $sql_query;
 912
 913 }
 914
 915 =back
 916
 917 =cut
 918
 919 sub _upgrade_data {
 920
 921   my $class = shift;
 922   local $ignore_banned_card = 1;
 923   local $ignore_expired_card = 1;
 924   local $ignore_invalid_card = 1;
 925   $class->upgrade_set_cardtype;
 926   $class->_upgrade_data_paydate_edgebug;
 927
 928 }
 929
 930 =item _upgrade_data_paydate_edgebug
 931
 932 Correct bad data injected into payment expire date column by Edge browser bug
 933
 934 The month and year values may have an extra character injected into form POST
 935 data by Edge browser.  It was possible for some bad month values to slip
 936 past data validation.
 937
 938 If the stored value was out of range, it was causing payments screen to crash.
 939 We can detect and fix this by dropping the second digit.
 940
 941 If the stored value is is 11 or 12, it's possible the user inputted a 1.  In
 942 this case, the payment method will fail to authorize, but the record will
 943 not cause crashdumps for being out of range.
 944
 945 In short, check for any expiration month > 12, and drop the extra digit
 946
 947 =cut
 948
 949 sub _upgrade_data_paydate_edgebug {
 950   my $journal_label = 'cust_payby_paydate_edgebug';
 951   return if FS::upgrade_journal->is_done( $journal_label );
 952
 953   my $oldAutoCommit = $FS::UID::AutoCommit;
 954   local $FS::UID::AutoCommit = 0;
 955
 956   for my $row (
 957     FS::Record::qsearch(
 958       cust_payby => { paydate => { op => '!=', value => '' }}
 959     )
 960   ) {
 961     next unless $row->ut_daten('paydate');
 962
 963     # paydate column stored in database has failed date validation
 964     my $bad_paydate = $row->paydate;
 965
 966     my @date = split /[\-\/]/, $bad_paydate;
 967     @date = @date[2,0,1] if $date[2] > 1900;
 968
 969     # Only autocorrecting when month > 12 - notify operator
 970     unless ( $date[1] > 12 ) {
 971       die sprintf(
 972         'Unable to correct bad paydate stored in cust_payby row '.
 973         'custpaybynum(%s) custnum(%s) paydate(%s)',
 974         $row->custpaybynum,
 975         $row->custnum,
 976         $bad_paydate,
 977       );
 978     }
 979
 980     $date[1] = substr( $date[1], 0, 1 );
 981     $row->paydate( join('-', @date ));
 982
 983     if ( my $error = $row->replace ) {
 984       die sprintf(
 985         'Failed to autocorrect bad paydate stored in cust_payby row '.
 986         'custpaybynum(%s) custnum(%s) paydate(%s) - error: %s',
 987         $row->custpaybynum,
 988         $row->custnum,
 989         $bad_paydate,
 990         $error
 991       );
 992     }
 993
 994     warn sprintf(
 995       'Autocorrected bad paydate stored in cust_payby row '.
 996       "custpaybynum(%s) custnum(%s) old-paydate(%s) new-paydate(%s)\n",
 997       $row->custpaybynum,
 998       $row->custnum,
 999       $bad_paydate,
1000       $row->paydate,
1001     );
1002
1003   }
1004
1005   FS::upgrade_journal->set_done( $journal_label );
1006   dbh->commit unless $oldAutoCommit;
1007 }
1008
1009 =head1 BUGS
1010
1011 =head1 SEE ALSO
1012
1013 L<FS::Record>, schema.html from the base documentation.
1014
1015 =cut
1016
1017 1;
1018