fix upgrades, fix bogus "Tokenized" paycardtype, RT#71513
[freeside.git] / FS / FS / payinfo_Mixin.pm
1 package FS::payinfo_Mixin;
2
3 use strict;
4 use Business::CreditCard;
5 use FS::payby;
6 use FS::Record qw(qsearch);
7 use FS::UID qw(driver_name);
8 use FS::Cursor;
9 use Time::Local qw(timelocal);
10
11 # allow_closed_replace only relevant to cust_pay/cust_refund, for upgrade tokenizing
12 use vars qw( $ignore_masked_payinfo $allow_closed_replace );
13
14 =head1 NAME
15
16 FS::payinfo_Mixin - Mixin class for records in tables that contain payinfo.  
17
18 =head1 SYNOPSIS
19
20 package FS::some_table;
21 use vars qw(@ISA);
22 @ISA = qw( FS::payinfo_Mixin FS::Record );
23
24 =head1 DESCRIPTION
25
26 This is a mixin class for records that contain payinfo. 
27
28 =head1 FIELDS
29
30 =over 4
31
32 =item payby
33
34 The following payment types (payby) are supported:
35
36 For Customers (cust_main):
37 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
38 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
39 'LECB' (Phone bill billing), 'BILL' (billing), 'COMP' (free), or
40 'PREPAY' (special billing type: applies a credit and sets billing type to I<BILL> - see L<FS::prepay_credit>)
41
42 For Refunds (cust_refund):
43 'CARD' (credit cards), 'CHEK' (electronic check/ACH),
44 'LECB' (Phone bill billing), 'BILL' (billing), 'CASH' (cash),
45 'WEST' (Western Union), 'MCRD' (Manual credit card), 'MCHK' (Manual electronic
46 check), 'CBAK' Chargeback, or 'COMP' (free)
47
48
49 For Payments (cust_pay):
50 'CARD' (credit cards), 'CHEK' (electronic check/ACH),
51 'LECB' (phone bill billing), 'BILL' (billing), 'PREP' (prepaid card),
52 'CASH' (cash), 'WEST' (Western Union), 'MCRD' (Manual credit card), 'MCHK'
53 (Manual electronic check), 'PPAL' (PayPal)
54 'COMP' (free) is depricated as a payment type in cust_pay
55
56 =cut 
57
58 =item payinfo
59
60 Payment information (payinfo) can be one of the following types:
61
62 Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) 
63 prepayment identifier (see L<FS::prepay_credit>), PayPal transaction ID
64
65 =cut
66
67 sub payinfo {
68   my($self,$payinfo) = @_;
69
70   if ( defined($payinfo) ) {
71     $self->paymask($self->mask_payinfo) unless $self->getfield('paymask') || $self->tokenized; #make sure old mask is set
72     $self->setfield('payinfo', $payinfo);
73     $self->paymask($self->mask_payinfo) unless $self->tokenized($payinfo); #remask unless tokenizing
74   } else {
75     $self->getfield('payinfo');
76   }
77 }
78
79 =item paycvv
80
81 Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
82
83 =cut
84
85 #this prevents encrypting empty values on insert?
86 sub paycvv {
87   my($self,$paycvv) = @_;
88   # This is only allowed in cust_payby (formerly cust_main)
89   #  It shouldn't be stored longer than necessary to run the first transaction
90   if ( defined($paycvv) ) {
91     $self->setfield('paycvv', $paycvv);
92   } else {
93     $self->getfield('paycvv');
94   }
95 }
96
97 =item paymask
98
99 =cut
100
101 sub paymask {
102   my($self, $paymask) = @_;
103
104   if ( defined($paymask) ) {
105     $self->setfield('paymask', $paymask);
106   } else {
107     $self->getfield('paymask') || $self->mask_payinfo;
108   }
109 }
110
111 =back
112
113 =head1 METHODS
114
115 =over 4
116
117 =item mask_payinfo [ PAYBY, PAYINFO ]
118
119 This method converts the payment info (credit card, bank account, etc.) into a
120 masked string.
121
122 Optionally, an arbitrary payby and payinfo can be passed.
123
124 =cut
125
126 sub mask_payinfo {
127   my $self = shift;
128   my $payby   = scalar(@_) ? shift : $self->payby;
129   my $payinfo = scalar(@_) ? shift : $self->payinfo;
130
131   # Check to see if it's encrypted...
132   if ( ref($self) && $self->is_encrypted($payinfo) ) {
133     return 'N/A';
134   } elsif ( $self->tokenized($payinfo) || $payinfo eq 'N/A' ) { #token
135     return 'N/A (tokenized)'; #?
136   } else { # if not, mask it...
137
138     if ($payby eq 'CARD' || $payby eq 'DCRD') {
139                                                 #|| $payby eq 'MCRD') {
140                                                 #MCRD isn't a card in payinfo,
141                                                 #its a record of an _offline_
142                                                 #card
143
144       # Credit Cards
145
146       # special handling for Local Isracards: always show last 4 
147       if ( $payinfo =~ /^(\d{8,9})$/ ) {
148
149         return 'x'x(length($payinfo)-4).
150                substr($payinfo,(length($payinfo)-4));
151
152       }
153
154       my $conf = new FS::Conf;
155       my $mask_method = $conf->config('card_masking_method') || 'first6last4';
156       $mask_method =~ /^first(\d+)last(\d+)$/
157         or die "can't parse card_masking_method $mask_method";
158       my($first, $last) = ($1, $2);
159
160       return substr($payinfo,0,$first).
161              'x'x(length($payinfo)-$first-$last).
162              substr($payinfo,(length($payinfo)-$last));
163
164     } elsif ($payby eq 'CHEK' || $payby eq 'DCHK' ) {
165
166       # Checks (Show last 2 @ bank)
167       my( $account, $aba ) = split('@', $payinfo );
168       return 'x'x(length($account)-2).
169              substr($account,(length($account)-2)).
170              ( length($aba) ? "@".$aba : '');
171
172     } elsif ($payby eq 'EDI') {
173       # EDI.
174       # These numbers have been seen anywhere from 8 to 30 digits, and 
175       # possibly more.  Lacking any better idea I'm going to mask all but
176       # the last 4 digits.
177       return 'x' x (length($payinfo) - 4) . substr($payinfo, -4);
178
179     } else { # Tie up loose ends
180       return $payinfo;
181     }
182   }
183   #die "shouldn't be reached";
184 }
185
186 =item payinfo_check
187
188 Checks payby and payinfo.
189
190 =cut
191
192 sub payinfo_check {
193   my $self = shift;
194
195   FS::payby->can_payby($self->table, $self->payby)
196     or return "Illegal payby: ". $self->payby;
197
198   if ( $self->payby eq 'CARD' && ! $self->is_encrypted($self->payinfo) ) {
199
200     if ( $self->tokenized && ! $self->paycardtype ) {
201       return "paycardtype required (cannot be derived from a token)";
202     } else {
203       $self->set('paycardtype', cardtype($self->payinfo));
204     }
205
206     if ( $ignore_masked_payinfo and $self->mask_payinfo eq $self->payinfo ) {
207       # allow it
208     } else {
209       my $payinfo = $self->payinfo;
210       $payinfo =~ s/\D//g;
211       $self->payinfo($payinfo);
212       if ( $self->payinfo ) {
213         $self->payinfo =~ /^(\d{13,16}|\d{8,9})$/
214           or return "Illegal (mistyped?) credit card number (payinfo)";
215         $self->payinfo($1);
216         validate($self->payinfo) or return "Illegal credit card number";
217         return "Unknown card type" if $self->paycardtype eq "Unknown";
218       } else {
219         $self->payinfo('N/A'); #??? re-masks card
220       }
221     }
222   } else {
223     if ( $self->payby eq 'CARD' and $self->paymask ) {
224       # if we can't decrypt the card, at least detect the cardtype
225       $self->set('paycardtype', cardtype($self->paymask));
226     } else {
227       $self->set('paycardtype', '');
228     }
229     if ( $self->is_encrypted($self->payinfo) ) {
230       #something better?  all it would cause is a decryption error anyway?
231       my $error = $self->ut_anything('payinfo');
232       return $error if $error;
233     } else {
234       my $error = $self->ut_textn('payinfo');
235       return $error if $error;
236     }
237   }
238
239   return '';
240 }
241
242 =item payby_payinfo_pretty [ LOCALE ]
243
244 Returns payment method and information (suitably masked, if applicable) as
245 a human-readable string, such as:
246
247   Card #54xxxxxxxxxxxx32
248
249 or
250
251   Check #119006
252
253 =cut
254
255 sub payby_payinfo_pretty {
256   my $self = shift;
257   my $locale = shift;
258   my $lh = FS::L10N->get_handle($locale);
259   if ( $self->payby eq 'CARD' ) {
260     if ($self->paymask =~ /tokenized/) {
261       $lh->maketext('Tokenized Card');
262     } else {
263       $lh->maketext('Card #') . $self->paymask;
264     }
265   } elsif ( $self->payby eq 'CHEK' ) {
266
267     #false laziness w/view/cust_main/payment_history.html::translate_payinfo
268     my( $account, $aba ) = split('@', $self->paymask );
269
270     if ( $aba =~ /^(\d{5})\.(\d{3})$/ ) { #blame canada
271       my($branch, $routing) = ($1, $2);
272       $lh->maketext("Routing [_1], Branch [_2], Acct [_3]",
273                      $routing, $branch, $account);
274     } else {
275       $lh->maketext("Routing [_1], Acct [_2]", $aba, $account);
276     }
277
278   } elsif ( $self->payby eq 'BILL' ) {
279     $lh->maketext('Check #') . $self->payinfo;
280   } elsif ( $self->payby eq 'PREP' ) {
281     $lh->maketext('Prepaid card #') . $self->payinfo;
282   } elsif ( $self->payby eq 'CASH' ) {
283     $lh->maketext('Cash') . ' ' . $self->payinfo;
284   } elsif ( $self->payby eq 'WEST' ) {
285     # does Western Union localize their name?
286     $lh->maketext('Western Union');
287   } elsif ( $self->payby eq 'MCRD' ) {
288     $lh->maketext('Manual credit card');
289   } elsif ( $self->payby eq 'MCHK' ) {
290     $lh->maketext('Manual electronic check');
291   } elsif ( $self->payby eq 'EDI' ) {
292     $lh->maketext('EDI') . ' ' . $self->paymask;
293   } elsif ( $self->payby eq 'PPAL' ) {
294     $lh->maketext('PayPal transaction#') . $self->order_number;
295   } else {
296     $self->payby. ' '. $self->payinfo;
297   }
298 }
299
300 =item payinfo_used [ PAYINFO ]
301
302 Returns 1 if there's an existing payment using this payinfo.  This can be 
303 used to set the 'recurring payment' flag required by some processors.
304
305 =cut
306
307 sub payinfo_used {
308   my $self = shift;
309   my $payinfo = shift || $self->payinfo;
310   my %hash = (
311     'custnum' => $self->custnum,
312     'payby'   => $self->payby,
313   );
314
315   return 1
316   if qsearch('cust_pay', { %hash, 'payinfo' => $payinfo } )
317   || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo } )
318   ;
319
320   return 0;
321 }
322
323 =item display_status
324
325 For transactions that have both 'status' and 'failure_status', shows the
326 status in a single, display-friendly string.
327
328 =cut
329
330 sub display_status {
331   my $self = shift;
332   my %status = (
333     'done'        => 'Approved',
334     'expired'     => 'Card Expired',
335     'stolen'      => 'Lost/Stolen',
336     'pickup'      => 'Pick Up Card',
337     'nsf'         => 'Insufficient Funds',
338     'inactive'    => 'Inactive Account',
339     'blacklisted' => 'Blacklisted',
340     'declined'    => 'Declined',
341     'approved'    => 'Approved',
342   );
343   if ( $self->failure_status ) {
344     return $status{$self->failure_status};
345   } else {
346     return $status{$self->status};
347   }
348 }
349
350 =item paydate_monthyear
351
352 Returns a two-element list consisting of the month and year of this customer's
353 paydate (credit card expiration date for CARD customers)
354
355 =cut
356
357 sub paydate_monthyear {
358   my $self = shift;
359   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
360     ( $2, $1 );
361   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
362     ( $1, $3 );
363   } else {
364     ('', '');
365   }
366 }
367
368 =item paydate_epoch
369
370 Returns the exact time in seconds corresponding to the payment method 
371 expiration date.  For CARD/DCRD customers this is the end of the month;
372 for others (COMP is the only other payby that uses paydate) it's the start.
373 Returns 0 if the paydate is empty or set to the far future.
374
375 =cut
376
377 sub paydate_epoch {
378   my $self = shift;
379   my ($month, $year) = $self->paydate_monthyear;
380   return 0 if !$year or $year >= 2037;
381   if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
382     $month++;
383     if ( $month == 13 ) {
384       $month = 1;
385       $year++;
386     }
387     return timelocal(0,0,0,1,$month-1,$year) - 1;
388   }
389   else {
390     return timelocal(0,0,0,1,$month-1,$year);
391   }
392 }
393
394 =item paydate_epoch_sql
395
396 Class method.  Returns an SQL expression to obtain the payment expiration date
397 as a number of seconds.
398
399 =cut
400
401 # Special expiration date behavior for non-CARD/DCRD customers has been 
402 # carefully preserved.  Do we really use that?
403 sub paydate_epoch_sql {
404   my $class = shift;
405   my $table = $class->table;
406   my ($case1, $case2);
407   if ( driver_name eq 'Pg' ) {
408     $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
409     $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
410   }
411   elsif ( lc(driver_name) eq 'mysql' ) {
412     $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
413     $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
414   }
415   else { return '' }
416   return "CASE WHEN $table.payby IN('CARD','DCRD') 
417   THEN ($case1)
418   ELSE ($case2)
419   END"
420 }
421
422 =item upgrade_set_cardtype
423
424 Find all records with a credit card payment type and no paycardtype, and
425 replace them in order to set their paycardtype.
426
427 This method actually just starts a queue job.
428
429 =cut
430
431 sub upgrade_set_cardtype {
432   my $class = shift;
433   my $table = $class->table or die "upgrade_set_cardtype needs a table";
434
435   if ( ! FS::upgrade_journal->is_done("${table}__set_cardtype") ) {
436     my $job = FS::queue->new({ job => 'FS::payinfo_Mixin::process_set_cardtype' });
437     my $error = $job->insert($table);
438     die $error if $error;
439     FS::upgrade_journal->set_done("${table}__set_cardtype");
440   }
441 }
442
443 sub process_set_cardtype {
444   my $table = shift;
445
446   # assign cardtypes to CARD/DCRDs that need them; check_payinfo_cardtype
447   # will do this. ignore any problems with the cards.
448   local $ignore_masked_payinfo = 1;
449   my $search = FS::Cursor->new({
450     table     => $table,
451     extra_sql => q[ WHERE payby IN('CARD','DCRD') AND paycardtype IS NULL ],
452   });
453   while (my $record = $search->fetch) {
454     my $error = $record->replace;
455     die $error if $error;
456   }
457 }
458
459 =item tokenized [ PAYINFO ]
460
461 Returns true if object payinfo is tokenized
462
463 Optionally, an arbitrary payby and payinfo can be passed.
464
465 =cut
466
467 sub tokenized {
468   my $self = shift;
469   my $payinfo = scalar(@_) ? shift : $self->payinfo;
470   return 0 unless $payinfo; #avoid uninitialized value error
471   $payinfo =~ /^99\d{14}$/;
472 }
473
474 =back
475
476 =head1 BUGS
477
478 =head1 SEE ALSO
479
480 L<FS::payby>, L<FS::Record>
481
482 =cut
483
484 1;
485