unreverse the check for tokenized payinfo, #71291
[freeside.git] / 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
163             || $self->SUPER::insert;
164   if ( $error ) {
165     $dbh->rollback if $oldAutoCommit;
166     return $error;
167   }
168
169   if ( $self->payby =~ /^(CARD|CHEK)$/ ) {
170     # new auto card/check info, want to retry realtime_ invoice events
171     #  (new customer?  that's okay, they won't have any)
172     my $error = $self->cust_main->retry_realtime;
173     if ( $error ) {
174       $dbh->rollback if $oldAutoCommit;
175       return $error;
176     }
177   }
178
179   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
180   '';
181
182 }
183
184 =item delete
185
186 Delete this record from the database.
187
188 =item replace OLD_RECORD
189
190 Replaces the OLD_RECORD with this one in the database.  If there is an error,
191 returns the error, otherwise returns false.
192
193 =cut
194
195 sub replace {
196   my $self = shift;
197
198   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
199               ? shift
200               : $self->replace_old;
201
202   if ( $self->payby =~ /^(CARD|DCRD)$/
203        && (    $self->payinfo =~ /xx/
204             || $self->payinfo =~ /^\s*N\/A\s+\(tokenized\)\s*$/
205           )
206      )
207   {
208
209     $self->payinfo($old->payinfo);
210
211   } elsif ( $self->payby =~ /^(CHEK|DCHK)$/ && $self->payinfo =~ /xx/ ) {
212     #fix for #3085 "edit of customer's routing code only surprisingly causes
213     #nothing to happen...
214     # this probably won't do the right thing when we don't have the
215     # public key (can't actually get the real $old->payinfo)
216     my($new_account, $new_aba) = split('@', $self->payinfo);
217     my($old_account, $old_aba) = split('@', $old->payinfo);
218     $new_account = $old_account if $new_account =~ /xx/;
219     $new_aba     = $old_aba     if $new_aba     =~ /xx/;
220     $self->payinfo($new_account.'@'.$new_aba);
221   }
222
223   # only unmask paycvv if payinfo stayed the same
224   if ( $self->payby =~ /^(CARD|DCRD)$/ and $self->paycvv =~ /^\s*[\*x]+\s*$/ ) {
225     if ( $old->payinfo eq $self->payinfo
226          && $old->paymask eq $self->paymask
227     ) {
228       $self->paycvv($old->paycvv);
229     } else {
230       $self->paycvv('');
231     }
232   }
233
234   local($ignore_expired_card) = 1
235     if $old->payby  =~ /^(CARD|DCRD)$/
236     && $self->payby =~ /^(CARD|DCRD)$/
237     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
238
239   local($ignore_banned_card) = 1
240     if (    $old->payby  =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
241          || $old->payby  =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
242     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
243
244   if (    $self->payby =~ /^(CARD|DCRD)$/
245        && $old->payinfo ne $self->payinfo
246        && $old->paymask ne $self->paymask )
247   {
248     my $error = $self->check_payinfo_cardtype;
249     return $error if $error;
250
251     if ( $conf->exists('business-onlinepayment-verification') ) {
252       $error = $self->verify;
253       return $error if $error;
254     }
255   }
256
257   local $SIG{HUP} = 'IGNORE';
258   local $SIG{INT} = 'IGNORE';
259   local $SIG{QUIT} = 'IGNORE';
260   local $SIG{TERM} = 'IGNORE';
261   local $SIG{TSTP} = 'IGNORE';
262   local $SIG{PIPE} = 'IGNORE';
263
264   my $oldAutoCommit = $FS::UID::AutoCommit;
265   local $FS::UID::AutoCommit = 0;
266   my $dbh = dbh;
267
268   my $error = $self->SUPER::replace($old);
269   if ( $error ) {
270     $dbh->rollback if $oldAutoCommit;
271     return $error;
272   }
273
274   if ( $self->payby =~ /^(CARD|CHEK)$/
275        && ( ( $self->get('payinfo') ne $old->get('payinfo')
276               && $self->get('payinfo') !~ /^99\d{14}$/ 
277             )
278             || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
279           )
280      )
281   {
282
283     # card/check/lec info has changed, want to retry realtime_ invoice events
284     my $error = $self->cust_main->retry_realtime;
285     if ( $error ) {
286       $dbh->rollback if $oldAutoCommit;
287       return $error;
288     }
289   }
290
291   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
292   '';
293
294 }
295
296 =item check
297
298 Checks all fields to make sure this is a valid record.  If there is
299 an error, returns the error, otherwise returns false.  Called by the insert
300 and replace methods.
301
302 =cut
303
304 sub check {
305   my $self = shift;
306
307   my $error = 
308     $self->ut_numbern('custpaybynum')
309     || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
310     || $self->ut_numbern('weight')
311     #encrypted #|| $self->ut_textn('payinfo')
312     #encrypted #|| $self->ut_textn('paycvv')
313 #    || $self->ut_textn('paymask') #XXX something
314     #later #|| $self->ut_textn('paydate')
315     || $self->ut_numbern('paystart_month')
316     || $self->ut_numbern('paystart_year')
317     || $self->ut_numbern('payissue')
318 #    || $self->ut_textn('payname') #XXX something
319     || $self->ut_alphan('paystate')
320     || $self->ut_textn('paytype')
321     || $self->ut_ipn('payip')
322   ;
323   return $error if $error;
324
325   ### from cust_main
326
327   FS::payby->can_payby($self->table, $self->payby)
328     or return "Illegal payby: ". $self->payby;
329
330   # If it is encrypted and the private key is not availaible then we can't
331   # check the credit card.
332   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
333
334   # Need some kind of global flag to accept invalid cards, for testing
335   # on scrubbed data.
336   #XXX if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
337
338   # In this block: detect card type; reject credit card / account numbers that
339   # are impossible or banned; reject other payment features (date, CVV length)
340   # that are inappropriate for the card type.
341   # However, if the payinfo is encrypted then just detect card type and assume
342   # the other checks were already done.
343
344   if ( !$ignore_invalid_card && 
345     $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
346
347     my $payinfo = $self->payinfo;
348     $payinfo =~ s/\D//g;
349     $payinfo =~ /^(\d{13,16}|\d{8,9})$/
350       or return gettext('invalid_card'); #. ": ". $self->payinfo;
351     $payinfo = $1;
352     $self->payinfo($payinfo);
353     validate($payinfo)
354       or return gettext('invalid_card'); # . ": ". $self->payinfo;
355
356     my $cardtype = cardtype($payinfo);
357     $cardtype = 'Tokenized' if $self->payinfo =~ /^99\d{14}$/; #token
358     
359     return gettext('unknown_card_type') if $cardtype eq "Unknown";
360     
361     $self->set('paycardtype', $cardtype);
362
363     unless ( $ignore_banned_card ) {
364       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
365       if ( $ban ) {
366         if ( $ban->bantype eq 'warn' ) {
367           #or others depending on value of $ban->reason ?
368           return '_duplicate_card'.
369                  ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
370                  ' until '.         time2str('%a %h %o at %r', $ban->_end_date).
371                  ' (ban# '. $ban->bannum. ')'
372             unless $self->override_ban_warn;
373         } else {
374           return 'Banned credit card: banned on '.
375                  time2str('%a %h %o at %r', $ban->_date).
376                  ' by '. $ban->otaker.
377                  ' (ban# '. $ban->bannum. ')';
378         }
379       }
380     }
381
382     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
383       if ( $cardtype eq 'American Express card' ) {
384         $self->paycvv =~ /^(\d{4})$/
385           or return "CVV2 (CID) for American Express cards is four digits.";
386         $self->paycvv($1);
387       } else {
388         $self->paycvv =~ /^(\d{3})$/
389           or return "CVV2 (CVC2/CID) is three digits.";
390         $self->paycvv($1);
391       }
392     } else {
393       $self->paycvv('');
394     }
395
396     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
397
398       return "Start date or issue number is required for $cardtype cards"
399         unless $self->paystart_month && $self->paystart_year or $self->payissue;
400
401       return "Start month must be between 1 and 12"
402         if $self->paystart_month
403            and $self->paystart_month < 1 || $self->paystart_month > 12;
404
405       return "Start year must be 1990 or later"
406         if $self->paystart_year
407            and $self->paystart_year < 1990;
408
409       return "Issue number must be beween 1 and 99"
410         if $self->payissue
411           and $self->payissue < 1 || $self->payissue > 99;
412
413     } else {
414       $self->paystart_month('');
415       $self->paystart_year('');
416       $self->payissue('');
417     }
418
419   } elsif ( !$ignore_invalid_card && 
420     $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
421
422     my $payinfo = $self->payinfo;
423     $payinfo =~ s/[^\d\@\.]//g;
424     if ( $conf->config('echeck-country') eq 'CA' ) {
425       $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
426         or return 'invalid echeck account@branch.bank';
427       $payinfo = "$1\@$2.$3";
428     } elsif ( $conf->config('echeck-country') eq 'US' ) {
429       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
430       $payinfo = "$1\@$2";
431     } else {
432       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
433       $payinfo = "$1\@$2";
434     }
435     $self->payinfo($payinfo);
436     $self->paycvv('');
437
438     unless ( $ignore_banned_card ) {
439       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
440       if ( $ban ) {
441         if ( $ban->bantype eq 'warn' ) {
442           #or others depending on value of $ban->reason ?
443           return '_duplicate_ach' unless $self->override_ban_warn;
444         } else {
445           return 'Banned ACH account: banned on '.
446                  time2str('%a %h %o at %r', $ban->_date).
447                  ' by '. $ban->otaker.
448                  ' (ban# '. $ban->bannum. ')';
449         }
450       }
451     }
452
453   } elsif ( $self->payby =~ /^CARD|DCRD$/ and $self->paymask ) {
454     # either ignoring invalid cards, or we can't decrypt the payinfo, but
455     # try to detect the card type anyway. this never returns failure, so
456     # the contract of $ignore_invalid_cards is maintained.
457     $self->set('paycardtype', cardtype($self->paymask));
458   } else {
459     $self->set('paycardtype', '');
460   }
461
462 #  } elsif ( $self->payby eq 'PREPAY' ) {
463 #
464 #    my $payinfo = $self->payinfo;
465 #    $payinfo =~ s/\W//g; #anything else would just confuse things
466 #    $self->payinfo($payinfo);
467 #    $error = $self->ut_alpha('payinfo');
468 #    return "Illegal prepayment identifier: ". $self->payinfo if $error;
469 #    return "Unknown prepayment identifier"
470 #      unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
471 #    $self->paycvv('');
472
473   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
474
475     $self->paydate('');
476
477   } elsif ( $self->payby =~ /^(CARD|DCRD)$/ ) {
478
479     # shouldn't payinfo_check do this?
480     # (except we don't ever call payinfo_check from here)
481     return "Expiration date required"
482       if $self->paydate eq '' || $self->paydate eq '-';
483
484     my( $m, $y );
485     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
486       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
487     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
488       ( $m, $y ) = ( $2, "19$1" );
489     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
490       ( $m, $y ) = ( $3, "20$2" );
491     } else {
492       return "Illegal expiration date: ". $self->paydate;
493     }
494     $m = sprintf('%02d',$m);
495     $self->paydate("$y-$m-01");
496     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
497     return gettext('expired_card')
498       if #XXX !$import
499       #&&
500          !$ignore_expired_card 
501       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
502
503   }
504
505   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
506        ( ! $conf->exists('require_cardname')
507          || $self->payby !~ /^(CARD|DCRD)$/  ) 
508   ) {
509     $self->payname( $self->first. " ". $self->getfield('last') );
510   } else {
511
512     if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
513       $self->payname =~ /^([\w \,\.\-\']*)$/
514         or return gettext('illegal_name'). " payname: ". $self->payname;
515       $self->payname($1);
516     } else {
517       $self->payname =~ /^([\w \,\.\-\'\&]*)$/
518         or return gettext('illegal_name'). " payname: ". $self->payname;
519       $self->payname($1);
520     }
521
522   }
523
524   if ( ! $self->custpaybynum
525        && $conf->exists('business-onlinepayment-verification') ) {
526     $error = $self->verify;
527     return $error if $error;
528   }
529
530   $self->SUPER::check;
531 }
532
533 sub check_payinfo_cardtype {
534   my $self = shift;
535
536   return '' if $ignore_cardtype;
537
538   return '' unless $self->payby =~ /^(CARD|CHEK)$/;
539
540   my $payinfo = $self->payinfo;
541   $payinfo =~ s/\D//g;
542
543   if ( $payinfo =~ /^99\d{14}$/ ) {
544     $self->set('paycardtype', 'Tokenized');
545     return '';
546   }
547
548   my %bop_card_types = map { $_=>1 } values %{ card_types() };
549   my $cardtype = cardtype($payinfo);
550   $self->set('paycardtype', $cardtype);
551
552   return "$cardtype not accepted" unless $bop_card_types{$cardtype};
553
554   '';
555
556 }
557
558 sub _banned_pay_hashref {
559   my $self = shift;
560
561   my %payby2ban = (
562     'CARD' => 'CARD',
563     'DCRD' => 'CARD',
564     'CHEK' => 'CHEK',
565     'DCHK' => 'CHEK'
566   );
567
568   {
569     'payby'   => $payby2ban{$self->payby},
570     'payinfo' => $self->payinfo,
571     #don't ever *search* on reason! #'reason'  =>
572   };
573 }
574
575 sub _new_banned_pay_hashref {
576   my $self = shift;
577   my $hr = $self->_banned_pay_hashref;
578   $hr->{payinfo_hash} = 'SHA512';
579   $hr->{payinfo} = sha512_base64($hr->{payinfo});
580   $hr;
581 }
582
583 =item paydate_mon_year
584
585 Returns a two element list consisting of the paydate month and year.
586
587 =cut
588
589 sub paydate_mon_year {
590   my $self = shift;
591
592   my $date = $self->paydate; # || '12-2037';
593
594   #false laziness w/elements/select-month_year.html
595   if ( $date  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #PostgreSQL date format
596     ( $2, $1 );
597   } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
598     ( $1, $3 );
599   } else {
600     warn "unrecognized expiration date format: $date";
601     ( '', '' );
602   }
603
604 }
605
606 =item label
607
608 Returns a one line text label for this payment type.
609
610 =cut
611
612 my %weight = (
613   1 => 'Primary',
614   2 => 'Secondary',
615   3 => 'Tertiary',
616   4 => 'Fourth',
617   5 => 'Fifth',
618   6 => 'Sixth',
619   7 => 'Seventh',
620 );
621
622 sub label {
623   my $self = shift;
624
625   my $name = $self->payby =~ /^(CARD|DCRD)$/
626               && $self->paycardtype || FS::payby->shortname($self->payby);
627
628   ( $self->payby =~ /^(CARD|CHEK)$/  ? $weight{$self->weight}. ' automatic '
629                                      : 'Manual '
630   ).
631   "$name: ". $self->paymask.
632   ( $self->payby =~ /^(CARD|DCRD)$/
633       ? ' Exp '. join('/', $self->paydate_mon_year)
634       : ''
635   );
636
637 }
638
639 =item realtime_bop
640
641 =cut
642
643 sub realtime_bop {
644   my( $self, %opt ) = @_;
645
646   $opt{$_} = $self->$_() for qw( payinfo payname paydate );
647
648   if ( $self->locationnum ) {
649     my $cust_location = $self->cust_location;
650     $opt{$_} = $cust_location->$_() for qw( address1 address2 city state zip );
651   }
652
653   $self->cust_main->realtime_bop({
654     'method' => FS::payby->payby2bop( $self->payby ),
655     %opt,
656   });
657
658 }
659
660 =item verify 
661
662 =cut
663
664 sub verify {
665   my $self = shift;
666   return '' unless $self->payby =~ /^(CARD|DCRD)$/;
667
668   my %opt = ();
669
670   # false laziness with check
671   my( $m, $y );
672   if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
673     ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
674   } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
675     ( $m, $y ) = ( $2, "19$1" );
676   } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
677     ( $m, $y ) = ( $3, "20$2" );
678   } else {
679     return "Illegal expiration date: ". $self->paydate;
680   }
681   $m = sprintf('%02d',$m);
682   $opt{paydate} = "$y-$m-01";
683
684   $opt{$_} = $self->$_() for qw( payinfo payname paycvv );
685
686   if ( $self->locationnum ) {
687     my $cust_location = $self->cust_location;
688     $opt{$_} = $cust_location->$_() for qw( address1 address2 city state zip );
689   }
690
691   $self->cust_main->realtime_verify_bop({
692     'method' => FS::payby->payby2bop( $self->payby ),
693     %opt,
694   });
695
696 }
697
698 =item paytypes
699
700 Returns a list of valid values for the paytype field (bank account type for
701 electronic check payment).
702
703 =cut
704
705 sub paytypes {
706   #my $class = shift;
707
708   ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
709 }
710
711 =item cgi_cust_payby_fields
712
713 Returns the field names used in the web interface (including some pseudo-fields).
714
715 =cut
716
717 sub cgi_cust_payby_fields {
718   #my $class = shift;
719   [qw( payby payinfo paydate_month paydate_year paycvv payname weight
720        payinfo1 payinfo2 payinfo3 paytype paystate payname_CHEK )];
721 }
722
723 =item cgi_hash_callback HASHREF OLD
724
725 Subroutine (not a class or object method).  Processes a hash reference
726 of web interface contet (transfers the data from pseudo-fields to real fields).
727
728 If OLD object is passed, also preserves locationnum, paystart_month, paystart_year,
729 payissue and payip.  If the new field is blank but the old is not, the old field 
730 will be preserved.
731
732 =cut
733
734 sub cgi_hash_callback {
735   my $hashref = shift;
736   my $old = shift;
737
738   my %noauto = (
739     'CARD' => 'DCRD',
740     'CHEK' => 'DCHK',
741   );
742   # the payby selector gives the choice of CARD or CHEK (or others, but
743   # those are the ones with auto and on-demand versions). if the user didn't
744   # choose a weight, then they mean DCRD/DCHK.
745   $hashref->{payby} = $noauto{$hashref->{payby}}
746     if ! $hashref->{weight} && exists $noauto{$hashref->{payby}};
747
748   if ( $hashref->{payby} =~ /^(CHEK|DCHK)$/ ) {
749
750     unless ( grep $hashref->{$_}, qw(payinfo1 payinfo2 payinfo3 payname_CHEK)) {
751       %$hashref = ();
752       return;
753     }
754
755     $hashref->{payinfo} = $hashref->{payinfo1}. '@';
756     $hashref->{payinfo} .= $hashref->{payinfo3}.'.' 
757       if $conf->config('echeck-country') eq 'CA';
758     $hashref->{payinfo} .= $hashref->{'payinfo2'};
759
760     $hashref->{payname} = $hashref->{'payname_CHEK'};
761
762   } elsif ( $hashref->{payby} =~ /^(CARD|DCRD)$/ ) {
763
764     unless ( grep $hashref->{$_}, qw( payinfo paycvv payname ) ) {
765       %$hashref = ();
766       return;
767     }
768
769   }
770
771   $hashref->{paydate}= $hashref->{paydate_month}. '-'. $hashref->{paydate_year};
772
773   if ($old) {
774     foreach my $field ( qw(locationnum paystart_month paystart_year payissue payip) ) {
775       next if $hashref->{$field};
776       next unless $old->get($field);
777       $hashref->{$field} = $old->get($field);
778     }
779   }
780
781 }
782
783 =item search_sql
784
785 Class method.
786
787 Returns a qsearch hash expression to search for parameters specified in HASHREF.
788 Valid paramters are:
789
790 =over 4
791
792 =item payby
793
794 listref
795
796 =item paydate_year
797
798 =item paydate_month
799
800
801 =back
802
803 =cut
804
805 sub search_sql {
806   my ($class, $params) = @_;
807
808   my @where = ();
809   my $orderby;
810
811   # initialize these to prevent warnings
812   $params = {
813     'paydate_year'  => '',
814     %$params
815   };
816
817   ###
818   # payby
819   ###
820
821   if ( $params->{'payby'} ) {
822
823     my @payby = ref( $params->{'payby'} )
824                   ? @{ $params->{'payby'} }
825                   :  ( $params->{'payby'} );
826
827     @payby = grep /^([A-Z]{4})$/, @payby;
828     my $in_payby = 'IN(' . join(',', map {"'$_'"} @payby) . ')';
829     push @where, "cust_payby.payby $in_payby"
830       if @payby;
831   }
832
833   ###
834   # paydate_year / paydate_month
835   ###
836
837   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
838     my $year = $1;
839     $params->{'paydate_month'} =~ /^(\d\d?)$/
840       or die "paydate_year without paydate_month?";
841     my $month = $1;
842
843     push @where,
844       'cust_payby.paydate IS NOT NULL',
845       "cust_payby.paydate != ''",
846       "CAST(cust_payby.paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
847 ;
848   }
849   ##
850   # setup queries, subs, etc. for the search
851   ##
852
853   $orderby ||= 'ORDER BY custnum';
854
855   # here is the agent virtualization
856   push @where,
857     $FS::CurrentUser::CurrentUser->agentnums_sql(table => 'cust_main');
858
859   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
860
861   my $addl_from = ' LEFT JOIN cust_main USING ( custnum ) ';
862   # always make address fields available in results
863   for my $pre ('bill_', 'ship_') {
864     $addl_from .= 
865       ' LEFT JOIN cust_location AS '.$pre.'location '.
866       'ON (cust_main.'.$pre.'locationnum = '.$pre.'location.locationnum) ';
867   }
868   # always make referral available in results
869   #   (maybe we should be using FS::UI::Web::join_cust_main instead?)
870   $addl_from .= ' LEFT JOIN (select refnum, referral from part_referral) AS part_referral_x ON (cust_main.refnum = part_referral_x.refnum) ';
871
872   my $count_query = "SELECT COUNT(*) FROM cust_payby $addl_from $extra_sql";
873
874   my @select = ( 'cust_payby.*',
875                  #'cust_main.custnum',
876                  # there's a good chance that we'll need these
877                  'cust_main.bill_locationnum',
878                  'cust_main.ship_locationnum',
879                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
880                );
881
882   my $select = join(', ', @select);
883
884   my $sql_query = {
885     'table'         => 'cust_payby',
886     'select'        => $select,
887     'addl_from'     => $addl_from,
888     'hashref'       => {},
889     'extra_sql'     => $extra_sql,
890     'order_by'      => $orderby,
891     'count_query'   => $count_query,
892   };
893   $sql_query;
894
895 }
896
897 =back
898
899 =cut
900
901 sub _upgrade_data {
902
903   my $class = shift;
904   local $ignore_banned_card = 1;
905   local $ignore_expired_card = 1;
906   local $ignore_invalid_card = 1;
907   $class->upgrade_set_cardtype;
908
909 }
910
911 =head1 BUGS
912
913 =head1 SEE ALSO
914
915 L<FS::Record>, schema.html from the base documentation.
916
917 =cut
918
919 1;
920