site_perl/cust_pay.pm

   1 package FS::cust_pay;
   2
   3 use strict;
   4 use vars qw(@ISA @EXPORT_OK);
   5 use Exporter;
   6 use Business::CreditCard;
   7 use FS::Record qw(fields qsearchs);
   8 use FS::cust_bill;
   9
  10 @ISA = qw(FS::Record Exporter);
  11 @EXPORT_OK = qw(fields);
  12
  13 =head1 NAME
  14
  15 FS::cust_pay - Object methods for cust_pay objects
  16
  17 =head1 SYNOPSIS
  18
  19   use FS::cust_pay;
  20
  21   $record = create FS::cust_pay \%hash;
  22   $record = create FS::cust_pay { 'column' => 'value' };
  23
  24   $error = $record->insert;
  25
  26   $error = $new_record->replace($old_record);
  27
  28   $error = $record->delete;
  29
  30   $error = $record->check;
  31
  32 =head1 DESCRIPTION
  33
  34 An FS::cust_pay object represents a payment.  FS::cust_pay inherits from
  35 FS::Record.  The following fields are currently supported:
  36
  37 =over 4
  38
  39 =item paynum - primary key (assigned automatically for new payments)
  40
  41 =item invnum - Invoice (see L<FS::cust_bill>)
  42
  43 =item paid - Amount of this payment
  44
  45 =item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
  46 L<Time::Local> and L<Date::Parse> for conversion functions.
  47
  48 =item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
  49
  50 =item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
  51
  52 =item paybatch - text field for tracking card processing
  53
  54 =back
  55
  56 =head1 METHODS
  57
  58 =over 4
  59
  60 =item create HASHREF
  61
  62 Creates a new payment.  To add the payment to the databse, see L<"insert">.
  63
  64 =cut
  65
  66 sub create {
  67   my($proto,$hashref)=@_;
  68
  69   #now in FS::Record::new
  70   #my($field);
  71   #foreach $field (fields('cust_pay')) {
  72   #  $hashref->{$field}='' unless defined $hashref->{$field};
  73   #}
  74
  75   $proto->new('cust_pay',$hashref);
  76
  77 }
  78
  79 =item insert
  80
  81 Adds this payment to the databse, and updates the invoice (see
  82 L<FS::cust_bill>).
  83
  84 =cut
  85
  86 sub insert {
  87   my($self)=@_;
  88
  89   my($error);
  90
  91   $error=$self->check;
  92   return $error if $error;
  93
  94   my($old_cust_bill) = qsearchs('cust_bill', {
  95                                 'invnum' => $self->getfield('invnum')
  96                                } );
  97   return "Unknown invnum" unless $old_cust_bill;
  98   my(%hash)=$old_cust_bill->hash;
  99   $hash{owed} = sprintf("%.2f",$hash{owed} - $self->getfield('paid') );
 100   my($new_cust_bill) = create FS::cust_bill ( \%hash );
 101
 102   local $SIG{HUP} = 'IGNORE';
 103   local $SIG{INT} = 'IGNORE';
 104   local $SIG{QUIT} = 'IGNORE';
 105   local $SIG{TERM} = 'IGNORE';
 106   local $SIG{TSTP} = 'IGNORE';
 107
 108   $error=$new_cust_bill -> replace($old_cust_bill);
 109   return "Error modifying cust_bill: $error" if $error;
 110
 111   $self->add;
 112 }
 113
 114 =item delete
 115
 116 Currently unimplemented (accounting reasons).
 117
 118 =cut
 119
 120 sub delete {
 121   return "Can't (yet?) delete cust_pay records!";
 122 #template code below
 123 #  my($self)=@_;
 124 #
 125 #  $self->del;
 126 }
 127
 128 =item replace OLD_RECORD
 129
 130 Currently unimplemented (accounting reasons).
 131
 132 =cut
 133
 134 sub replace {
 135    return "Can't (yet?) modify cust_pay records!";
 136 #template code below
 137 #  my($new,$old)=@_;
 138 #  return "(Old) Not a cust_pay record!" unless $old->table eq "cust_pay";
 139 #
 140 #  $new->check or
 141 #  $new->rep($old);
 142 }
 143
 144 =item check
 145
 146 Checks all fields to make sure this is a valid payment.  If there is an error,
 147 returns the error, otherwise returns false.  Called by the insert method.
 148
 149 =cut
 150
 151 sub check {
 152   my($self)=@_;
 153   return "Not a cust_pay record!" unless $self->table eq "cust_pay";
 154   my($recref) = $self->hashref;
 155
 156   $recref->{paynum} =~ /^(\d*)$/ or return "Illegal paynum";
 157   $recref->{paynum} = $1;
 158
 159   $recref->{invnum} =~ /^(\d+)$/ or return "Illegal invnum";
 160   $recref->{invnum} = $1;
 161
 162   $recref->{paid} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal paid";
 163   $recref->{paid} = $1;
 164
 165   $recref->{_date} =~ /^(\d*)$/ or return "Illegal date";
 166   $recref->{_date} = $recref->{_date} ? $1 : time;
 167
 168   $recref->{payby} =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
 169   $recref->{payby} = $1;
 170
 171   if ( $recref->{payby} eq 'CARD' ) {
 172
 173     $recref->{payinfo} =~ s/\D//g;
 174     if ( $recref->{payinfo} ) {
 175       $recref->{payinfo} =~ /^(\d{13,16})$/
 176         or return "Illegal (mistyped?) credit card number (payinfo)";
 177       $recref->{payinfo} = $1;
 178       #validate($recref->{payinfo})
 179       #  or return "Illegal credit card number";
 180       my($type)=cardtype($recref->{payinfo});
 181       return "Unknown credit card type"
 182         unless ( $type =~ /^VISA/ ||
 183                  $type =~ /^MasterCard/ ||
 184                  $type =~ /^American Express/ ||
 185                  $type =~ /^Discover/ );
 186     } else {
 187       $recref->{payinfo}='N/A';
 188     }
 189
 190   } elsif ( $recref->{payby} eq 'BILL' ) {
 191
 192     $recref->{payinfo} =~ /^([\w \-]*)$/
 193       or return "Illegal P.O. number (payinfo)";
 194     $recref->{payinfo} = $1;
 195
 196   } elsif ( $recref->{payby} eq 'COMP' ) {
 197
 198     $recref->{payinfo} =~ /^([\w]{2,8})$/
 199       or return "Illegal comp account issuer (payinfo)";
 200     $recref->{payinfo} = $1;
 201
 202   }
 203
 204   $recref->{paybatch} =~ /^([\w\-\:]*)$/
 205     or return "Illegal paybatch";
 206   $recref->{paybatch} = $1;
 207
 208   ''; #no error
 209
 210 }
 211
 212 =back
 213
 214 =head1 BUGS
 215
 216 It doesn't properly override FS::Record yet.
 217
 218 Delete and replace methods.
 219
 220 =head1 SEE ALSO
 221
 222 L<FS::Record>, L<FS::cust_bill>, schema.html from the base documentation.
 223
 224 =head1 HISTORY
 225
 226 ivan@voicenet.com 97-jul-1 - 25 - 29
 227
 228 new api ivan@sisd.com 98-mar-13
 229
 230 pod ivan@sisd.com 98-sep-21
 231
 232 =cut
 233
 234 1;
 235