FS/FS/cust_pay_batch.pm

   1 package FS::cust_pay_batch;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   5 use FS::Record qw(dbh qsearch qsearchs);
   6 use FS::payinfo_Mixin;
   7 use Business::CreditCard 0.28;
   8
   9 @ISA = qw( FS::Record FS::payinfo_Mixin );
  10
  11 # 1 is mostly method/subroutine entry and options
  12 # 2 traces progress of some operations
  13 # 3 is even more information including possibly sensitive data
  14 $DEBUG = 0;
  15
  16 =head1 NAME
  17
  18 FS::cust_pay_batch - Object methods for batch cards
  19
  20 =head1 SYNOPSIS
  21
  22   use FS::cust_pay_batch;
  23
  24   $record = new FS::cust_pay_batch \%hash;
  25   $record = new FS::cust_pay_batch { 'column' => 'value' };
  26
  27   $error = $record->insert;
  28
  29   $error = $new_record->replace($old_record);
  30
  31   $error = $record->delete;
  32
  33   $error = $record->check;
  34
  35   $error = $record->retriable;
  36
  37 =head1 DESCRIPTION
  38
  39 An FS::cust_pay_batch object represents a credit card transaction ready to be
  40 batched (sent to a processor).  FS::cust_pay_batch inherits from FS::Record.
  41 Typically called by the collect method of an FS::cust_main object.  The
  42 following fields are currently supported:
  43
  44 =over 4
  45
  46 =item paybatchnum - primary key (automatically assigned)
  47
  48 =item batchnum - indentifies group in batch
  49
  50 =item payby - CARD/CHEK/LECB/BILL/COMP
  51
  52 =item payinfo
  53
  54 =item exp - card expiration
  55
  56 =item amount
  57
  58 =item invnum - invoice
  59
  60 =item custnum - customer
  61
  62 =item payname - name on card
  63
  64 =item first - name
  65
  66 =item last - name
  67
  68 =item address1
  69
  70 =item address2
  71
  72 =item city
  73
  74 =item state
  75
  76 =item zip
  77
  78 =item country
  79
  80 =item status
  81
  82 =back
  83
  84 =head1 METHODS
  85
  86 =over 4
  87
  88 =item new HASHREF
  89
  90 Creates a new record.  To add the record to the database, see L<"insert">.
  91
  92 Note that this stores the hash reference, not a distinct copy of the hash it
  93 points to.  You can ask the object for a copy with the I<hash> method.
  94
  95 =cut
  96
  97 sub table { 'cust_pay_batch'; }
  98
  99 =item insert
 100
 101 Adds this record to the database.  If there is an error, returns the error,
 102 otherwise returns false.
 103
 104 =item delete
 105
 106 Delete this record from the database.  If there is an error, returns the error,
 107 otherwise returns false.
 108
 109 =item replace OLD_RECORD
 110
 111 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 112 returns the error, otherwise returns false.
 113
 114 =item check
 115
 116 Checks all fields to make sure this is a valid transaction.  If there is
 117 an error, returns the error, otherwise returns false.  Called by the insert
 118 and replace methods.
 119
 120 =cut
 121
 122 sub check {
 123   my $self = shift;
 124
 125   my $error =
 126       $self->ut_numbern('paybatchnum')
 127     || $self->ut_numbern('trancode') #deprecated
 128     || $self->ut_money('amount')
 129     || $self->ut_number('invnum')
 130     || $self->ut_number('custnum')
 131     || $self->ut_text('address1')
 132     || $self->ut_textn('address2')
 133     || $self->ut_text('city')
 134     || $self->ut_textn('state')
 135   ;
 136
 137   return $error if $error;
 138
 139   $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
 140   $self->setfield('last',$1);
 141
 142   $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name";
 143   $self->first($1);
 144
 145   $error = $self->payinfo_check();
 146   return $error if $error;
 147
 148   if ( $self->exp eq '' ) {
 149     return "Expiration date required"
 150       unless $self->payby =~ /^(CHEK|DCHK|LECB|WEST)$/;
 151     $self->exp('');
 152   } else {
 153     if ( $self->exp =~ /^(\d{4})[\/\-](\d{1,2})[\/\-](\d{1,2})$/ ) {
 154       $self->exp("$1-$2-$3");
 155     } elsif ( $self->exp =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
 156       if ( length($2) == 4 ) {
 157         $self->exp("$2-$1-01");
 158       } elsif ( $2 > 98 ) { #should pry change to check for "this year"
 159         $self->exp("19$2-$1-01");
 160       } else {
 161         $self->exp("20$2-$1-01");
 162       }
 163     } else {
 164       return "Illegal expiration date";
 165     }
 166   }
 167
 168   if ( $self->payname eq '' ) {
 169     $self->payname( $self->first. " ". $self->getfield('last') );
 170   } else {
 171     $self->payname =~ /^([\w \,\.\-\']+)$/
 172       or return "Illegal billing name";
 173     $self->payname($1);
 174   }
 175
 176   #we have lots of old zips in there... don't hork up batch results cause of em
 177   $self->zip =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
 178     or return "Illegal zip: ". $self->zip;
 179   $self->zip($1);
 180
 181   $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
 182   $self->country($1);
 183
 184   #$error = $self->ut_zip('zip', $self->country);
 185   #return $error if $error;
 186
 187   #check invnum, custnum, ?
 188
 189   $self->SUPER::check;
 190 }
 191
 192 =item cust_main
 193
 194 Returns the customer (see L<FS::cust_main>) for this batched credit card
 195 payment.
 196
 197 =cut
 198
 199 sub cust_main {
 200   my $self = shift;
 201   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 202 }
 203
 204 =item retriable
 205
 206 Marks the corresponding event (see L<FS::cust_bill_event>) for this batched
 207 credit card payment as retriable.  Useful if the corresponding financial
 208 institution account was declined for temporary reasons and/or a manual
 209 retry is desired.
 210
 211 Implementation details: For the named customer's invoice, changes the
 212 statustext of the 'done' (without statustext) event to 'retriable.'
 213
 214 =cut
 215
 216 sub retriable {
 217   my $self = shift;
 218
 219   local $SIG{HUP} = 'IGNORE';        #Hmm
 220   local $SIG{INT} = 'IGNORE';
 221   local $SIG{QUIT} = 'IGNORE';
 222   local $SIG{TERM} = 'IGNORE';
 223   local $SIG{TSTP} = 'IGNORE';
 224   local $SIG{PIPE} = 'IGNORE';
 225
 226   my $oldAutoCommit = $FS::UID::AutoCommit;
 227   local $FS::UID::AutoCommit = 0;
 228   my $dbh = dbh;
 229
 230   my $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
 231     or return "event $self->eventnum references nonexistant invoice $self->invnum";
 232
 233   warn "cust_pay_batch->retriable working with self of " . $self->paybatchnum . " and invnum of " . $self->invnum;
 234   my @cust_bill_event =
 235     sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
 236       grep {
 237         $_->part_bill_event->eventcode =~ /\$cust_bill->batch_card/
 238           && $_->status eq 'done'
 239           && ! $_->statustext
 240         }
 241       $cust_bill->cust_bill_event;
 242   # complain loudly if scalar(@cust_bill_event) > 1 ?
 243   my $error = $cust_bill_event[0]->retriable;
 244   if ($error ) {
 245     # gah, even with transactions.
 246     $dbh->commit if $oldAutoCommit; #well.
 247     return "error marking invoice event retriable: $error";
 248   }
 249   '';
 250 }
 251
 252 =back
 253
 254 =head1 BUGS
 255
 256 There should probably be a configuration file with a list of allowed credit
 257 card types.
 258
 259 =head1 SEE ALSO
 260
 261 L<FS::cust_main>, L<FS::Record>
 262
 263 =cut
 264
 265 1;
 266