site_perl/cust_refund.pm

   1 package FS::cust_refund;
   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::UID qw(getotaker);
   9 use FS::cust_credit;
  10
  11 @ISA = qw(FS::Record Exporter);
  12 @EXPORT_OK = qw(fields);
  13
  14 =head1 NAME
  15
  16 FS::cust_refund - Object method for cust_refund objects
  17
  18 =head1 SYNOPSIS
  19
  20   use FS::cust_refund;
  21
  22   $record = create FS::cust_refund \%hash;
  23   $record = create FS::cust_refund { 'column' => 'value' };
  24
  25   $error = $record->insert;
  26
  27   $error = $new_record->replace($old_record);
  28
  29   $error = $record->delete;
  30
  31   $error = $record->check;
  32
  33 =head1 DESCRIPTION
  34
  35 An FS::cust_refund represents a refund.  FS::cust_refund inherits from
  36 FS::Record.  The following fields are currently supported:
  37
  38 =over 4
  39
  40 =item refundnum - primary key (assigned automatically for new refunds)
  41
  42 =item crednum - Credit (see L<FS::cust_credit>)
  43
  44 =item refund - Amount of the refund
  45
  46 =item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
  47 L<Time::Local> and L<Date::Parse> for conversion functions.
  48
  49 =item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
  50
  51 =item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
  52
  53 =item otaker - order taker (assigned automatically, see L<FS::UID>)
  54
  55 =back
  56
  57 =head1 METHODS
  58
  59 =over 4
  60
  61 =item create HASHREF
  62
  63 Creates a new refund.  To add the refund to the database, see L<"insert">.
  64
  65 =cut
  66
  67 sub create {
  68   my($proto,$hashref)=@_;
  69
  70   #now in FS::Record::new
  71   #my($field);
  72   #foreach $field (fields('cust_refund')) {
  73   #  $hashref->{$field}='' unless defined $hashref->{$field};
  74   #}
  75
  76   $proto->new('cust_refund',$hashref);
  77
  78 }
  79
  80 =item insert
  81
  82 Adds this refund to the database, and updates the credit (see
  83 L<FS::cust_credit>).
  84
  85 =cut
  86
  87 sub insert {
  88   my($self)=@_;
  89
  90   my($error);
  91
  92   $error=$self->check;
  93   return $error if $error;
  94
  95   my($old_cust_credit) = qsearchs('cust_credit', {
  96                                 'crednum' => $self->getfield('crednum')
  97                                } );
  98   return "Unknown crednum" unless $old_cust_credit;
  99   my(%hash)=$old_cust_credit->hash;
 100   $hash{credited} = sprintf("%.2f",$hash{credited} - $self->getfield('refund') );
 101   my($new_cust_credit) = create FS::cust_credit ( \%hash );
 102
 103   local $SIG{HUP} = 'IGNORE';
 104   local $SIG{INT} = 'IGNORE';
 105   local $SIG{QUIT} = 'IGNORE';
 106   local $SIG{TERM} = 'IGNORE';
 107   local $SIG{TSTP} = 'IGNORE';
 108
 109   $error=$new_cust_credit -> replace($old_cust_credit);
 110   return "Error modifying cust_credit: $error" if $error;
 111
 112   $self->add;
 113 }
 114
 115 =item delete
 116
 117 Currently unimplemented (accounting reasons).
 118
 119 =cut
 120
 121 sub delete {
 122   return "Can't (yet?) delete cust_refund records!";
 123 #template code below
 124 #  my($self)=@_;
 125 #
 126 #  $self->del;
 127 }
 128
 129 =item replace OLD_RECORD
 130
 131 Currently unimplemented (accounting reasons).
 132
 133 =cut
 134
 135 sub replace {
 136    return "Can't (yet?) modify cust_refund records!";
 137 #template code below
 138 #  my($new,$old)=@_;
 139 #  return "(Old) Not a cust_refund record!" unless $old->table eq "cust_refund";
 140 #
 141 #  $new->check or
 142 #  $new->rep($old);
 143 }
 144
 145 =item check
 146
 147 Checks all fields to make sure this is a valid refund.  If there is an error,
 148 returns the error, otherwise returns false.  Called by the insert method.
 149
 150 =cut
 151
 152 sub check {
 153   my($self)=@_;
 154   return "Not a cust_refund record!" unless $self->table eq "cust_refund";
 155
 156   my $error =
 157     $self->ut_number('refundnum')
 158     || $self->ut_number('crednum')
 159     || $self->ut_money('amount')
 160     || $self->ut_numbern('_date')
 161   ;
 162   return $error if $error;
 163
 164   my($recref) = $self->hashref;
 165
 166   $recref->{_date} ||= 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 (checksum) credit card number (payinfo)";
 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   $self->otaker(getotaker);
 205
 206   ''; #no error
 207 }
 208
 209 =back
 210
 211 =head1 BUGS
 212
 213 It doesn't properly override FS::Record yet.
 214
 215 Delete and replace methods.
 216
 217 =head1 SEE ALSO
 218
 219 L<FS::Record>, L<FS::cust_credit>, schema.html from the base documentation.
 220
 221 =head1 HISTORY
 222
 223 ivan@sisd.com 98-mar-18
 224
 225 ->create had wrong tablename ivan@sisd.com 98-jun-16
 226 (finish me!)
 227
 228 pod and finish up ivan@sisd.com 98-sep-21
 229
 230 =cut
 231
 232 1;
 233