fix sprintf error, mostly #31273

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

diff --git a/FS/FS/quotation_pkg.pm b/FS/FS/quotation_pkg.pm
index cc45a85..28677d0 100644 (file)
--- a/FS/FS/quotation_pkg.pm
+++ b/FS/FS/quotation_pkg.pm
@@ -2,11 +2,12 @@ package FS::quotation_pkg;
 
 use strict;
 use base qw( FS::TemplateItem_Mixin FS::Record );
 
 use strict;
 use base qw( FS::TemplateItem_Mixin FS::Record );

-use FS::Record qw( qsearchs ); #qsearch
+use FS::Record qw( qsearchs dbh ); #qsearch

 use FS::part_pkg;
 use FS::cust_location;
 use FS::quotation;
 use FS::quotation_pkg_discount; #so its loaded when TemplateItem_Mixin needs it
 use FS::part_pkg;
 use FS::cust_location;
 use FS::quotation;
 use FS::quotation_pkg_discount; #so its loaded when TemplateItem_Mixin needs it

+use List::Util qw(sum);

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -41,19 +42,19 @@ primary key
 
 =item pkgpart
 
 
 =item pkgpart
 

-pkgpart
+pkgpart (L<FS::part_pkg>) of the package

 
 =item locationnum
 
 
 =item locationnum
 

-locationnum
+locationnum (L<FS::cust_location>) where the package will be in service

 
 =item start_date
 
 
 =item start_date
 

-start_date
+expected start date for the package, as a timestamp

 
 =item contract_end
 
 
 =item contract_end
 

-contract_end
+contract end date

 
 =item quantity
 
 
 =item quantity
 


@@ -61,8 +62,15 @@ quantity
 
 =item waive_setup
 
 
 =item waive_setup
 

-waive_setup
+'Y' to waive the setup fee

 
 

+=item unitsetup
+
+The amount per package that will be charged in setup/one-time fees.
+
+=item unitrecur
+
+The amount per package that will be charged per billing cycle.

 
 =back
 
 
 =back
 


@@ -95,10 +103,69 @@ sub discount_table        { 'quotation_pkg_discount'; }
 Adds this record to the database.  If there is an error, returns the error,
 otherwise returns false.
 
 Adds this record to the database.  If there is an error, returns the error,
 otherwise returns false.
 

+=cut
+
+sub insert {
+  my ($self, %options) = @_;
+
+  my $dbh = dbh;
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+
+  my $error = $self->SUPER::insert;
+
+  if ( !$error and $self->discountnum ) {
+    $error = $self->insert_discount;
+    $error .= ' (setting discount)' if $error;
+  }
+
+  # update $self and any discounts with their amounts
+  if ( !$error ) {
+    $error = $self->estimate;
+    $error .= ' (calculating charges)' if $error;
+  }
+
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  } else {
+    $dbh->commit if $oldAutoCommit;
+    return '';
+  }
+}
+

 =item delete
 
 Delete this record from the database.
 
 =item delete
 
 Delete this record from the database.
 

+=cut
+
+sub delete {
+  my $self = shift;
+
+  my $dbh = dbh;
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+
+  foreach ($self->quotation_pkg_discount) {
+    my $error = $_->delete;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error . ' (deleting discount)';
+    }
+  }
+
+  my $error = $self->SUPER::delete;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  } else {
+    $dbh->commit if $oldAutoCommit;
+    return '';
+  }
+  
+}
+

 =item replace OLD_RECORD
 
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 =item replace OLD_RECORD
 
 Replaces the OLD_RECORD with this one in the database.  If there is an error,


