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