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_daten('paydate')
 319     || $self->ut_numbern('paystart_month')
 320     || $self->ut_numbern('paystart_year')
 321     || $self->ut_numbern('payissue')
 322 #    || $self->ut_textn('payname') #XXX something
 323     || $self->ut_alphan('paystate')
 324     || $self->ut_textn('paytype')
 325     || $self->ut_ipn('payip')
 326   ;
 327   return $error if $error;
 328
 329   ### from cust_main
 330
 331   FS::payby->can_payby($self->table, $self->payby)
 332     or return "Illegal payby: ". $self->payby;
 333
 334   # If it is encrypted and the private key is not availaible then we can't
 335   # check the credit card.
 336   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
 337
 338   # Need some kind of global flag to accept invalid cards, for testing
 339   # on scrubbed data.
 340   #XXX if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
 341
 342   # In this block: detect card type; reject credit card / account numbers that
 343   # are impossible or banned; reject other payment features (date, CVV length)
 344   # that are inappropriate for the card type.
 345   # However, if the payinfo is encrypted then just detect card type and assume
 346   # the other checks were already done.
 347
 348   if ( !$ignore_invalid_card &&
 349     $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
 350
 351     my $payinfo = $self->payinfo;
 352     $payinfo =~ s/\D//g;
 353     $payinfo =~ /^(\d{13,19}|\d{8,9})$/
 354       or return gettext('invalid_card'); #. ": ". $self->payinfo;
 355     $payinfo = $1;
 356     $self->payinfo($payinfo);
 357     validate($payinfo)
 358       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 359
 360     # see parallel checks in check_payinfo_cardtype & payinfo_Mixin::payinfo_check
 361     my $cardtype = $self->paycardtype;
 362     if ( $self->tokenized ) {
 363       $self->set('is_tokenized', 'Y'); #so we don't try to do it again
 364       if ( $self->paymask =~ /^\d+x/ ) {
 365         $cardtype = cardtype($self->paymask);
 366       } else {
 367         #return "paycardtype required ".
 368         #       "(can't derive from a token and no paymask w/prefix provided)"
 369         #  unless $cardtype;
 370       }
 371     } else {
 372       $cardtype = cardtype($self->payinfo);
 373     }
 374
 375     return gettext('unknown_card_type') if $cardtype eq "Unknown";
 376
 377     $self->set('paycardtype', $cardtype);
 378
 379     unless ( $ignore_banned_card ) {
 380       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
 381       if ( $ban ) {
 382         if ( $ban->bantype eq 'warn' ) {
 383           #or others depending on value of $ban->reason ?
 384           return '_duplicate_card'.
 385                  ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
 386                  ' until '.         time2str('%a %h %o at %r', $ban->_end_date).
 387                  ' (ban# '. $ban->bannum. ')'
 388             unless $self->override_ban_warn;
 389         } else {
 390           return 'Banned credit card: banned on '.
 391                  time2str('%a %h %o at %r', $ban->_date).
 392                  ' by '. $ban->otaker.
 393                  ' (ban# '. $ban->bannum. ')';
 394         }
 395       }
 396     }
 397
 398     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
 399       if ( $cardtype eq 'American Express card' ) {
 400         $self->paycvv =~ /^(\d{4})$/
 401           or return "CVV2 (CID) for American Express cards is four digits.";
 402         $self->paycvv($1);
 403       } else {
 404         $self->paycvv =~ /^(\d{3})$/
 405           or return "CVV2 (CVC2/CID) is three digits.";
 406         $self->paycvv($1);
 407       }
 408     } else {
 409       $self->paycvv('');
 410     }
 411
 412     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
 413
 414       return "Start date or issue number is required for $cardtype cards"
 415         unless $self->paystart_month && $self->paystart_year or $self->payissue;
 416
 417       return "Start month must be between 1 and 12"
 418         if $self->paystart_month
 419            and $self->paystart_month < 1 || $self->paystart_month > 12;
 420
 421       return "Start year must be 1990 or later"
 422         if $self->paystart_year
 423            and $self->paystart_year < 1990;
 424
 425       return "Issue number must be beween 1 and 99"
 426         if $self->payissue
 427           and $self->payissue < 1 || $self->payissue > 99;
 428
 429     } else {
 430       $self->paystart_month('');
 431       $self->paystart_year('');
 432       $self->payissue('');
 433     }
 434
 435   } elsif ( !$ignore_invalid_card &&
 436     $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
 437
 438     my $payinfo = $self->payinfo;
 439     $payinfo =~ s/[^\d\@\.]//g;
 440     if ( $conf->config('echeck-country') eq 'CA' ) {
 441       $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
 442         or return 'invalid echeck account@branch.bank';
 443       $payinfo = "$1\@$2.$3";
 444     } elsif ( $conf->config('echeck-country') eq 'US' ) {
 445       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
 446       $payinfo = "$1\@$2";
 447     } else {
 448       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
 449       $payinfo = "$1\@$2";
 450     }
 451     $self->payinfo($payinfo);
 452     $self->paycvv('');
 453
 454     unless ( $ignore_banned_card ) {
 455       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
 456       if ( $ban ) {
 457         if ( $ban->bantype eq 'warn' ) {
 458           #or others depending on value of $ban->reason ?
 459           return '_duplicate_ach' unless $self->override_ban_warn;
 460         } else {
 461           return 'Banned ACH account: banned on '.
 462                  time2str('%a %h %o at %r', $ban->_date).
 463                  ' by '. $ban->otaker.
 464                  ' (ban# '. $ban->bannum. ')';
 465         }
 466       }
 467     }
 468
 469   } elsif ( $self->payby =~ /^CARD|DCRD$/ and $self->paymask ) {
 470     # either ignoring invalid cards, or we can't decrypt the payinfo, but
 471     # try to detect the card type anyway. this never returns failure, so
 472     # the contract of $ignore_invalid_cards is maintained.
 473     $self->set('paycardtype', cardtype($self->paymask));
 474   } else {
 475     $self->set('paycardtype', '');
 476   }
 477
 478 #  } elsif ( $self->payby eq 'PREPAY' ) {
 479 #
 480 #    my $payinfo = $self->payinfo;
 481 #    $payinfo =~ s/\W//g; #anything else would just confuse things
 482 #    $self->payinfo($payinfo);
 483 #    $error = $self->ut_alpha('payinfo');
 484 #    return "Illegal prepayment identifier: ". $self->payinfo if $error;
 485 #    return "Unknown prepayment identifier"
 486 #      unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 487 #    $self->paycvv('');
 488
 489   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
 490
 491     $self->paydate('');
 492
 493   } elsif ( $self->payby =~ /^(CARD|DCRD)$/ ) {
 494
 495     # shouldn't payinfo_check do this?
 496     # (except we don't ever call payinfo_check from here)
 497     return "Expiration date required"
 498       if $self->paydate eq '' || $self->paydate eq '-';
 499
 500     my( $m, $y );
 501     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
 502       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
 503     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
 504       ( $m, $y ) = ( $2, "19$1" );
 505     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
 506       ( $m, $y ) = ( $3, "20$2" );
 507     } else {
 508       return "Illegal expiration date: ". $self->paydate;
 509     }
 510     $m = sprintf('%02d',$m);
 511     $self->paydate("$y-$m-01");
 512     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
 513     return gettext('expired_card')
 514       if #XXX !$import
 515       #&&
 516          !$ignore_expired_card
 517       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
 518
 519   }
 520
 521   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
 522        ( ! $conf->exists('require_cardname')
 523          || $self->payby !~ /^(CARD|DCRD)$/  )
 524   ) {
 525     $self->payname( $self->first. " ". $self->getfield('last') );
 526   } else {
 527
 528     if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
 529       $self->payname =~ /^([\w \,\.\-\']*)$/
 530         or return gettext('illegal_name'). " payname: ". $self->payname;
 531       $self->payname($1);
 532     } else {
 533       $self->payname =~ /^([\w \,\.\-\'\&]*)$/
 534         or return gettext('illegal_name'). " payname: ". $self->payname;
 535       $self->payname($1);
 536     }
 537
 538   }
 539
 540   if ( ! $self->custpaybynum ) {
 541     if ($conf->exists('business-onlinepayment-verification')) {
 542       $error = $self->verify;
 543     } else {
 544       $error = $self->tokenize;
 545     }
 546     return $error if $error;
 547   }
 548
 549   $self->SUPER::check;
 550 }
 551
 552 sub check_payinfo_cardtype {
 553   my $self = shift;
 554
 555   return '' if $ignore_cardtype;
 556
 557   return '' unless $self->payby =~ /^(CARD|CHEK)$/;
 558
 559   my $payinfo = $self->payinfo;
 560   $payinfo =~ s/\D//g;
 561
 562   # see parallel checks in cust_payby::check & payinfo_Mixin::payinfo_check
 563   if ( $self->tokenized($payinfo) ) {
 564     $self->set('is_tokenized', 'Y'); #so we don't try to do it again
 565     if ( $self->paymask =~ /^\d+x/ ) {
 566       $self->set('paycardtype', cardtype($self->paymask));
 567     } else {
 568       $self->set('paycardtype', '');
 569       #return "paycardtype required ".
 570       #       "(can't derive from a token and no paymask w/prefix provided)";
 571     }
 572     return '';
 573   }
 574
 575   my %bop_card_types = map { $_=>1 } values %{ card_types() };
 576   my $cardtype = cardtype($payinfo);
 577   $self->set('paycardtype', $cardtype);
 578
 579   return "$cardtype not accepted" unless $bop_card_types{$cardtype};
 580
 581   '';
 582
 583 }
 584
 585 sub _banned_pay_hashref {
 586   my $self = shift;
 587
 588   my %payby2ban = (
 589     'CARD' => 'CARD',
 590     'DCRD' => 'CARD',
 591     'CHEK' => 'CHEK',
 592     'DCHK' => 'CHEK'
 593   );
 594
 595   {
 596     'payby'   => $payby2ban{$self->payby},
 597     'payinfo' => $self->payinfo,
 598     #don't ever *search* on reason! #'reason'  =>
 599   };
 600 }
 601
 602 sub _new_banned_pay_hashref {
 603   my $self = shift;
 604   my $hr = $self->_banned_pay_hashref;
 605   $hr->{payinfo_hash} = 'SHA512';
 606   $hr->{payinfo} = sha512_base64($hr->{payinfo});
 607   $hr;
 608 }
 609
 610 =item paydate_mon_year
 611
 612 Returns a two element list consisting of the paydate month and year.
 613
 614 =cut
 615
 616 sub paydate_mon_year {
 617   my $self = shift;
 618
 619   my $date = $self->paydate; # || '12-2037';
 620
 621   #false laziness w/elements/select-month_year.html
 622   if ( $date  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #PostgreSQL date format
 623     ( $2, $1 );
 624   } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
 625     ( $1, $3 );
 626   } else {
 627     warn "unrecognized expiration date format: $date";
 628     ( '', '' );
 629   }
 630
 631 }
 632
 633 =item label
 634
 635 Returns a one line text label for this payment type.
 636
 637 =cut
 638
 639 my %weight = (
 640   1 => 'Primary',
 641   2 => 'Secondary',
 642   3 => 'Tertiary',
 643   4 => 'Fourth',
 644   5 => 'Fifth',
 645   6 => 'Sixth',
 646   7 => 'Seventh',
 647 );
 648
 649 sub label {
 650   my $self = shift;
 651
 652   my $name = $self->payby =~ /^(CARD|DCRD)$/
 653               && $self->paycardtype || FS::payby->shortname($self->payby);
 654
 655   ( $self->payby =~ /^(CARD|CHEK)$/  ? $weight{$self->weight}. ' automatic '
 656                                      : 'Manual '
 657   ).
 658   "$name: ". $self->paymask.
 659   ( $self->payby =~ /^(CARD|DCRD)$/
 660       ? ' Exp '. join('/', $self->paydate_mon_year)
 661       : ''
 662   );
 663
 664 }
 665
 666 =item realtime_bop
 667
 668 Runs a L<realtime_bop|FS::cust_main::Billing_Realtime::realtime_bop> transaction on this card
 669
 670 =cut
 671
 672 sub realtime_bop {
 673   my( $self, %opt ) = @_;
 674
 675   $self->cust_main->realtime_bop({
 676     %opt,
 677     'cust_payby' => $self,
 678   });
 679
 680 }
 681
 682 =item tokenize
 683
 684 Runs a L<realtime_tokenize|FS::cust_main::Billing_Realtime::realtime_tokenize> transaction on this card
 685
 686 =cut
 687
 688 sub tokenize {
 689   my $self = shift;
 690   return '' unless $self->payby =~ /^(CARD|DCRD)$/;
 691
 692   $self->cust_main->realtime_tokenize({
 693     'cust_payby' => $self,
 694   });
 695
 696 }
 697
 698 =item verify
 699
 700 Runs a L<realtime_verify_bop|FS::cust_main::Billing_Realtime/realtime_verify_bop> transaction on this card
 701
 702 =cut
 703
 704 sub verify {
 705   my $self = shift;
 706   return '' unless $self->payby =~ /^(CARD|DCRD)$/;
 707
 708   $self->cust_main->realtime_verify_bop({
 709     'cust_payby' => $self,
 710   });
 711
 712 }
 713
 714 =item paytypes
 715
 716 Returns a list of valid values for the paytype field (bank account type for
 717 electronic check payment).
 718
 719 =cut
 720
 721 sub paytypes {
 722   #my $class = shift;
 723
 724   ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
 725 }
 726
 727 =item cgi_cust_payby_fields
 728
 729 Returns the field names used in the web interface (including some pseudo-fields).
 730
 731 =cut
 732
 733 sub cgi_cust_payby_fields {
 734   #my $class = shift;
 735   [qw( payby payinfo paydate_month paydate_year paycvv payname weight
 736        payinfo1 payinfo2 payinfo3 paytype paystate payname_CHEK )];
 737 }
 738
 739 =item cgi_hash_callback HASHREF OLD
 740
 741 Subroutine (not a class or object method).  Processes a hash reference
 742 of web interface contet (transfers the data from pseudo-fields to real fields).
 743
 744 If OLD object is passed, also preserves locationnum, paystart_month, paystart_year,
 745 payissue and payip.  If the new field is blank but the old is not, the old field
 746 will be preserved.
 747
 748 =cut
 749
 750 sub cgi_hash_callback {
 751   my $hashref = shift;
 752   my $old = shift;
 753
 754   my %noauto = (
 755     'CARD' => 'DCRD',
 756     'CHEK' => 'DCHK',
 757   );
 758   # the payby selector gives the choice of CARD or CHEK (or others, but
 759   # those are the ones with auto and on-demand versions). if the user didn't
 760   # choose a weight, then they mean DCRD/DCHK.
 761   $hashref->{payby} = $noauto{$hashref->{payby}}
 762     if ! $hashref->{weight} && exists $noauto{$hashref->{payby}};
 763
 764   if ( $hashref->{payby} =~ /^(CHEK|DCHK)$/ ) {
 765
 766     unless ( grep $hashref->{$_}, qw(payinfo1 payinfo2 payinfo3 payname_CHEK)) {
 767       %$hashref = ();
 768       return;
 769     }
 770
 771     $hashref->{payinfo} = $hashref->{payinfo1}. '@';
 772     $hashref->{payinfo} .= $hashref->{payinfo3}.'.'
 773       if $conf->config('echeck-country') eq 'CA';
 774     $hashref->{payinfo} .= $hashref->{'payinfo2'};
 775
 776     $hashref->{payname} = $hashref->{'payname_CHEK'};
 777
 778   } elsif ( $hashref->{payby} =~ /^(CARD|DCRD)$/ ) {
 779
 780     unless ( grep $hashref->{$_}, qw( payinfo paycvv payname ) ) {
 781       %$hashref = ();
 782       return;
 783     }
 784
 785   }
 786
 787   $hashref->{paydate}= $hashref->{paydate_month}. '-'. $hashref->{paydate_year};
 788
 789   if ($old) {
 790     foreach my $field ( qw(locationnum paystart_month paystart_year payissue payip) ) {
 791       next if $hashref->{$field};
 792       next unless $old->get($field);
 793       $hashref->{$field} = $old->get($field);
 794     }
 795   }
 796
 797 }
 798
 799 =item search_sql
 800
 801 Class method.
 802
 803 Returns a qsearch hash expression to search for parameters specified in HASHREF.
 804 Valid paramters are:
 805
 806 =over 4
 807
 808 =item payby
 809
 810 listref
 811
 812 =item paydate_year
 813
 814 =item paydate_month
 815
 816
 817 =back
 818
 819 =cut
 820
 821 sub search_sql {
 822   my ($class, $params) = @_;
 823
 824   my @where = ();
 825   my $orderby;
 826
 827   # initialize these to prevent warnings
 828   $params = {
 829     'paydate_year'  => '',
 830     %$params
 831   };
 832
 833   ###
 834   # payby
 835   ###
 836
 837   if ( $params->{'payby'} ) {
 838
 839     my @payby = ref( $params->{'payby'} )
 840                   ? @{ $params->{'payby'} }
 841                   :  ( $params->{'payby'} );
 842
 843     @payby = grep /^([A-Z]{4})$/, @payby;
 844     my $in_payby = 'IN(' . join(',', map {"'$_'"} @payby) . ')';
 845     push @where, "cust_payby.payby $in_payby"
 846       if @payby;
 847   }
 848
 849   ###
 850   # paydate_year / paydate_month
 851   ###
 852
 853   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
 854     my $year = $1;
 855     $params->{'paydate_month'} =~ /^(\d\d?)$/
 856       or die "paydate_year without paydate_month?";
 857     my $month = $1;
 858
 859     push @where,
 860       'cust_payby.paydate IS NOT NULL',
 861       "cust_payby.paydate != ''",
 862       "CAST(cust_payby.paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
 863 ;
 864   }
 865   ##
 866   # setup queries, subs, etc. for the search
 867   ##
 868
 869   $orderby ||= 'ORDER BY custnum';
 870
 871   # here is the agent virtualization
 872   push @where,
 873     $FS::CurrentUser::CurrentUser->agentnums_sql(table => 'cust_main');
 874
 875   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
 876
 877   my $addl_from = ' LEFT JOIN cust_main USING ( custnum ) ';
 878   # always make address fields available in results
 879   for my $pre ('bill_', 'ship_') {
 880     $addl_from .=
 881       ' LEFT JOIN cust_location AS '.$pre.'location '.
 882       'ON (cust_main.'.$pre.'locationnum = '.$pre.'location.locationnum) ';
 883   }
 884   # always make referral available in results
 885   #   (maybe we should be using FS::UI::Web::join_cust_main instead?)
 886   $addl_from .= ' LEFT JOIN (select refnum, referral from part_referral) AS part_referral_x ON (cust_main.refnum = part_referral_x.refnum) ';
 887
 888   my $count_query = "SELECT COUNT(*) FROM cust_payby $addl_from $extra_sql";
 889
 890   my @select = ( 'cust_payby.*',
 891                  #'cust_main.custnum',
 892                  # there's a good chance that we'll need these
 893                  'cust_main.bill_locationnum',
 894                  'cust_main.ship_locationnum',
 895                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
 896                );
 897
 898   my $select = join(', ', @select);
 899
 900   my $sql_query = {
 901     'table'         => 'cust_payby',
 902     'select'        => $select,
 903     'addl_from'     => $addl_from,
 904     'hashref'       => {},
 905     'extra_sql'     => $extra_sql,
 906     'order_by'      => $orderby,
 907     'count_query'   => $count_query,
 908   };
 909   $sql_query;
 910
 911 }
 912
 913 =back
 914
 915 =cut
 916
 917 sub _upgrade_data {
 918
 919   my $class = shift;
 920   local $ignore_banned_card = 1;
 921   local $ignore_expired_card = 1;
 922   local $ignore_invalid_card = 1;
 923   $class->upgrade_set_cardtype;
 924   $class->_upgrade_data_paydate_edgebug;
 925
 926 }
 927
 928 =item _upgrade_data_paydate_edgebug
 929
 930 Correct bad data injected into payment expire date column by Edge browser bug
 931
 932 The month and year values may have an extra character injected into form POST
 933 data by Edge browser.  It was possible for some bad month values to slip
 934 past data validation.
 935
 936 If the stored value was out of range, it was causing payments screen to crash.
 937 We can detect and fix this by dropping the second digit.
 938
 939 If the stored value is is 11 or 12, it's possible the user inputted a 1.  In
 940 this case, the payment method will fail to authorize, but the record will
 941 not cause crashdumps for being out of range.
 942
 943 In short, check for any expiration month > 12, and drop the extra digit
 944
 945 =cut
 946
 947 sub _upgrade_data_paydate_edgebug {
 948   my $journal_label = 'cust_payby_paydate_edgebug';
 949   return if FS::upgrade_journal->is_done( $journal_label );
 950
 951   my $oldAutoCommit = $FS::UID::AutoCommit;
 952   local $FS::UID::AutoCommit = 0;
 953
 954   for my $row (
 955     FS::Record::qsearch(
 956       cust_payby => { paydate => { op => '!=', value => '' }}
 957     )
 958   ) {
 959     next unless $row->ut_daten('paydate');
 960
 961     # paydate column stored in database has failed date validation
 962     my $bad_paydate = $row->paydate;
 963
 964     my @date = split /[\-\/]/, $bad_paydate;
 965     @date = @date[2,0,1] if $date[2] > 1900;
 966
 967     # Only autocorrecting when month > 12 - notify operator
 968     unless ( $date[1] > 12 ) {
 969       die sprintf(
 970         'Unable to correct bad paydate stored in cust_payby row '.
 971         'custpaybynum(%s) custnum(%s) paydate(%s)',
 972         $row->custpaybynum,
 973         $row->custnum,
 974         $bad_paydate,
 975       );
 976     }
 977
 978     $date[1] = substr( $date[1], 0, 1 );
 979     $row->paydate( join('-', @date ));
 980
 981     if ( my $error = $row->replace ) {
 982       die sprintf(
 983         'Failed to autocorrect bad paydate stored in cust_payby row '.
 984         'custpaybynum(%s) custnum(%s) paydate(%s) - error: %s',
 985         $row->custpaybynum,
 986         $row->custnum,
 987         $bad_paydate,
 988         $error
 989       );
 990     }
 991
 992     warn sprintf(
 993       'Autocorrected bad paydate stored in cust_payby row '.
 994       "custpaybynum(%s) custnum(%s) old-paydate(%s) new-paydate(%s)\n",
 995       $row->custpaybynum,
 996       $row->custnum,
 997       $bad_paydate,
 998       $row->paydate,
 999     );
1000
1001   }
1002
1003   FS::upgrade_journal->set_done( $journal_label );
1004   dbh->commit unless $oldAutoCommit;
1005 }
1006
1007 =head1 BUGS
1008
1009 =head1 SEE ALSO
1010
1011 L<FS::Record>, schema.html from the base documentation.
1012
1013 =cut
1014
1015 1;
1016