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 if $self->payby =~/^(CARD|DCRD)$/;
 164   $self->SUPER::insert unless $error;
 165
 166   if ( $error ) {
 167     $dbh->rollback if $oldAutoCommit;
 168     return $error;
 169   }
 170
 171   if ( $self->payby =~ /^(CARD|CHEK)$/ ) {
 172     # new auto card/check info, want to retry realtime_ invoice events
 173     #  (new customer?  that's okay, they won't have any)
 174     my $error = $self->cust_main->retry_realtime;
 175     if ( $error ) {
 176       $dbh->rollback if $oldAutoCommit;
 177       return $error;
 178     }
 179   }
 180
 181   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 182   '';
 183
 184 }
 185
 186 =item delete
 187
 188 Delete this record from the database.
 189
 190 =item replace OLD_RECORD
 191
 192 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 193 returns the error, otherwise returns false.
 194
 195 =cut
 196
 197 sub replace {
 198   my $self = shift;
 199
 200   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 201               ? shift
 202               : $self->replace_old;
 203
 204   if ( $self->payby =~ /^(CARD|DCRD)$/
 205        && (    $self->payinfo =~ /xx/
 206             || $self->payinfo =~ /^\s*N\/A\s+\(tokenized\)\s*$/
 207           )
 208      )
 209   {
 210
 211     $self->payinfo($old->payinfo);
 212
 213   } elsif ( $self->payby =~ /^(CHEK|DCHK)$/ && $self->payinfo =~ /xx/ ) {
 214     #fix for #3085 "edit of customer's routing code only surprisingly causes
 215     #nothing to happen...
 216     # this probably won't do the right thing when we don't have the
 217     # public key (can't actually get the real $old->payinfo)
 218     my($new_account, $new_aba) = split('@', $self->payinfo);
 219     my($old_account, $old_aba) = split('@', $old->payinfo);
 220     $new_account = $old_account if $new_account =~ /xx/;
 221     $new_aba     = $old_aba     if $new_aba     =~ /xx/;
 222     $self->payinfo($new_account.'@'.$new_aba);
 223   }
 224
 225   # only unmask paycvv if payinfo stayed the same
 226   if ( $self->payby =~ /^(CARD|DCRD)$/ and $self->paycvv =~ /^\s*[\*x]+\s*$/ ) {
 227     if ( $old->payinfo eq $self->payinfo
 228          && $old->paymask eq $self->paymask
 229     ) {
 230       $self->paycvv($old->paycvv);
 231     } else {
 232       $self->paycvv('');
 233     }
 234   }
 235
 236   local($ignore_expired_card) = 1
 237     if $old->payby  =~ /^(CARD|DCRD)$/
 238     && $self->payby =~ /^(CARD|DCRD)$/
 239     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
 240
 241   local($ignore_banned_card) = 1
 242     if (    $old->payby  =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
 243          || $old->payby  =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
 244     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
 245
 246   if (    $self->payby =~ /^(CARD|DCRD)$/
 247        && $old->payinfo ne $self->payinfo
 248        && $old->paymask ne $self->paymask )
 249   {
 250     my $error = $self->check_payinfo_cardtype;
 251     return $error if $error;
 252
 253     if ( $conf->exists('business-onlinepayment-verification') ) {
 254       $error = $self->verify;
 255     } else {
 256       $error = $self->tokenize;
 257     }
 258     return $error if $error;
 259
 260   }
 261
 262   local $SIG{HUP} = 'IGNORE';
 263   local $SIG{INT} = 'IGNORE';
 264   local $SIG{QUIT} = 'IGNORE';
 265   local $SIG{TERM} = 'IGNORE';
 266   local $SIG{TSTP} = 'IGNORE';
 267   local $SIG{PIPE} = 'IGNORE';
 268
 269   my $oldAutoCommit = $FS::UID::AutoCommit;
 270   local $FS::UID::AutoCommit = 0;
 271   my $dbh = dbh;
 272
 273   my $error = $self->SUPER::replace($old);
 274   if ( $error ) {
 275     $dbh->rollback if $oldAutoCommit;
 276     return $error;
 277   }
 278
 279   if ( $self->payby =~ /^(CARD|CHEK)$/
 280        && ( ( $self->get('payinfo') ne $old->get('payinfo')
 281               && !$self->tokenized
 282             )
 283             || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
 284           )
 285      )
 286   {
 287
 288     # card/check/lec info has changed, want to retry realtime_ invoice events
 289     my $error = $self->cust_main->retry_realtime;
 290     if ( $error ) {
 291       $dbh->rollback if $oldAutoCommit;
 292       return $error;
 293     }
 294   }
 295
 296   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 297   '';
 298
 299 }
 300
 301 =item check
 302
 303 Checks all fields to make sure this is a valid record.  If there is
 304 an error, returns the error, otherwise returns false.  Called by the insert
 305 and replace methods.
 306
 307 =cut
 308
 309 sub check {
 310   my $self = shift;
 311
 312   my $error =
 313     $self->ut_numbern('custpaybynum')
 314     || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
 315     || $self->ut_numbern('weight')
 316     #encrypted #|| $self->ut_textn('payinfo')
 317     #encrypted #|| $self->ut_textn('paycvv')
 318 #    || $self->ut_textn('paymask') #XXX something
 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   $error = $self->ut_daten('paydate');
 550   return $error if $error;
 551
 552   $self->SUPER::check;
 553 }
 554
 555 sub check_payinfo_cardtype {
 556   my $self = shift;
 557
 558   return '' if $ignore_cardtype;
 559
 560   return '' unless $self->payby =~ /^(CARD|CHEK)$/;
 561
 562   my $payinfo = $self->payinfo;
 563   $payinfo =~ s/\D//g;
 564
 565   # see parallel checks in cust_payby::check & payinfo_Mixin::payinfo_check
 566   if ( $self->tokenized($payinfo) ) {
 567     $self->set('is_tokenized', 'Y'); #so we don't try to do it again
 568     if ( $self->paymask =~ /^\d+x/ ) {
 569       $self->set('paycardtype', cardtype($self->paymask));
 570     } else {
 571       $self->set('paycardtype', '');
 572       #return "paycardtype required ".
 573       #       "(can't derive from a token and no paymask w/prefix provided)";
 574     }
 575     return '';
 576   }
 577
 578   my %bop_card_types = map { $_=>1 } values %{ card_types() };
 579   my $cardtype = cardtype($payinfo);
 580   $self->set('paycardtype', $cardtype);
 581
 582   return "$cardtype not accepted" unless $bop_card_types{$cardtype};
 583
 584   '';
 585
 586 }
 587
 588 sub _banned_pay_hashref {
 589   my $self = shift;
 590
 591   my %payby2ban = (
 592     'CARD' => 'CARD',
 593     'DCRD' => 'CARD',
 594     'CHEK' => 'CHEK',
 595     'DCHK' => 'CHEK'
 596   );
 597
 598   {
 599     'payby'   => $payby2ban{$self->payby},
 600     'payinfo' => $self->payinfo,
 601     #don't ever *search* on reason! #'reason'  =>
 602   };
 603 }
 604
 605 sub _new_banned_pay_hashref {
 606   my $self = shift;
 607   my $hr = $self->_banned_pay_hashref;
 608   $hr->{payinfo_hash} = 'SHA512';
 609   $hr->{payinfo} = sha512_base64($hr->{payinfo});
 610   $hr;
 611 }
 612
 613 =item paydate_mon_year
 614
 615 Returns a two element list consisting of the paydate month and year.
 616
 617 =cut
 618
 619 sub paydate_mon_year {
 620   my $self = shift;
 621
 622   my $date = $self->paydate; # || '12-2037';
 623
 624   #false laziness w/elements/select-month_year.html
 625   if ( $date  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #PostgreSQL date format
 626     ( $2, $1 );
 627   } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
 628     ( $1, $3 );
 629   } else {
 630     warn "unrecognized expiration date format: $date";
 631     ( '', '' );
 632   }
 633
 634 }
 635
 636 =item label
 637
 638 Returns a one line text label for this payment type.
 639
 640 =cut
 641
 642 my %weight = (
 643   1 => 'Primary',
 644   2 => 'Secondary',
 645   3 => 'Tertiary',
 646   4 => 'Fourth',
 647   5 => 'Fifth',
 648   6 => 'Sixth',
 649   7 => 'Seventh',
 650 );
 651
 652 sub label {
 653   my $self = shift;
 654
 655   my $name = $self->payby =~ /^(CARD|DCRD)$/
 656               && $self->paycardtype || FS::payby->shortname($self->payby);
 657
 658   ( $self->payby =~ /^(CARD|CHEK)$/  ? $weight{$self->weight}. ' automatic '
 659                                      : 'Manual '
 660   ).
 661   "$name: ". $self->paymask.
 662   ( $self->payby =~ /^(CARD|DCRD)$/
 663       ? ' Exp '. join('/', $self->paydate_mon_year)
 664       : ''
 665   );
 666
 667 }
 668
 669 =item realtime_bop
 670
 671 Runs a L<FS::cust_main::Billing_Realtime/realtime_bop> transaction on this card
 672
 673 =cut
 674
 675 sub realtime_bop {
 676   my( $self, %opt ) = @_;
 677
 678   $self->cust_main->realtime_bop({
 679     %opt,
 680     'cust_payby' => $self,
 681   });
 682
 683 }
 684
 685 =item tokenize
 686
 687 Runs a L<FS::cust_main::Billing_Realtime/realtime_tokenize> transaction on this card
 688
 689 =cut
 690
 691 sub tokenize {
 692   my $self = shift;
 693   return '' unless $self->payby =~ /^(CARD|DCRD)$/;
 694
 695   $self->cust_main->realtime_tokenize({
 696     'cust_payby' => $self,
 697   });
 698
 699 }
 700
 701 =item verify
 702
 703 Runs a L<realtime_verify_bop|FS::cust_main::Billing_Realtime/realtime_verify_bop> transaction on this card
 704
 705 =cut
 706
 707 sub verify {
 708   my $self = shift;
 709   return '' unless $self->payby =~ /^(CARD|DCRD)$/;
 710
 711   $self->cust_main->realtime_verify_bop({
 712     'cust_payby' => $self,
 713   });
 714
 715 }
 716
 717 =item paytypes
 718
 719 Returns a list of valid values for the paytype field (bank account type for
 720 electronic check payment).
 721
 722 =cut
 723
 724 sub paytypes {
 725   #my $class = shift;
 726
 727   ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
 728 }
 729
 730 =item cgi_cust_payby_fields
 731
 732 Returns the field names used in the web interface (including some pseudo-fields).
 733
 734 =cut
 735
 736 sub cgi_cust_payby_fields {
 737   #my $class = shift;
 738   [qw( payby payinfo paydate_month paydate_year paycvv payname weight
 739        payinfo1 payinfo2 payinfo3 paytype paystate payname_CHEK )];
 740 }
 741
 742 =item cgi_hash_callback HASHREF OLD
 743
 744 Subroutine (not a class or object method).  Processes a hash reference
 745 of web interface contet (transfers the data from pseudo-fields to real fields).
 746
 747 If OLD object is passed, also preserves locationnum, paystart_month, paystart_year,
 748 payissue and payip.  If the new field is blank but the old is not, the old field
 749 will be preserved.
 750
 751 =cut
 752
 753 sub cgi_hash_callback {
 754   my $hashref = shift;
 755   my $old = shift;
 756
 757   my %noauto = (
 758     'CARD' => 'DCRD',
 759     'CHEK' => 'DCHK',
 760   );
 761   # the payby selector gives the choice of CARD or CHEK (or others, but
 762   # those are the ones with auto and on-demand versions). if the user didn't
 763   # choose a weight, then they mean DCRD/DCHK.
 764   $hashref->{payby} = $noauto{$hashref->{payby}}
 765     if ! $hashref->{weight} && exists $noauto{$hashref->{payby}};
 766
 767   if ( $hashref->{payby} =~ /^(CHEK|DCHK)$/ ) {
 768
 769     unless ( grep $hashref->{$_}, qw(payinfo1 payinfo2 payinfo3 payname_CHEK)) {
 770       %$hashref = ();
 771       return;
 772     }
 773
 774     $hashref->{payinfo} = $hashref->{payinfo1}. '@';
 775     $hashref->{payinfo} .= $hashref->{payinfo3}.'.'
 776       if $conf->config('echeck-country') eq 'CA';
 777     $hashref->{payinfo} .= $hashref->{'payinfo2'};
 778
 779     $hashref->{payname} = $hashref->{'payname_CHEK'};
 780
 781   } elsif ( $hashref->{payby} =~ /^(CARD|DCRD)$/ ) {
 782
 783     unless ( grep $hashref->{$_}, qw( payinfo paycvv payname ) ) {
 784       %$hashref = ();
 785       return;
 786     }
 787
 788   }
 789
 790   $hashref->{paydate}= $hashref->{paydate_month}. '-'. $hashref->{paydate_year};
 791
 792   if ($old) {
 793     foreach my $field ( qw(locationnum paystart_month paystart_year payissue payip) ) {
 794       next if $hashref->{$field};
 795       next unless $old->get($field);
 796       $hashref->{$field} = $old->get($field);
 797     }
 798   }
 799
 800 }
 801
 802 =item search_sql
 803
 804 Class method.
 805
 806 Returns a qsearch hash expression to search for parameters specified in HASHREF.
 807 Valid paramters are:
 808
 809 =over 4
 810
 811 =item payby
 812
 813 listref
 814
 815 =item paydate_year
 816
 817 =item paydate_month
 818
 819
 820 =back
 821
 822 =cut
 823
 824 sub search_sql {
 825   my ($class, $params) = @_;
 826
 827   my @where = ();
 828   my $orderby;
 829
 830   # initialize these to prevent warnings
 831   $params = {
 832     'paydate_year'  => '',
 833     %$params
 834   };
 835
 836   ###
 837   # payby
 838   ###
 839
 840   if ( $params->{'payby'} ) {
 841
 842     my @payby = ref( $params->{'payby'} )
 843                   ? @{ $params->{'payby'} }
 844                   :  ( $params->{'payby'} );
 845
 846     @payby = grep /^([A-Z]{4})$/, @payby;
 847     my $in_payby = 'IN(' . join(',', map {"'$_'"} @payby) . ')';
 848     push @where, "cust_payby.payby $in_payby"
 849       if @payby;
 850   }
 851
 852   ###
 853   # paydate_year / paydate_month
 854   ###
 855
 856   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
 857     my $year = $1;
 858     $params->{'paydate_month'} =~ /^(\d\d?)$/
 859       or die "paydate_year without paydate_month?";
 860     my $month = $1;
 861
 862     push @where,
 863       'cust_payby.paydate IS NOT NULL',
 864       "cust_payby.paydate != ''",
 865       "CAST(cust_payby.paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
 866 ;
 867   }
 868   ##
 869   # setup queries, subs, etc. for the search
 870   ##
 871
 872   $orderby ||= 'ORDER BY custnum';
 873
 874   # here is the agent virtualization
 875   push @where,
 876     $FS::CurrentUser::CurrentUser->agentnums_sql(table => 'cust_main');
 877
 878   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
 879
 880   my $addl_from = ' LEFT JOIN cust_main USING ( custnum ) ';
 881   # always make address fields available in results
 882   for my $pre ('bill_', 'ship_') {
 883     $addl_from .=
 884       ' LEFT JOIN cust_location AS '.$pre.'location '.
 885       'ON (cust_main.'.$pre.'locationnum = '.$pre.'location.locationnum) ';
 886   }
 887   # always make referral available in results
 888   #   (maybe we should be using FS::UI::Web::join_cust_main instead?)
 889   $addl_from .= ' LEFT JOIN (select refnum, referral from part_referral) AS part_referral_x ON (cust_main.refnum = part_referral_x.refnum) ';
 890
 891   my $count_query = "SELECT COUNT(*) FROM cust_payby $addl_from $extra_sql";
 892
 893   my @select = ( 'cust_payby.*',
 894                  #'cust_main.custnum',
 895                  # there's a good chance that we'll need these
 896                  'cust_main.bill_locationnum',
 897                  'cust_main.ship_locationnum',
 898                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
 899                );
 900
 901   my $select = join(', ', @select);
 902
 903   my $sql_query = {
 904     'table'         => 'cust_payby',
 905     'select'        => $select,
 906     'addl_from'     => $addl_from,
 907     'hashref'       => {},
 908     'extra_sql'     => $extra_sql,
 909     'order_by'      => $orderby,
 910     'count_query'   => $count_query,
 911   };
 912   $sql_query;
 913
 914 }
 915
 916 =back
 917
 918 =item has_autobill_cards
 919
 920 Returns the number of unexpired cards configured for autobill
 921
 922 =cut
 923
 924 sub has_autobill_cards {
 925   scalar FS::Record::qsearch({
 926     table     => 'cust_payby',
 927     addl_from => 'JOIN cust_main USING (custnum)',
 928     order_by  => 'LIMIT 1',
 929     hashref   => {
 930         paydate => { op => '>', value => DateTime->now->ymd },
 931         weight  => { op => '>',  value => 0 },
 932     },
 933     extra_sql =>
 934       "AND cust_payby.payby IN ('CARD', 'DCRD') ".
 935       'AND '.
 936       $FS::CurrentUser::CurrentUser->agentnums_sql( table => 'cust_main' ),
 937   });
 938 }
 939
 940 =item has_autobill_checks
 941
 942 Returns the number of check accounts configured for autobill
 943
 944 =cut
 945
 946 sub has_autobill_checks {
 947   scalar FS::Record::qsearch({
 948     table     => 'cust_payby',
 949     addl_from => 'JOIN cust_main USING (custnum)',
 950     order_by  => 'LIMIT 1',
 951     hashref   => {
 952         weight  => { op => '>',  value => 0 },
 953     },
 954     extra_sql =>
 955       "AND cust_payby.payby IN ('CHEK','DCHEK','DCHK') ".
 956       'AND '.
 957       $FS::CurrentUser::CurrentUser->agentnums_sql( table => 'cust_main' ),
 958   });
 959 }
 960
 961 =item future_autobill_report_title
 962
 963 Determine if the future_autobill report should be available.
 964 If so, return a dynamic title for it
 965
 966 =cut
 967
 968 sub future_autobill_report_title {
 969   # Perhaps this function belongs somewhere else
 970   state $title;
 971   return $title if defined $title;
 972
 973   # Report incompatible with tax engines
 974   return $title = '' if FS::TaxEngine->new->info->{batch};
 975
 976   my $has_cards  = has_autobill_cards();
 977   my $has_checks = has_autobill_checks();
 978   my $_title = 'Future %s transactions';
 979
 980   if ( $has_cards && $has_checks ) {
 981     $title = sprintf $_title, 'credit card and electronic check';
 982   } elsif ( $has_cards ) {
 983     $title = sprintf $_title, 'credit card';
 984   } elsif ( $has_checks ) {
 985     $title = sprintf $_title, 'electronic check';
 986   } else {
 987     $title = '';
 988   }
 989
 990   $title;
 991 }
 992
 993 sub _upgrade_data {
 994
 995   my $class = shift;
 996   local $ignore_banned_card = 1;
 997   local $ignore_expired_card = 1;
 998   local $ignore_invalid_card = 1;
 999   $class->upgrade_set_cardtype;
1000   $class->_upgrade_data_paydate_edgebug;
1001
1002 }
1003
1004 =item _upgrade_data_paydate_edgebug
1005
1006 Correct bad data injected into payment expire date column by Edge browser bug
1007
1008 The month and year values may have an extra character injected into form POST
1009 data by Edge browser.  It was possible for some bad month values to slip
1010 past data validation.
1011
1012 If the stored value was out of range, it was causing payments screen to crash.
1013 We can detect and fix this by dropping the second digit.
1014
1015 If the stored value is is 11 or 12, it's possible the user inputted a 1.  In
1016 this case, the payment method will fail to authorize, but the record will
1017 not cause crashdumps for being out of range.
1018
1019 In short, check for any expiration month > 12, and drop the extra digit
1020
1021 =cut
1022
1023 sub _upgrade_data_paydate_edgebug {
1024   my $journal_label = 'cust_payby_paydate_edgebug';
1025   return if FS::upgrade_journal->is_done( $journal_label );
1026
1027   my $oldAutoCommit = $FS::UID::AutoCommit;
1028   local $FS::UID::AutoCommit = 0;
1029
1030   for my $row (
1031     FS::Record::qsearch(
1032       cust_payby => { paydate => { op => '!=', value => '' }}
1033     )
1034   ) {
1035     next unless $row->ut_daten('paydate');
1036
1037     # paydate column stored in database has failed date validation
1038     my $bad_paydate = $row->paydate;
1039
1040     my @date = split /[\-\/]/, $bad_paydate;
1041     @date = @date[2,0,1] if $date[2] > 1900;
1042
1043     # Only autocorrecting when month > 12 - notify operator
1044     unless ( $date[1] > 12 ) {
1045       die sprintf(
1046         'Unable to correct bad paydate stored in cust_payby row '.
1047         'custpaybynum(%s) custnum(%s) paydate(%s)',
1048         $row->custpaybynum,
1049         $row->custnum,
1050         $bad_paydate,
1051       );
1052     }
1053
1054     $date[1] = substr( $date[1], 0, 1 );
1055     $row->paydate( join('-', @date ));
1056
1057     if ( my $error = $row->replace ) {
1058       die sprintf(
1059         'Failed to autocorrect bad paydate stored in cust_payby row '.
1060         'custpaybynum(%s) custnum(%s) paydate(%s) - error: %s',
1061         $row->custpaybynum,
1062         $row->custnum,
1063         $bad_paydate,
1064         $error
1065       );
1066     }
1067
1068     warn sprintf(
1069       'Autocorrected bad paydate stored in cust_payby row '.
1070       "custpaybynum(%s) custnum(%s) old-paydate(%s) new-paydate(%s)\n",
1071       $row->custpaybynum,
1072       $row->custnum,
1073       $bad_paydate,
1074       $row->paydate,
1075     );
1076
1077   }
1078
1079   FS::upgrade_journal->set_done( $journal_label );
1080   dbh->commit unless $oldAutoCommit;
1081 }
1082
1083 =head1 BUGS
1084
1085 =head1 SEE ALSO
1086
1087 L<FS::Record>, schema.html from the base documentation.
1088
1089 =cut
1090
1091 1;
1092