Merge branch 'master' of git.freeside.biz:/home/git/freeside

[freeside.git] / FS / FS / cust_credit.pm

diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index 3f8d57c..df2a6cc 100644 (file)
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -1,5 +1,6 @@
 package FS::cust_credit;
 package FS::cust_credit;

-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record );
+use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::reason_Mixin
+             FS::Record );

 
 use strict;
 use vars qw( $conf $unsuspendauto $me $DEBUG
 
 use strict;
 use vars qw( $conf $unsuspendauto $me $DEBUG


@@ -21,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 ]';


@@ -130,11 +132,27 @@ sub cust_unlinked_msg {
   ' (cust_credit.crednum '. $self->crednum. ')';
 }
 
   ' (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 {


@@ -154,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', '');


@@ -174,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


@@ -447,57 +483,8 @@ sub credited {
 
 Returns the customer (see L<FS::cust_main>) for this credit.
 
 
 Returns the customer (see L<FS::cust_main>) for this credit.
 

-=item reason
-
-Returns the text of the associated reason (see L<FS::reason>) for this credit.
-

 =cut
 
 =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.


@@ -507,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;
 


@@ -773,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;


@@ -820,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 ) {


@@ -910,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

   }
 
   ###
   }
 
   ###


@@ -1013,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',
           };
 


@@ -1118,7 +1036,7 @@ sub process_batch_import {
   my $job = shift;
 
   my $opt = { 'table'   => 'cust_credit',
   my $job = shift;
 
   my $opt = { 'table'   => 'cust_credit',

-              'params'  => [ 'credbatch' ],
+              'params'  => [ '_date', 'credbatch' ],

               'formats' => { 'simple' =>
                                [ 'custnum', 'amount', 'reasonnum', 'invnum' ],
                            },
               'formats' => { 'simple' =>
                                [ 'custnum', 'amount', 'reasonnum', 'invnum' ],
                            },