Merge branch 'master' of git.freeside.biz:/home/git/freeside
[freeside.git] / FS / FS / cust_credit.pm
index c459d82..df2a6cc 100644 (file)
@@ -1,7 +1,8 @@
 package FS::cust_credit;
 package FS::cust_credit;
+use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::reason_Mixin
+             FS::Record );
 
 use strict;
 
 use strict;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record );
 use vars qw( $conf $unsuspendauto $me $DEBUG
              $otaker_upgrade_kludge $ignore_empty_reasonnum
            );
 use vars qw( $conf $unsuspendauto $me $DEBUG
              $otaker_upgrade_kludge $ignore_empty_reasonnum
            );
@@ -11,7 +12,6 @@ use FS::UID qw( dbh );
 use FS::Misc qw(send_email);
 use FS::Record qw( qsearch qsearchs dbdef );
 use FS::CurrentUser;
 use FS::Misc qw(send_email);
 use FS::Record qw( qsearch qsearchs dbdef );
 use FS::CurrentUser;
-use FS::cust_main;
 use FS::cust_pkg;
 use FS::cust_refund;
 use FS::cust_credit_bill;
 use FS::cust_pkg;
 use FS::cust_refund;
 use FS::cust_credit_bill;
@@ -22,6 +22,7 @@ use FS::cust_event;
 use FS::agent;
 use FS::sales;
 use FS::cust_credit_void;
 use FS::agent;
 use FS::sales;
 use FS::cust_credit_void;
+use FS::cust_bill_pkg;
 use FS::upgrade_journal;
 
 $me = '[ FS::cust_credit ]';
 use FS::upgrade_journal;
 
 $me = '[ FS::cust_credit ]';
@@ -124,18 +125,34 @@ Creates a new credit.  To add the credit to the database, see L<"insert">.
 =cut
 
 sub table { 'cust_credit'; }
 =cut
 
 sub table { 'cust_credit'; }
-sub cust_linked { $_[0]->cust_main_custnum; } 
+sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum } 
 sub cust_unlinked_msg {
   my $self = shift;
   "WARNING: can't find cust_main.custnum ". $self->custnum.
   ' (cust_credit.crednum '. $self->crednum. ')';
 }
 
 sub cust_unlinked_msg {
   my $self = shift;
   "WARNING: can't find cust_main.custnum ". $self->custnum.
   ' (cust_credit.crednum '. $self->crednum. ')';
 }
 
-=item insert
+=item insert [ OPTION => VALUE ... ]
 
 Adds this credit to the database ("Posts" the credit).  If there is an error,
 returns the error, otherwise returns false.
 
 
 Adds this credit to the database ("Posts" the credit).  If there is an error,
 returns the error, otherwise returns false.
 
