FS/FS/cust_pay_batch.pm

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