@@ -123,8 +190,11 @@ sub check {
     || $self->ut_numbern('start_date')
     || $self->ut_numbern('contract_end')
     || $self->ut_numbern('quantity')
     || $self->ut_numbern('start_date')
     || $self->ut_numbern('contract_end')
     || $self->ut_numbern('quantity')

+    || $self->ut_moneyn('unitsetup')
+    || $self->ut_moneyn('unitrecur')

     || $self->ut_enum('waive_setup', [ '', 'Y'] )
   ;
     || $self->ut_enum('waive_setup', [ '', 'Y'] )
   ;

+

   return $error if $error;
 
   $self->SUPER::check;
   return $error if $error;
 
   $self->SUPER::check;


@@ -140,48 +210,159 @@ sub desc {
   $self->part_pkg->pkg;
 }
 
   $self->part_pkg->pkg;
 }
 

-sub setup {
+=item estimate
+
+Update the quotation_pkg record with the estimated setup and recurring 
+charges for the package. Returns nothing on success, or an error message
+on failure.
+
+=cut
+
+sub estimate {

   my $self = shift;
   my $self = shift;

-  return '0.00' if $self->waive_setup eq 'Y' || $self->{'_NO_SETUP_KLUDGE'};

   my $part_pkg = $self->part_pkg;
   my $part_pkg = $self->part_pkg;

-  #my $setup = $part_pkg->can('base_setup') ? $part_pkg->base_setup
-  #                                         : $part_pkg->option('setup_fee');
-  my $setup = $part_pkg->option('setup_fee');
-  #XXX discounts
-  $setup *= $self->quantity if $self->quantity;
-  sprintf('%.2f', $setup);
+  my $quantity = $self->quantity || 1;
+  my ($unitsetup, $unitrecur);
+  # calculate base fees
+  if ( $self->waive_setup eq 'Y' || $self->{'_NO_SETUP_KLUDGE'} ) {
+    $unitsetup = '0.00';
+  } else {
+    $unitsetup = $part_pkg->base_setup;
+  }
+  if ( $self->{'_NO_RECUR_KLUDGE'} ) {
+    $unitrecur = '0.00';
+  } else {
+    $unitrecur = $part_pkg->base_recur;
+  }
+
+  #XXX add-on packages
+
+  $self->set('unitsetup', $unitsetup);
+  $self->set('unitrecur', $unitrecur);
+  my $error = $self->replace;
+  return $error if $error;
+
+  # semi-duplicates calc_discount
+  my $setup_discount = 0;
+  my $recur_discount = 0;
+
+  my %setup_discounts; # quotationpkgdiscountnum => amount
+  my %recur_discounts; # quotationpkgdiscountnum => amount
+
+  # XXX the order of applying discounts is ill-defined, which matters
+  # if there are percentage and amount discounts on the same package.
+  foreach my $pkg_discount ($self->quotation_pkg_discount) {
+
+    my $discount = $pkg_discount->discount;
+    my $this_setup_discount = 0;
+    my $this_recur_discount = 0;
+
+    if ( $discount->percent > 0 ) {
+
+      if ( $discount->setup ) {
+        $this_setup_discount = ($discount->percent * $unitsetup / 100);
+      }
+      $this_recur_discount = ($discount->percent * $unitrecur / 100);
+
+    } elsif ( $discount->amount > 0 ) {
+
+      my $discount_left = $discount->amount;
+      if ( $discount->setup ) {
+        if ( $discount_left > $unitsetup - $setup_discount ) {
+          # then discount the setup to zero
+          $discount_left -= $unitsetup - $setup_discount;
+          $this_setup_discount = $unitsetup - $setup_discount;
+        } else {
+          # not enough discount to fully cover the setup
+          $this_setup_discount = $discount_left;
+          $discount_left = 0;
+        }
+      }
+      # same logic for recur
+      if ( $discount_left > $unitrecur - $recur_discount ) {
+        $this_recur_discount = $unitrecur - $recur_discount;
+      } else {
+        $this_recur_discount = $discount_left;
+      }
+
+    }
+
+    # increment the total discountage
+    $setup_discount += $this_setup_discount;
+    $recur_discount += $this_recur_discount;
+    # and update the pkg_discount object
+    $pkg_discount->set('setup_amount', sprintf('%.2f', $setup_discount));
+    $pkg_discount->set('recur_amount', sprintf('%.2f', $recur_discount));
+    my $error = $pkg_discount->replace;
+    return $error if $error;
+  }

 
 

+  '';

 }
 
 }
 