+Ooptions are passed as a list of keys and values.  Available options:
+
+=over 4
+
+=item reason_type
+
+L<FS::reason_type|Reason> type for newly-inserted reason
+
+=item cust_credit_source_bill_pkg
+
+An arrayref of
+L<FS::cust_credit_source_bill_pkg|FS::cust_credit_source_bilL_pkg> objects.
+They will have their crednum set and will be inserted along with this credit.
+
+=back
+
 =cut
 
 sub insert {
 =cut
 
 sub insert {
@@ -155,16 +172,23 @@ sub insert {
   my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
   my $old_balance = $cust_main->balance;
 
   my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
   my $old_balance = $cust_main->balance;
 
-  unless ($self->reasonnum) {
-    my $result = $self->reason( $self->getfield('reason'),
-                                exists($options{ 'reason_type' })
-                                  ? ('reason_type' => $options{ 'reason_type' })
-                                  : (),
-                              );
-    unless($result) {
+  if (!$self->reasonnum) {
+    my $reason_text = $self->get('reason')
+      or return "reason text or existing reason required";
+    my $reason_type = $options{'reason_type'}
+      or return "reason type required";
+
+    local $@;
+    my $reason = FS::reason->new_or_existing(
+      reason => $reason_text,
+      type   => $reason_type,
+      class  => 'R',
+    );
+    if ($@) {
       $dbh->rollback if $oldAutoCommit;
       $dbh->rollback if $oldAutoCommit;
-      return "failed to set reason for $me"; #: ". $dbh->errstr;
+      return "failed to set credit reason: $@";
     }
     }
+    $self->set('reasonnum', $reason->reasonnum);
   }
 
   $self->setfield('reason', '');
   }
 
   $self->setfield('reason', '');
@@ -175,6 +199,17 @@ sub insert {
     return "error inserting $self: $error";
   }
 
     return "error inserting $self: $error";
   }
 
+  if ( $options{'cust_credit_source_bill_pkg'} ) {
+    foreach my $ccsbr ( @{ $options{'cust_credit_source_bill_pkg'} } ) {
+      $ccsbr->crednum( $self->crednum );
+      $error = $ccsbr->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "error inserting $ccsbr: $error";
+      }
+    }
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   #false laziness w/ cust_pay::insert
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   #false laziness w/ cust_pay::insert
@@ -450,63 +485,6 @@ Returns the customer (see L<FS::cust_main>) for this credit.
 
 =cut
 
 
 =cut
 
-sub cust_main {
-  my $self = shift;
-  qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-}
-
-
-=item reason
-
-Returns the text of the associated reason (see L<FS::reason>) for this credit.
-
-=cut
-
-sub reason {
-  my ($self, $value, %options) = @_;
-  my $dbh = dbh;
-  my $reason;
-  my $typenum = $options{'reason_type'};
-
-  my $oldAutoCommit = $FS::UID::AutoCommit;  # this should already be in
-  local $FS::UID::AutoCommit = 0;            # a transaction if it matters
-
-  if ( defined( $value ) ) {
-    my $hashref = { 'reason' => $value };
-    $hashref->{'reason_type'} = $typenum if $typenum;
-    my $addl_from = "LEFT JOIN reason_type ON ( reason_type = typenum ) ";
-    my $extra_sql = " AND reason_type.class='R'"; 
-
-    $reason = qsearchs( { 'table'     => 'reason',
-                          'hashref'   => $hashref,
-                          'addl_from' => $addl_from,
-                          'extra_sql' => $extra_sql,
-                       } );
-
-    if (!$reason && $typenum) {
-      $reason = new FS::reason( { 'reason_type' => $typenum,
-                                  'reason' => $value,
-                                  'disabled' => 'Y', 
-                              } );
-      my $error = $reason->insert;
-      if ( $error ) {
-        warn "error inserting reason: $error\n";
-        $reason = undef;
-      }
-    }
-
-    $self->reasonnum($reason ? $reason->reasonnum : '') ;
-    warn "$me reason used in set mode with non-existant reason -- clearing"
-      unless $reason;
-  }
-  $reason = qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } );
-
-  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
-  ( $reason ? $reason->reason : '' ).
-  ( $self->addlinfo ? ' '.$self->addlinfo : '' );
-}
-
 # _upgrade_data
 #
 # Used by FS::Upgrade to migrate to a new database.
 # _upgrade_data
 #
 # Used by FS::Upgrade to migrate to a new database.
