FS/FS/cust_payby.pm

   1 package FS::cust_payby;
   2 use base qw( FS::payinfo_Mixin FS::cust_main_Mixin FS::Record );
   3 use feature 'state';
   4
   5 use strict;
   6 use Scalar::Util qw( blessed );
   7 use Digest::SHA qw( sha512_base64 );
   8 use Business::CreditCard qw( validate cardtype );
   9 use FS::UID qw( dbh );
  10 use FS::Msgcat qw( gettext );
  11 use FS::Misc qw( card_types );
  12 use FS::Record; #qw( qsearch qsearchs );
  13 use FS::payby;
  14 use FS::cust_main;
  15 use FS::banned_pay;
  16
  17 our @encrypted_fields = ('payinfo', 'paycvv');
  18 sub nohistory_fields { ('payinfo', 'paycvv'); }
  19
  20 our $ignore_expired_card = 0;
  21 our $ignore_banned_card = 0;
  22 our $ignore_invalid_card = 0;
  23 our $ignore_cardtype = 0;
  24
  25 our $conf;
  26 install_callback FS::UID sub {
  27   $conf = new FS::Conf;
  28   #yes, need it for stuff below (prolly should be cached)
  29   $ignore_invalid_card = $conf->exists('allow_invalid_cards');
  30 };
  31
  32 =head1 NAME
  33
  34 FS::cust_payby - Object methods for cust_payby records
  35
  36 =head1 SYNOPSIS
  37
  38   use FS::cust_payby;
  39
  40   $record = new FS::cust_payby \%hash;
  41   $record = new FS::cust_payby { 'column' => 'value' };
  42
  43   $error = $record->insert;
  44
  45   $error = $new_record->replace($old_record);
  46
  47   $error = $record->delete;
  48
  49   $error = $record->check;
  50
  51 =head1 DESCRIPTION
  52
  53 An FS::cust_payby object represents customer stored payment information.
  54 FS::cust_payby inherits from FS::Record.  The following fields are currently
  55 supported:
  56
  57 =over 4
  58
  59 =item custpaybynum
  60
  61 primary key
  62
  63 =item custnum
  64
  65 custnum
  66
  67 =item weight
  68
  69 weight
  70
  71 =item payby
  72
  73 payby
  74
  75 =item payinfo
  76
  77 payinfo
  78
  79 =item paycvv
  80
  81 paycvv
  82
  83 =item paymask
  84
  85 paymask
  86
  87 =item paydate
  88
  89 paydate
  90
  91 =item paystart_month
  92
  93 paystart_month
  94
  95 =item paystart_year
  96
  97 paystart_year
  98
  99 =item payissue
 100
 101 payissue
 102
 103 =item payname
 104
 105 payname
 106
 107 =item paystate
 108
 109 paystate
 110
 111 =item paytype
 112
 113 paytype
 114
 115 =item payip
 116
 117 payip
 118
 119 =item paycardtype
 120
 121 The credit card type (deduced from the card number).
 122
 123 =back
 124
 125 =head1 METHODS
 126
 127 =over 4
 128
 129 =item new HASHREF
 130
 131 Creates a new record.  To add the record to the database, see L<"insert">.
 132
 133 Note that this stores the hash reference, not a distinct copy of the hash it
 134 points to.  You can ask the object for a copy with the I<hash> method.
 135
 136 =cut
 137
 138 # the new method can be inherited from FS::Record, if a table method is defined
 139
 140 sub table { 'cust_payby'; }
 141
 142 =item insert
 143
 144 Adds this record to the database.  If there is an error, returns the error,
 145 otherwise returns false.
 146
 147 =cut
 148
 149 sub insert {
 150   my $self = shift;
 151
 152   local $SIG{HUP} = 'IGNORE';
 153   local $SIG{INT} = 'IGNORE';
 154   local $SIG{QUIT} = 'IGNORE';
 155   local $SIG{TERM} = 'IGNORE';
 156   local $SIG{TSTP} = 'IGNORE';
 157   local $SIG{PIPE} = 'IGNORE';
 158
 159   my $oldAutoCommit = $FS::UID::AutoCommit;
 160   local $FS::UID::AutoCommit = 0;
 161   my $dbh = dbh;
 162
 163   my $error =  $self->check_payinfo_cardtype
 164             || $self->SUPER::insert;
 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     unless ( $self->tokenized ) {
 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
 361     # see parallel checks in check_payinfo_cardtype & payinfo_Mixin::payinfo_check
 362     my $cardtype = $self->paycardtype;
 363     if ( $self->tokenized ) {
 364       $self->set('is_tokenized', 'Y'); #so we don't try to do it again
 365       if ( $self->paymask =~ /^\d+x/ ) {
 366         $cardtype = cardtype($self->paymask);
 367       } else {
 368         #return "paycardtype required ".
 369         #       "(can't derive from a token and no paymask w/prefix provided)"
 370         #  unless $cardtype;
 371       }
 372     } else {
 373       $cardtype = cardtype($self->payinfo);
 374     }
 375
 376     return gettext('unknown_card_type') if $cardtype eq "Unknown";
 377
 378     $self->set('paycardtype', $cardtype);
 379
 380     unless ( $ignore_banned_card ) {
 381       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
 382       if ( $ban ) {
 383         if ( $ban->bantype eq 'warn' ) {
 384           #or others depending on value of $ban->reason ?
 385           return '_duplicate_card'.
 386                  ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
 387                  ' until '.         time2str('%a %h %o at %r', $ban->_end_date).
 388                  ' (ban# '. $ban->bannum. ')'
 389             unless $self->override_ban_warn;
 390         } else {
 391           return 'Banned credit card: banned on '.
 392                  time2str('%a %h %o at %r', $ban->_date).
 393                  ' by '. $ban->otaker.
 394                  ' (ban# '. $ban->bannum. ')';
 395         }
 396       }
 397     }
 398
 399     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
 400       if ( $cardtype eq 'American Express card' ) {
 401         $self->paycvv =~ /^(\d{4})$/
 402           or return "CVV2 (CID) for American Express cards is four digits.";
 403         $self->paycvv($1);
 404       } else {
 405         $self->paycvv =~ /^(\d{3})$/
 406           or return "CVV2 (CVC2/CID) is three digits.";
 407         $self->paycvv($1);
 408       }
 409     } else {
 410       $self->paycvv('');
 411     }
 412
 413     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
 414
 415       return "Start date or issue number is required for $cardtype cards"
 416         unless $self->paystart_month && $self->paystart_year or $self->payissue;
 417
 418       return "Start month must be between 1 and 12"
 419         if $self->paystart_month
 420            and $self->paystart_month < 1 || $self->paystart_month > 12;
 421
 422       return "Start year must be 1990 or later"
 423         if $self->paystart_year
 424            and $self->paystart_year < 1990;
 425
 426       return "Issue number must be beween 1 and 99"
 427         if $self->payissue
 428           and $self->payissue < 1 || $self->payissue > 99;
 429
 430     } else {
 431       $self->paystart_month('');
 432       $self->paystart_year('');
 433       $self->payissue('');
 434     }
 435
 436   } elsif ( !$ignore_invalid_card &&
 437     $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
 438
 439     my $payinfo = $self->payinfo;
 440     $payinfo =~ s/[^\d\@\.]//g;
 441     if ( $conf->config('echeck-country') eq 'CA' ) {
 442       $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
 443         or return 'invalid echeck account@branch.bank';
 444       $payinfo = "$1\@$2.$3";
 445     } elsif ( $conf->config('echeck-country') eq 'US' ) {
 446       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
 447       $payinfo = "$1\@$2";
 448     } else {
 449       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
 450       $payinfo = "$1\@$2";
 451     }
 452     $self->payinfo($payinfo);
 453     $self->paycvv('');
 454
 455     unless ( $ignore_banned_card ) {
 456       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
 457       if ( $ban ) {
 458         if ( $ban->bantype eq 'warn' ) {
 459           #or others depending on value of $ban->reason ?
 460           return '_duplicate_ach' unless $self->override_ban_warn;
 461         } else {
 462           return 'Banned ACH account: banned on '.
 463                  time2str('%a %h %o at %r', $ban->_date).
 464                  ' by '. $ban->otaker.
 465                  ' (ban# '. $ban->bannum. ')';
 466         }
 467       }
 468     }
 469
 470   } elsif ( $self->payby =~ /^CARD|DCRD$/ and $self->paymask ) {
 471     # either ignoring invalid cards, or we can't decrypt the payinfo, but
 472     # try to detect the card type anyway. this never returns failure, so
 473     # the contract of $ignore_invalid_cards is maintained.
 474     $self->set('paycardtype', cardtype($self->paymask));
 475   } else {
 476     $self->set('paycardtype', '');
 477   }
 478
 479 #  } elsif ( $self->payby eq 'PREPAY' ) {
 480 #
 481 #    my $payinfo = $self->payinfo;
 482 #    $payinfo =~ s/\W//g; #anything else would just confuse things
 483 #    $self->payinfo($payinfo);
 484 #    $error = $self->ut_alpha('payinfo');
 485 #    return "Illegal prepayment identifier: ". $self->payinfo if $error;
 486 #    return "Unknown prepayment identifier"
 487 #      unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 488 #    $self->paycvv('');
 489
 490   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
 491
 492     $self->paydate('');
 493
 494   } elsif ( $self->payby =~ /^(CARD|DCRD)$/ ) {
 495
 496     # shouldn't payinfo_check do this?
 497     # (except we don't ever call payinfo_check from here)
 498     return "Expiration date required"
 499       if $self->paydate eq '' || $self->paydate eq '-';
 500
 501     my( $m, $y );
 502     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
 503       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
 504     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
 505       ( $m, $y ) = ( $2, "19$1" );
 506     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
 507       ( $m, $y ) = ( $3, "20$2" );
 508     } else {
 509       return "Illegal expiration date: ". $self->paydate;
 510     }
 511     $m = sprintf('%02d',$m);
 512     $self->paydate("$y-$m-01");
 513     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
 514     return gettext('expired_card')
 515       if #XXX !$import
 516       #&&
 517          !$ignore_expired_card
 518       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
 519
 520   }
 521
 522   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
 523        ( ! $conf->exists('require_cardname')
 524          || $self->payby !~ /^(CARD|DCRD)$/  )
 525   ) {
 526     $self->payname( $self->first. " ". $self->getfield('last') );
 527   } else {
 528
 529     if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
 530       $self->payname =~ /^([\w \,\.\-\']*)$/
 531         or return gettext('illegal_name'). " payname: ". $self->payname;
 532       $self->payname($1);
 533     } else {
 534       $self->payname =~ /^([\w \,\.\-\'\&]*)$/
 535         or return gettext('illegal_name'). " payname: ". $self->payname;
 536       $self->payname($1);
 537     }
 538
 539   }
 540
 541   if ( ! $self->custpaybynum ) {
 542     if ($conf->exists('business-onlinepayment-verification')) {
 543       $error = $self->verify;
 544     } else {
 545       $error = $self->tokenize;
 546     }
 547     return $error if $error;
 548   }
 549
 550   $error = $self->ut_daten('paydate');
 551   return $error if $error;
 552
 553   $self->SUPER::check;
 554 }
 555
 556 sub check_payinfo_cardtype {
 557   my $self = shift;
 558
 559   return '' if $ignore_cardtype;
 560
 561   return '' unless $self->payby =~ /^(CARD|DCRD)$/;
 562
 563   my $payinfo = $self->payinfo;
 564   $payinfo =~ s/\D//g;
 565
 566   # see parallel checks in cust_payby::check & payinfo_Mixin::payinfo_check
 567   if ( $self->tokenized($payinfo) ) {
 568     $self->set('is_tokenized', 'Y'); #so we don't try to do it again
 569     if ( $self->paymask =~ /^\d+x/ ) {
 570       $self->set('paycardtype', cardtype($self->paymask));
 571     } else {
 572       $self->set('paycardtype', '');
 573       #return "paycardtype required ".
 574       #       "(can't derive from a token and no paymask w/prefix provided)";
 575     }
 576     return '';
 577   }
 578
 579   my %bop_card_types = map { $_=>1 } values %{ card_types() };
 580   my $cardtype = cardtype($payinfo);
 581   $self->set('paycardtype', $cardtype);
 582
 583   return "$cardtype not accepted" unless $bop_card_types{$cardtype};
 584
 585   '';
 586
 587 }
 588
 589 sub _banned_pay_hashref {
 590   my $self = shift;
 591
 592   my %payby2ban = (
 593     'CARD' => 'CARD',
 594     'DCRD' => 'CARD',
 595     'CHEK' => 'CHEK',
 596     'DCHK' => 'CHEK'
 597   );
 598
 599   {
 600     'payby'   => $payby2ban{$self->payby},
 601     'payinfo' => $self->payinfo,
 602     #don't ever *search* on reason! #'reason'  =>
 603   };
 604 }
 605
 606 sub _new_banned_pay_hashref {
 607   my $self = shift;
 608   my $hr = $self->_banned_pay_hashref;
 609   $hr->{payinfo_hash} = 'SHA512';
 610   $hr->{payinfo} = sha512_base64($hr->{payinfo});
 611   $hr;
 612 }
 613
 614 =item paydate_mon_year
 615
 616 Returns a two element list consisting of the paydate month and year.
 617
 618 =cut
 619
 620 sub paydate_mon_year {
 621   my $self = shift;
 622
 623   my $date = $self->paydate; # || '12-2037';
 624
 625   #false laziness w/elements/select-month_year.html
 626   if ( $date  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #PostgreSQL date format
 627     ( $2, $1 );
 628   } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
 629     ( $1, $3 );
 630   } else {
 631     warn "unrecognized expiration date format: $date";
 632     ( '', '' );
 633   }
 634
 635 }
 636
 637 =item label
 638
 639 Returns a one line text label for this payment type.
 640
 641 =cut
 642
 643 my %weight = (
 644   1 => 'Primary',
 645   2 => 'Secondary',
 646   3 => 'Tertiary',
 647   4 => 'Fourth',
 648   5 => 'Fifth',
 649   6 => 'Sixth',
 650   7 => 'Seventh',
 651 );
 652
 653 sub label {
 654   my $self = shift;
 655
 656   my $name = $self->payby =~ /^(CARD|DCRD)$/
 657               && $self->paycardtype || FS::payby->shortname($self->payby);
 658
 659   ( $self->payby =~ /^(CARD|CHEK)$/  ? $weight{$self->weight}. ' automatic '
 660                                      : 'Manual '
 661   ).
 662   "$name: ". $self->paymask.
 663   ( $self->payby =~ /^(CARD|DCRD)$/
 664       ? ' Exp '. join('/', $self->paydate_mon_year)
 665       : ''
 666   );
 667
 668 }
 669
 670 =item realtime_bop
 671
 672 Runs a L<FS::cust_main::Billing_Realtime/realtime_bop> transaction on this card
 673
 674 =cut
 675
 676 sub realtime_bop {
 677   my( $self, %opt ) = @_;
 678
 679   $self->cust_main->realtime_bop({
 680     %opt,
 681     'cust_payby' => $self,
 682   });
 683
 684 }
 685
 686 =item tokenize
 687
 688 Runs a L<FS::cust_main::Billing_Realtime/realtime_tokenize> transaction on this card
 689
 690 =cut
 691
 692 sub tokenize {
 693   my $self = shift;
 694   return '' unless $self->payby =~ /^(CARD|DCRD)$/;
 695
 696   $self->cust_main->realtime_tokenize({
 697     'cust_payby' => $self,
 698   });
 699
 700 }
 701
 702 =item verify
 703
 704 Runs a L<realtime_verify_bop|FS::cust_main::Billing_Realtime/realtime_verify_bop> transaction on this card
 705
 706 =cut
 707
 708 sub verify {
 709   my $self = shift;
 710   return '' unless $self->payby =~ /^(CARD|DCRD)$/;
 711
 712   $self->cust_main->realtime_verify_bop({
 713     'cust_payby' => $self,
 714   });
 715
 716 }
 717
 718 =item paytypes
 719
 720 Returns a list of valid values for the paytype field (bank account type for
 721 electronic check payment).
 722
 723 =cut
 724
 725 sub paytypes {
 726   #my $class = shift;
 727
 728   ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
 729 }
 730
 731 =item cgi_cust_payby_fields
 732
 733 Returns the field names used in the web interface (including some pseudo-fields).
 734
 735 =cut
 736
 737 sub cgi_cust_payby_fields {
 738   #my $class = shift;
 739   [qw( payby payinfo paydate_month paydate_year paycvv payname weight
 740        payinfo1 payinfo2 payinfo3 paytype paystate payname_CHEK )];
 741 }
 742
 743 =item cgi_hash_callback HASHREF OLD
 744
 745 Subroutine (not a class or object method).  Processes a hash reference
 746 of web interface contet (transfers the data from pseudo-fields to real fields).
 747
 748 If OLD object is passed, also preserves locationnum, paystart_month, paystart_year,
 749 payissue and payip.  If the new field is blank but the old is not, the old field
 750 will be preserved.
 751
 752 =cut
 753
 754 sub cgi_hash_callback {
 755   my $hashref = shift;
 756   my $old = shift;
 757
 758   my %noauto = (
 759     'CARD' => 'DCRD',
 760     'CHEK' => 'DCHK',
 761   );
 762   # the payby selector gives the choice of CARD or CHEK (or others, but
 763   # those are the ones with auto and on-demand versions). if the user didn't
 764   # choose a weight, then they mean DCRD/DCHK.
 765   $hashref->{payby} = $noauto{$hashref->{payby}}
 766     if ! $hashref->{weight} && exists $noauto{$hashref->{payby}};
 767
 768   if ( $hashref->{payby} =~ /^(CHEK|DCHK)$/ ) {
 769
 770     unless ( grep $hashref->{$_}, qw(payinfo1 payinfo2 payinfo3 payname_CHEK)) {
 771       %$hashref = ();
 772       return;
 773     }
 774
 775     $hashref->{payinfo} = $hashref->{payinfo1}. '@';
 776     $hashref->{payinfo} .= $hashref->{payinfo3}.'.'
 777       if $conf->config('echeck-country') eq 'CA';
 778     $hashref->{payinfo} .= $hashref->{'payinfo2'};
 779
 780     $hashref->{payname} = $hashref->{'payname_CHEK'};
 781
 782   } elsif ( $hashref->{payby} =~ /^(CARD|DCRD)$/ ) {
 783
 784     unless ( grep $hashref->{$_}, qw( payinfo paycvv payname ) ) {
 785       %$hashref = ();
 786       return;
 787     }
 788
 789   }
 790
 791   $hashref->{paydate}= $hashref->{paydate_month}. '-'. $hashref->{paydate_year};
 792
 793   if ($old) {
 794     foreach my $field ( qw(locationnum paystart_month paystart_year payissue payip) ) {
 795       next if $hashref->{$field};
 796       next unless $old->get($field);
 797       $hashref->{$field} = $old->get($field);
 798     }
 799   }
 800
 801 }
 802
 803 =item search_sql
 804
 805 Class method.
 806
 807 Returns a qsearch hash expression to search for parameters specified in HASHREF.
 808 Valid paramters are:
 809
 810 =over 4
 811
 812 =item payby
 813
 814 listref
 815
 816 =item paydate_year
 817
 818 =item paydate_month
 819
 820
 821 =back
 822
 823 =cut
 824
 825 sub search_sql {
 826   my ($class, $params) = @_;
 827
 828   my @where = ();
 829   my $orderby;
 830
 831   # initialize these to prevent warnings
 832   $params = {
 833     'paydate_year'  => '',
 834     %$params
 835   };
 836
 837   ###
 838   # payby
 839   ###
 840
 841   if ( $params->{'payby'} ) {
 842
 843     my @payby = ref( $params->{'payby'} )
 844                   ? @{ $params->{'payby'} }
 845                   :  ( $params->{'payby'} );
 846
 847     @payby = grep /^([A-Z]{4})$/, @payby;
 848     my $in_payby = 'IN(' . join(',', map {"'$_'"} @payby) . ')';
 849     push @where, "cust_payby.payby $in_payby"
 850       if @payby;
 851   }
 852
 853   ###
 854   # paydate_year / paydate_month
 855   ###
 856
 857   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
 858     my $year = $1;
 859     $params->{'paydate_month'} =~ /^(\d\d?)$/
 860       or die "paydate_year without paydate_month?";
 861     my $month = $1;
 862
 863     push @where,
 864       'cust_payby.paydate IS NOT NULL',
 865       "cust_payby.paydate != ''",
 866       "CAST(cust_payby.paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
 867 ;
 868   }
 869   ##
 870   # setup queries, subs, etc. for the search
 871   ##
 872
 873   $orderby ||= 'ORDER BY custnum';
 874
 875   # here is the agent virtualization
 876   push @where,
 877     $FS::CurrentUser::CurrentUser->agentnums_sql(table => 'cust_main');
 878
 879   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
 880
 881   my $addl_from = ' LEFT JOIN cust_main USING ( custnum ) ';
 882   # always make address fields available in results
 883   for my $pre ('bill_', 'ship_') {
 884     $addl_from .=
 885       ' LEFT JOIN cust_location AS '.$pre.'location '.
 886       'ON (cust_main.'.$pre.'locationnum = '.$pre.'location.locationnum) ';
 887   }
 888   # always make referral available in results
 889   #   (maybe we should be using FS::UI::Web::join_cust_main instead?)
 890   $addl_from .= ' LEFT JOIN (select refnum, referral from part_referral) AS part_referral_x ON (cust_main.refnum = part_referral_x.refnum) ';
 891
 892   my $count_query = "SELECT COUNT(*) FROM cust_payby $addl_from $extra_sql";
 893
 894   my @select = ( 'cust_payby.*',
 895                  #'cust_main.custnum',
 896                  # there's a good chance that we'll need these
 897                  'cust_main.bill_locationnum',
 898                  'cust_main.ship_locationnum',
 899                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
 900                );
 901
 902   my $select = join(', ', @select);
 903
 904   my $sql_query = {
 905     'table'         => 'cust_payby',
 906     'select'        => $select,
 907     'addl_from'     => $addl_from,
 908     'hashref'       => {},
 909     'extra_sql'     => $extra_sql,
 910     'order_by'      => $orderby,
 911     'count_query'   => $count_query,
 912   };
 913   $sql_query;
 914
 915 }
 916
 917 =back
 918
 919 =item has_autobill_cards
 920
 921 Returns the number of unexpired cards configured for autobill
 922
 923 =cut
 924
 925 sub has_autobill_cards {
 926   scalar FS::Record::qsearch({
 927     table     => 'cust_payby',
 928     addl_from => 'JOIN cust_main USING (custnum)',
 929     order_by  => 'LIMIT 1',
 930     hashref   => {
 931         paydate => { op => '>', value => DateTime->now->ymd },
 932         weight  => { op => '>',  value => 0 },
 933     },
 934     extra_sql =>
 935       "AND cust_payby.payby IN ('CARD', 'DCRD') ".
 936       'AND '.
 937       $FS::CurrentUser::CurrentUser->agentnums_sql( table => 'cust_main' ),
 938   });
 939 }
 940
 941 =item has_autobill_checks
 942
 943 Returns the number of check accounts configured for autobill
 944
 945 =cut
 946
 947 sub has_autobill_checks {
 948   scalar FS::Record::qsearch({
 949     table     => 'cust_payby',
 950     addl_from => 'JOIN cust_main USING (custnum)',
 951     order_by  => 'LIMIT 1',
 952     hashref   => {
 953         weight  => { op => '>',  value => 0 },
 954     },
 955     extra_sql =>
 956       "AND cust_payby.payby IN ('CHEK','DCHEK','DCHK') ".
 957       'AND '.
 958       $FS::CurrentUser::CurrentUser->agentnums_sql( table => 'cust_main' ),
 959   });
 960 }
 961
 962 =item future_autobill_report_title
 963
 964 Determine if the future_autobill report should be available.
 965 If so, return a dynamic title for it
 966
 967 =cut
 968
 969 sub future_autobill_report_title {
 970   # Perhaps this function belongs somewhere else
 971   state $title;
 972   return $title if defined $title;
 973
 974   # Report incompatible with tax engines
 975   return $title = '' if FS::TaxEngine->new->info->{batch};
 976
 977   my $has_cards  = has_autobill_cards();
 978   my $has_checks = has_autobill_checks();
 979   my $_title = 'Future %s transactions';
 980
 981   if ( $has_cards && $has_checks ) {
 982     $title = sprintf $_title, 'credit card and electronic check';
 983   } elsif ( $has_cards ) {
 984     $title = sprintf $_title, 'credit card';
 985   } elsif ( $has_checks ) {
 986     $title = sprintf $_title, 'electronic check';
 987   } else {
 988     $title = '';
 989   }
 990
 991   $title;
 992 }
 993
 994 sub _upgrade_data {
 995
 996   my $class = shift;
 997   local $ignore_banned_card = 1;
 998   local $ignore_expired_card = 1;
 999   local $ignore_invalid_card = 1;
1000   $class->upgrade_set_cardtype;
1001   $class->_upgrade_data_paydate_edgebug;
1002
1003 }
1004
1005 =item _upgrade_data_paydate_edgebug
1006
1007 Correct bad data injected into payment expire date column by Edge browser bug
1008
1009 The month and year values may have an extra character injected into form POST
1010 data by Edge browser.  It was possible for some bad month values to slip
1011 past data validation.
1012
1013 If the stored value was out of range, it was causing payments screen to crash.
1014 We can detect and fix this by dropping the second digit.
1015
1016 If the stored value is is 11 or 12, it's possible the user inputted a 1.  In
1017 this case, the payment method will fail to authorize, but the record will
1018 not cause crashdumps for being out of range.
1019
1020 In short, check for any expiration month > 12, and drop the extra digit
1021
1022 =cut
1023
1024 sub _upgrade_data_paydate_edgebug {
1025   my $journal_label = 'cust_payby_paydate_edgebug';
1026   return if FS::upgrade_journal->is_done( $journal_label );
1027
1028   my $oldAutoCommit = $FS::UID::AutoCommit;
1029   local $FS::UID::AutoCommit = 0;
1030
1031   for my $row (
1032     FS::Record::qsearch(
1033       cust_payby => { paydate => { op => '!=', value => '' }}
1034     )
1035   ) {
1036     next unless $row->ut_daten('paydate');
1037
1038     # paydate column stored in database has failed date validation
1039     my $bad_paydate = $row->paydate;
1040
1041     my @date = split /[\-\/]/, $bad_paydate;
1042     @date = @date[2,0,1] if $date[2] > 1900;
1043
1044     # Only autocorrecting when month > 12 - notify operator
1045     unless ( $date[1] > 12 ) {
1046       die sprintf(
1047         'Unable to correct bad paydate stored in cust_payby row '.
1048         'custpaybynum(%s) custnum(%s) paydate(%s)',
1049         $row->custpaybynum,
1050         $row->custnum,
1051         $bad_paydate,
1052       );
1053     }
1054
1055     $date[1] = substr( $date[1], 0, 1 );
1056     $row->paydate( join('-', @date ));
1057
1058     if ( my $error = $row->replace ) {
1059       die sprintf(
1060         'Failed to autocorrect bad paydate stored in cust_payby row '.
1061         'custpaybynum(%s) custnum(%s) paydate(%s) - error: %s',
1062         $row->custpaybynum,
1063         $row->custnum,
1064         $bad_paydate,
1065         $error
1066       );
1067     }
1068
1069     warn sprintf(
1070       'Autocorrected bad paydate stored in cust_payby row '.
1071       "custpaybynum(%s) custnum(%s) old-paydate(%s) new-paydate(%s)\n",
1072       $row->custpaybynum,
1073       $row->custnum,
1074       $bad_paydate,
1075       $row->paydate,
1076     );
1077
1078   }
1079
1080   FS::upgrade_journal->set_done( $journal_label );
1081   dbh->commit unless $oldAutoCommit;
1082 }
1083
1084 =head1 BUGS
1085
1086 =head1 SEE ALSO
1087
1088 L<FS::Record>, schema.html from the base documentation.
1089
1090 =cut
1091
1092 1;
1093