FS/FS/cust_credit.pm

   1 package FS::cust_credit;
   2
   3 use strict;
   4 use vars qw( @ISA $conf $unsuspendauto );
   5 use Date::Format;
   6 use FS::UID qw( dbh getotaker );
   7 use FS::Record qw( qsearch qsearchs );
   8 use FS::Misc qw(send_email);
   9 use FS::cust_main;
  10 use FS::cust_refund;
  11 use FS::cust_credit_bill;
  12
  13 @ISA = qw( FS::Record );
  14
  15 #ask FS::UID to run this stuff for us later
  16 $FS::UID::callback{'FS::cust_credit'} = sub {
  17
  18   $conf = new FS::Conf;
  19   $unsuspendauto = $conf->exists('unsuspendauto');
  20
  21 };
  22
  23 =head1 NAME
  24
  25 FS::cust_credit - Object methods for cust_credit records
  26
  27 =head1 SYNOPSIS
  28
  29   use FS::cust_credit;
  30
  31   $record = new FS::cust_credit \%hash;
  32   $record = new FS::cust_credit { 'column' => 'value' };
  33
  34   $error = $record->insert;
  35
  36   $error = $new_record->replace($old_record);
  37
  38   $error = $record->delete;
  39
  40   $error = $record->check;
  41
  42 =head1 DESCRIPTION
  43
  44 An FS::cust_credit object represents a credit; the equivalent of a negative
  45 B<cust_bill> record (see L<FS::cust_bill>).  FS::cust_credit inherits from
  46 FS::Record.  The following fields are currently supported:
  47
  48 =over 4
  49
  50 =item crednum - primary key (assigned automatically for new credits)
  51
  52 =item custnum - customer (see L<FS::cust_main>)
  53
  54 =item amount - amount of the credit
  55
  56 =item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
  57 L<Time::Local> and L<Date::Parse> for conversion functions.
  58
  59 =item otaker - order taker (assigned automatically, see L<FS::UID>)
  60
  61 =item reason - text
  62
  63 =item closed - books closed flag, empty or `Y'
  64
  65 =back
  66
  67 =head1 METHODS
  68
  69 =over 4
  70
  71 =item new HASHREF
  72
  73 Creates a new credit.  To add the credit to the database, see L<"insert">.
  74
  75 =cut
  76
  77 sub table { 'cust_credit'; }
  78
  79 =item insert
  80
  81 Adds this credit to the database ("Posts" the credit).  If there is an error,
  82 returns the error, otherwise returns false.
  83
  84 =cut
  85
  86 sub insert {
  87   my $self = shift;
  88
  89   local $SIG{HUP} = 'IGNORE';
  90   local $SIG{INT} = 'IGNORE';
  91   local $SIG{QUIT} = 'IGNORE';
  92   local $SIG{TERM} = 'IGNORE';
  93   local $SIG{TSTP} = 'IGNORE';
  94   local $SIG{PIPE} = 'IGNORE';
  95
  96   my $oldAutoCommit = $FS::UID::AutoCommit;
  97   local $FS::UID::AutoCommit = 0;
  98   my $dbh = dbh;
  99
 100   my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 101   my $old_balance = $cust_main->balance;
 102
 103   my $error = $self->SUPER::insert;
 104   if ( $error ) {
 105     $dbh->rollback if $oldAutoCommit;
 106     return "error inserting $self: $error";
 107   }
 108
 109   #false laziness w/ cust_credit::insert
 110   if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
 111     my @errors = $cust_main->unsuspend;
 112     #return
 113     # side-fx with nested transactions?  upstack rolls back?
 114     warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
 115          join(' / ', @errors)
 116       if @errors;
 117   }
 118   #eslaf
 119
 120   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 121
 122   '';
 123
 124 }
 125
 126 =item delete
 127
 128 Currently unimplemented.
 129
 130 =cut
 131
 132 sub delete {
 133   my $self = shift;
 134   return "Can't delete closed credit" if $self->closed =~ /^Y/i;
 135
 136   local $SIG{HUP} = 'IGNORE';
 137   local $SIG{INT} = 'IGNORE';
 138   local $SIG{QUIT} = 'IGNORE';
 139   local $SIG{TERM} = 'IGNORE';
 140   local $SIG{TSTP} = 'IGNORE';
 141   local $SIG{PIPE} = 'IGNORE';
 142
 143   my $oldAutoCommit = $FS::UID::AutoCommit;
 144   local $FS::UID::AutoCommit = 0;
 145   my $dbh = dbh;
 146
 147   foreach my $cust_credit_bill ( $self->cust_credit_bill ) {
 148     my $error = $cust_credit_bill->delete;
 149     if ( $error ) {
 150       $dbh->rollback if $oldAutoCommit;
 151       return $error;
 152     }
 153   }
 154
 155   my $error = $self->SUPER::delete(@_);
 156   if ( $error ) {
 157     $dbh->rollback if $oldAutoCommit;
 158     return $error;
 159   }
 160
 161   if ( $conf->config('deletecredits') ne '' ) {
 162
 163     my $cust_main = qsearchs('cust_main',{ 'custnum' => $self->custnum });
 164
 165     my $error = send_email(
 166       'from'    => $conf->config('invoice_from'), #??? well as good as any
 167       'to'      => $conf->config('deletecredits'),
 168       'subject' => 'FREESIDE NOTIFICATION: Credit deleted',
 169       'body'    => [
 170         "This is an automatic message from your Freeside installation\n",
 171         "informing you that the following credit has been deleted:\n",
 172         "\n",
 173         'crednum: '. $self->crednum. "\n",
 174         'custnum: '. $self->custnum.
 175           " (". $cust_main->last. ", ". $cust_main->first. ")\n",
 176         'amount: $'. sprintf("%.2f", $self->amount). "\n",
 177         'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
 178         'reason: '. $self->reason. "\n",
 179       ],
 180     );
 181
 182     if ( $error ) {
 183       $dbh->rollback if $oldAutoCommit;
 184       return "can't send credit deletion notification: $error";
 185     }
 186
 187   }
 188
 189   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 190
 191   '';
 192
 193 }
 194
 195 =item replace OLD_RECORD
 196
 197 Credits may not be modified; there would then be no record the credit was ever
 198 posted.
 199
 200 =cut
 201
 202 sub replace {
 203   #return "Can't modify credit!"
 204   my $self = shift;
 205   return "Can't modify closed credit" if $self->closed =~ /^Y/i;
 206   $self->SUPER::replace(@_);
 207 }
 208
 209 =item check
 210
 211 Checks all fields to make sure this is a valid credit.  If there is an error,
 212 returns the error, otherwise returns false.  Called by the insert and replace
 213 methods.
 214
 215 =cut
 216
 217 sub check {
 218   my $self = shift;
 219
 220   my $error =
 221     $self->ut_numbern('crednum')
 222     || $self->ut_number('custnum')
 223     || $self->ut_numbern('_date')
 224     || $self->ut_money('amount')
 225     || $self->ut_textn('reason')
 226     || $self->ut_enum('closed', [ '', 'Y' ])
 227   ;
 228   return $error if $error;
 229
 230   return "amount must be > 0 " if $self->amount <= 0;
 231
 232   return "Unknown customer"
 233     unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 234
 235   $self->_date(time) unless $self->_date;
 236
 237   $self->otaker(getotaker);
 238
 239   $self->SUPER::check;
 240 }
 241
 242 =item cust_refund
 243
 244 Depreciated.  See the cust_credit_refund method.
 245
 246 #Returns all refunds (see L<FS::cust_refund>) for this credit.
 247
 248 =cut
 249
 250 sub cust_refund {
 251   use Carp;
 252   croak "FS::cust_credit->cust_pay depreciated; see ".
 253         "FS::cust_credit->cust_credit_refund";
 254   #my $self = shift;
 255   #sort { $a->_date <=> $b->_date }
 256   #  qsearch( 'cust_refund', { 'crednum' => $self->crednum } )
 257   #;
 258 }
 259
 260 =item cust_credit_refund
 261
 262 Returns all refund applications (see L<FS::cust_credit_refund>) for this credit.
 263
 264 =cut
 265
 266 sub cust_credit_refund {
 267   my $self = shift;
 268   sort { $a->_date <=> $b->_date }
 269     qsearch( 'cust_credit_refund', { 'crednum' => $self->crednum } )
 270   ;
 271 }
 272
 273 =item cust_credit_bill
 274
 275 Returns all application to invoices (see L<FS::cust_credit_bill>) for this
 276 credit.
 277
 278 =cut
 279
 280 sub cust_credit_bill {
 281   my $self = shift;
 282   sort { $a->_date <=> $b->_date }
 283     qsearch( 'cust_credit_bill', { 'crednum' => $self->crednum } )
 284   ;
 285 }
 286
 287 =item credited
 288
 289 Returns the amount of this credit that is still outstanding; which is
 290 amount minus all refund applications (see L<FS::cust_credit_refund>) and
 291 applications to invoices (see L<FS::cust_credit_bill>).
 292
 293 =cut
 294
 295 sub credited {
 296   my $self = shift;
 297   my $amount = $self->amount;
 298   $amount -= $_->amount foreach ( $self->cust_credit_refund );
 299   $amount -= $_->amount foreach ( $self->cust_credit_bill );
 300   sprintf( "%.2f", $amount );
 301 }
 302
 303 =item cust_main
 304
 305 Returns the customer (see L<FS::cust_main>) for this credit.
 306
 307 =cut
 308
 309 sub cust_main {
 310   my $self = shift;
 311   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 312 }
 313
 314
 315 =back
 316
 317 =head1 BUGS
 318
 319 The delete method.  The replace method.
 320
 321 =head1 SEE ALSO
 322
 323 L<FS::Record>, L<FS::cust_credit_refund>, L<FS::cust_refund>,
 324 L<FS::cust_credit_bill> L<FS::cust_bill>, schema.html from the base
 325 documentation.
 326
 327 =cut
 328
 329 1;
 330