site_perl/cust_credit.pm

   1 package FS::cust_credit;
   2
   3 use strict;
   4 use vars qw(@ISA @EXPORT_OK);
   5 use Exporter;
   6 use FS::UID qw(getotaker);
   7 use FS::Record qw(fields qsearchs);
   8
   9 @ISA = qw(FS::Record Exporter);
  10 @EXPORT_OK = qw(fields);
  11
  12 =head1 NAME
  13
  14 FS::cust_credit - Object methods for cust_credit records
  15
  16 =head1 SYNOPSIS
  17
  18   use FS::cust_credit;
  19
  20   $record = create FS::cust_credit \%hash;
  21   $record = create FS::cust_credit { 'column' => 'value' };
  22
  23   $error = $record->insert;
  24
  25   $error = $new_record->replace($old_record);
  26
  27   $error = $record->delete;
  28
  29   $error = $record->check;
  30
  31 =head1 DESCRIPTION
  32
  33 An FS::cust_credit object represents a credit.  FS::cust_credit inherits from
  34 FS::Record.  The following fields are currently supported:
  35
  36 =over 4
  37
  38 =item crednum - primary key (assigned automatically for new credits)
  39
  40 =item custnum - customer (see L<FS::cust_main>)
  41
  42 =item amount - amount of the credit
  43
  44 =item credited - how much of this credit that is still outstanding, which is
  45 amount minus all refunds (see L<FS::cust_refund>).
  46
  47 =item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
  48 L<Time::Local> and L<Date::Parse> for conversion functions.
  49
  50 =item otaker - order taker (assigned automatically, see L<FS::UID>)
  51
  52 =item reason - text
  53
  54 =back
  55
  56 =head1 METHODS
  57
  58 =over 4
  59
  60 =item create HASHREF
  61
  62 Creates a new credit.  To add the credit to the database, 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_credit')) {
  72   #  $hashref->{$field}='' unless defined $hashref->{$field};
  73   #}
  74
  75   $proto->new('cust_credit',$hashref);
  76 }
  77
  78 =item insert
  79
  80 Adds this credit to the database ("Posts" the credit).  If there is an error,
  81 returns the error, otherwise returns false.
  82
  83 When adding new invoices, credited must be amount (or null, in which case it is
  84 automatically set to amount).
  85
  86 =cut
  87
  88 sub insert {
  89   my($self)=@_;
  90
  91   $self->setfield('credited',$self->amount) if $self->credited eq '';
  92   return "credited != amount!"
  93     unless $self->credited == $self->amount;
  94
  95   $self->check or
  96   $self->add;
  97 }
  98
  99 =item delete
 100
 101 Currently unimplemented.
 102
 103 =cut
 104
 105 sub delete {
 106   return "Can't remove credit!"
 107   #my($self)=@_;
 108   #$self->del;
 109 }
 110
 111 =item replace OLD_RECORD
 112
 113 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 114 returns the error, otherwise returns false.
 115
 116 Only credited may be changed.  Credited is normally updated by creating and
 117 inserting a refund (see L<FS::cust_refund>).
 118
 119 =cut
 120
 121 sub replace {
 122   my($new,$old)=@_;
 123   return "(Old) Not a cust_credit record!" unless $old->table eq "cust_credit";
 124   return "Can't change crednum!"
 125     unless $old->getfield('crednum') eq $new->getfield('crednum');
 126   return "Can't change custnum!"
 127     unless $old->getfield('custnum') eq $new->getfield('custnum');
 128   return "Can't change date!"
 129     unless $old->getfield('_date') eq $new->getfield('_date');
 130   return "Can't change amount!"
 131     unless $old->getfield('amount') eq $new->getfield('amount');
 132   return "(New) credited can't be > (new) amount!"
 133     if $new->getfield('credited') > $new->getfield('amount');
 134
 135   $new->check or
 136   $new->rep($old);
 137 }
 138
 139 =item check
 140
 141 Checks all fields to make sure this is a valid credit.  If there is an error,
 142 returns the error, otherwise returns false.  Called by the insert and replace
 143 methods.
 144
 145 =cut
 146
 147 sub check {
 148   my($self)=@_;
 149   return "Not a cust_credit record!" unless $self->table eq "cust_credit";
 150   my($recref) = $self->hashref;
 151
 152   $recref->{crednum} =~ /^(\d*)$/ or return "Illegal crednum";
 153   $recref->{crednum} = $1;
 154
 155   $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
 156   $recref->{custnum} = $1;
 157   return "Unknown customer"
 158     unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
 159
 160   $recref->{_date} =~ /^(\d*)$/ or return "Illegal date";
 161   $recref->{_date} = $recref->{_date} ? $1 : time;
 162
 163   $recref->{amount} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal amount";
 164   $recref->{amount} = $1;
 165
 166   $recref->{credited} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal credited";
 167   $recref->{credited} = $1;
 168
 169   #$recref->{otaker} =~ /^(\w+)$/ or return "Illegal otaker";
 170   #$recref->{otaker} = $1;
 171   $self->otaker(getotaker);
 172
 173   $self->ut_textn('reason');
 174
 175 }
 176
 177 =back
 178
 179 =head1 BUGS
 180
 181 The delete method.
 182
 183 It doesn't properly override FS::Record yet.
 184
 185 =head1 SEE ALSO
 186
 187 L<FS::Record>, L<FS::cust_refund>, L<FS::cust_bill>, schema.html from the base
 188 documentation.
 189
 190 =head1 HISTORY
 191
 192 ivan@sisd.com 98-mar-17
 193
 194 pod, otaker from FS::UID ivan@sisd.com 98-sep-21
 195
 196 =cut
 197
 198 1;
 199