@@ -516,56 +494,9 @@ sub _upgrade_data {  # class method
 
   warn "$me upgrading $class\n" if $DEBUG;
 
 
   warn "$me upgrading $class\n" if $DEBUG;
 
-  if (defined dbdef->table($class->table)->column('reason')) {
-
-    warn "$me Checking for unmigrated reasons\n" if $DEBUG;
-
-    my @cust_credits = qsearch({ 'table'     => $class->table,
-                                 'hashref'   => {},
-                                 'extra_sql' => 'WHERE reason IS NOT NULL',
-                              });
-
-    if (scalar(grep { $_->getfield('reason') =~ /\S/ } @cust_credits)) {
-      warn "$me Found unmigrated reasons\n" if $DEBUG;
-      my $hashref = { 'class' => 'R', 'type' => 'Legacy' };
-      my $reason_type = qsearchs( 'reason_type', $hashref );
-      unless ($reason_type) {
-        $reason_type  = new FS::reason_type( $hashref );
-        my $error   = $reason_type->insert();
-        die "$class had error inserting FS::reason_type into database: $error\n"
-          if $error;
-      }
-
-      $hashref = { 'reason_type' => $reason_type->typenum,
-                   'reason' => '(none)'
-                 };
-      my $noreason = qsearchs( 'reason', $hashref );
-      unless ($noreason) {
-        $hashref->{'disabled'} = 'Y';
-        $noreason = new FS::reason( $hashref );
-        my $error  = $noreason->insert();
-        die "can't insert legacy reason '(none)' into database: $error\n"
-          if $error;
-      }
-
-      foreach my $cust_credit ( @cust_credits ) {
-        my $reason = $cust_credit->getfield('reason');
-        warn "Contemplating reason $reason\n" if $DEBUG > 1;
-        if ($reason =~ /\S/) {
-          $cust_credit->reason($reason, 'reason_type' => $reason_type->typenum)
-            or die "can't insert legacy reason $reason into database\n";
-        }else{
-          $cust_credit->reasonnum($noreason->reasonnum);
-        }
-
-        $cust_credit->setfield('reason', '');
-        my $error = $cust_credit->replace;
+  $class->_upgrade_reasonnum(%opts);
 
 
-        warn "*** WARNING: error replacing reason in $class ".
-             $cust_credit->crednum. ": $error ***\n"
-          if $error;
-      }
-    }
+  if (defined dbdef->table($class->table)->column('reason')) {
 
     warn "$me Ensuring existance of auto reasons\n" if $DEBUG;
 
 
     warn "$me Ensuring existance of auto reasons\n" if $DEBUG;
 
@@ -782,18 +713,15 @@ Example:
     'apply'             => 1, #0 leaves the credit unapplied
 
     #the credit
     'apply'             => 1, #0 leaves the credit unapplied
 
     #the credit
-    'newreasonnum'      => scalar($cgi->param('newreasonnum')),
-    'newreasonnum_type' => scalar($cgi->param('newreasonnumT')),
     map { $_ => scalar($cgi->param($_)) }
       #fields('cust_credit')  
     map { $_ => scalar($cgi->param($_)) }
       #fields('cust_credit')  
-      qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum
+      qw( custnum _date amount reasonnum addlinfo ), #pkgnum eventnum
 
   );
 
 =cut
 
 #maybe i should just be an insert with extra args instead of a class method
 
   );
 
 =cut
 
 #maybe i should just be an insert with extra args instead of a class method
-use FS::cust_bill_pkg;
 sub credit_lineitems {
   my( $class, %arg ) = @_;
   my $curuser = $FS::CurrentUser::CurrentUser;
 sub credit_lineitems {
   my( $class, %arg ) = @_;
   my $curuser = $FS::CurrentUser::CurrentUser;
@@ -829,26 +757,11 @@ sub credit_lineitems {
   #});
 
   my $error = '';
   #});
 
   my $error = '';
-  if ($arg{reasonnum} == -1) {
-
-    $error = 'Enter a new reason (or select an existing one)'
-      unless $arg{newreasonnum} !~ /^\s*$/;
-    my $reason = new FS::reason {
-                   'reason'      => $arg{newreasonnum},
-                   'reason_type' => $arg{newreasonnum_type},
-                 };
-    $error ||= $reason->insert;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "Error inserting reason: $error";
-    }
-    $arg{reasonnum} = $reason->reasonnum;
-  }
 
   my $cust_credit = new FS::cust_credit ( {
     map { $_ => $arg{$_} }
       #fields('cust_credit')
 
   my $cust_credit = new FS::cust_credit ( {
     map { $_ => $arg{$_} }
       #fields('cust_credit')
-      qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum
+      qw( custnum _date amount reasonnum addlinfo ), #pkgnum eventnum
   } );
   $error = $cust_credit->insert;
   if ( $error ) {
   } );
   $error = $cust_credit->insert;
   if ( $error ) {
@@ -919,14 +832,10 @@ sub credit_lineitems {
 
     # recalculate taxes with new amounts
     $taxlisthash{$invnum} ||= {};
 
     # recalculate taxes with new amounts
     $taxlisthash{$invnum} ||= {};
-    my $part_pkg = $cust_bill_pkg->part_pkg;
-    $cust_main->_handle_taxes( $part_pkg,
-                               $taxlisthash{$invnum},
-                               $cust_bill_pkg,
-                               $cust_bill_pkg->cust_pkg,
-                               $cust_bill_pkg->cust_bill->_date, #invoice time
-                               $cust_bill_pkg->cust_pkg->pkgpart,
-                             );
+    if ( $cust_bill_pkg->pkgnum or $cust_bill_pkg->feepart ) {
+      $cust_main->_handle_taxes( $taxlisthash{$invnum}, $cust_bill_pkg );
+    } # otherwise the item itself is a tax, and assume the caller knows
+      # what they're doing
   }
 
   ###
   }
 
   ###
@@ -1022,12 +931,12 @@ sub credit_lineitems {
 
       # we still have to deal with the possibility that the tax links don't
       # cover the whole amount of tax because of an incomplete upgrade...
 
       # we still have to deal with the possibility that the tax links don't
       # cover the whole amount of tax because of an incomplete upgrade...
-      if ($amount > 0) {
+      if ($amount > 0.005) {
         $cust_credit_bill{$invnum} += $amount;
         push @{ $cust_credit_bill_pkg{$invnum} },
           new FS::cust_credit_bill_pkg {
             'billpkgnum' => $tax_item->billpkgnum,
         $cust_credit_bill{$invnum} += $amount;
         push @{ $cust_credit_bill_pkg{$invnum} },
           new FS::cust_credit_bill_pkg {
             'billpkgnum' => $tax_item->billpkgnum,
-            'amount'     => $amount,
+            'amount'     => sprintf('%.2f', $amount),
             'setuprecur' => 'setup',
           };
 
             'setuprecur' => 'setup',
           };
 
@@ -1112,6 +1021,58 @@ sub credit_lineitems {
 
 =back
 
 
 =back
 
+=head1 SUBROUTINES
+
+=over 4
+
+=item process_batch_import
+
+=cut
+
+use List::Util qw( min );
+use FS::cust_bill;
+use FS::cust_credit_bill;
+sub process_batch_import {
+  my $job = shift;
+
+  my $opt = { 'table'   => 'cust_credit',
+              'params'  => [ '_date', 'credbatch' ],
+              'formats' => { 'simple' =>
+                               [ 'custnum', 'amount', 'reasonnum', 'invnum' ],
+                           },
+              'default_csv' => 1,
+              'postinsert_callback' => sub {
+                my $cust_credit = shift; #my ($cust_credit, $param ) = @_;
+
+                if ( $cust_credit->invnum ) {
+
+                  my $cust_bill = qsearchs('cust_bill', { invnum=>$cust_credit->invnum } );
+                  my $amount = min( $cust_credit->credited, $cust_bill->owed );
+    
+                  my $cust_credit_bill = new FS::cust_credit_bill ( {
+                    'crednum' => $cust_credit->crednum,
+                    'invnum'  => $cust_bill->invnum,
+                    'amount'  => $amount,
+                  } );
+                  my $error = $cust_credit_bill->insert;
+                  return '' unless $error;
+
+                }
+
+                #apply_payments_and_credits ?
+                $cust_credit->cust_main->apply_credits;
+
+                return '';
+
+              },
+            };
+
+  FS::Record::process_batch_import( $job, $opt, @_ );
+
+}
+
+=back
+
 =head1 BUGS
 
 The delete method.  The replace method.
 =head1 BUGS
 
 The delete method.  The replace method.