-sub recur {
+=item insert_discount
+
+Associates this package with a discount (see L<FS::cust_pkg_discount>,
+possibly inserting a new discount on the fly (see L<FS::discount>). Properties
+of the discount will be taken from this object.
+
+=cut
+
+sub insert_discount {
+  #my ($self, %options) = @_;

   my $self = shift;
   my $self = shift;

-  return '0.00' if $self->{'_NO_RECUR_KLUDGE'};
-  my $part_pkg = $self->part_pkg;
-  my $recur = $part_pkg->can('base_recur') ? $part_pkg->base_recur
-                                           : $part_pkg->option('recur_fee');
-  #XXX discounts
-  $recur *= $self->quantity if $self->quantity;
-  sprintf('%.2f', $recur);
+
+  my $cust_pkg_discount = FS::quotation_pkg_discount->new( {
+    'quotationpkgnum' => $self->quotationpkgnum,
+    'discountnum'     => $self->discountnum,
+    #for the create a new discount case
+    '_type'           => $self->discountnum__type,
+    'amount'      => $self->discountnum_amount,
+    'percent'     => $self->discountnum_percent,
+    'months'      => $self->discountnum_months,
+    'setup'       => $self->discountnum_setup,
+  } );
+
+  $cust_pkg_discount->insert;

 }
 
 }
 

-sub unitsetup {
+sub _item_discount {

   my $self = shift;
   my $self = shift;

-  return '0.00' if $self->waive_setup eq 'Y' || $self->{'_NO_SETUP_KLUDGE'};
-  my $part_pkg = $self->part_pkg;
-  my $setup = $part_pkg->option('setup_fee');
+  my @pkg_discounts = $self->pkg_discount;
+  return if @pkg_discounts == 0;
+  
+  my @ext;
+  my $d = {
+    _is_discount    => 1,
+    description     => $self->mt('Discount'),
+    setup_amount    => 0,
+    recur_amount    => 0,
+    amount          => 0,
+    ext_description => \@ext,
+    # maybe should show quantity/unit discount?
+  };
+  foreach my $pkg_discount (@pkg_discounts) {
+    push @ext, $pkg_discount->description;
+    $d->{setup_amount} -= $pkg_discount->setup_amount;
+    $d->{recur_amount} -= $pkg_discount->recur_amount;
+  } 
+  $d->{setup_amount} *= $self->quantity || 1;
+  $d->{recur_amount} *= $self->quantity || 1;
+  $d->{amount} = $d->{setup_amount} + $d->{recur_amount};
+  
+  return $d;
+}

 
 

-  #XXX discounts
-  sprintf('%.2f', $setup);
+sub setup {
+  my $self = shift;
+  ($self->unitsetup - sum(map { $_->setup_amount } $self->pkg_discount))
+    * ($self->quantity || 1);

 }
 
 }
 

-sub unitrecur {
+sub recur {

   my $self = shift;
   my $self = shift;

-  return '0.00' if $self->{'_NO_RECUR_KLUDGE'};
-  my $part_pkg = $self->part_pkg;
-  my $recur = $part_pkg->can('base_recur') ? $part_pkg->base_recur
-                                           : $part_pkg->option('recur_fee');
-  #XXX discounts
-  sprintf('%.2f', $recur);
+  ($self->unitrecur - sum(map { $_->recur_amount } $self->pkg_discount))
+    * ($self->quantity || 1);

 }
 
 =item cust_bill_pkg_display [ type => TYPE ]
 }
 
 =item cust_bill_pkg_display [ type => TYPE ]


@@ -237,6 +418,8 @@ sub cust_main {
 
 =head1 BUGS
 
 
 =head1 BUGS
 

+Doesn't support taxes, fees, or add-on packages.
+

 =head1 SEE ALSO
 
 L<FS::Record>, schema.html from the base documentation.
 =head1 SEE ALSO
 
 L<FS::Record>, schema.html from the base documentation.