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

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

diff --git a/FS/FS/quotation_pkg.pm b/FS/FS/quotation_pkg.pm
index 33c761e..4c78be7 100644 (file)
--- a/FS/FS/quotation_pkg.pm
+++ b/FS/FS/quotation_pkg.pm
@@ -2,9 +2,10 @@ package FS::quotation_pkg;
 use base qw( FS::TemplateItem_Mixin FS::Record );
 
 use strict;
 use base qw( FS::TemplateItem_Mixin FS::Record );
 
 use strict;

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

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

+use List::Util qw(sum);

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -39,19 +40,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
 


@@ -59,8 +60,20 @@ 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.
+
+=item freq
+
+The length of the billing cycle. If zero it's a one-time charge; if any 
+other number it's that many months; other values are in L<FS::Misc::pkg_freqs>.

 
 =back
 
 
 =back
 


@@ -93,10 +106,64 @@ 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 ) {
+    warn "inserting discount #".$self->discountnum."\n";
+    $error = $self->insert_discount;
+    $error .= ' (setting discount)' 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, $self->quotation_pkg_tax) {
+    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;
+  }
+  
+  $self->quotation->estimate;
+}
+

 =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,


@@ -113,6 +180,8 @@ and replace methods.
 sub check {
   my $self = shift;
 
 sub check {
   my $self = shift;
 

+  my @freqs = ('', keys (%{ FS::Misc->pkg_freqs }));
+

   my $error = 
     $self->ut_numbern('quotationpkgnum')
     || $self->ut_foreign_key(  'quotationnum', 'quotation',    'quotationnum' )
   my $error = 
     $self->ut_numbern('quotationpkgnum')
     || $self->ut_foreign_key(  'quotationnum', 'quotation',    'quotationnum' )


@@ -121,8 +190,26 @@ 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('freq', \@freqs)

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

+
+  if ($self->locationnum eq '') {
+    # use the customer default
+    my $quotation = $self->quotation;
+    if ($quotation->custnum) {
+      $self->set('locationnum', $quotation->cust_main->ship_locationnum);
+    } elsif ($quotation->prospectnum) {
+      # use the first non-disabled location for that prospect
+      my $cust_location = qsearchs('cust_location',
+        { prospectnum => $quotation->prospectnum,
+          disabled => '' });
+      $self->set('locationnum', $cust_location->locationnum) if $cust_location;
+    } # else the quotation is invalid
+  }
+

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


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

-sub setup {
+=cut
+
+=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->waive_setup eq 'Y' || $self->{'_NO_SETUP_KLUDGE'};
-  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 $quotation_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,
+  } );
+
+  $quotation_pkg_discount->insert;

 }
 
 }
 

-sub recur {
+sub _item_discount {

   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($self)
-                                           : $part_pkg->option('recur_fee');
-  #XXX discounts
-  $recur *= $self->quantity if $self->quantity;
-  sprintf('%.2f', $recur);
+  my %options = @_;
+  my $setuprecur = $options{'setuprecur'};
+
+  # kind of silly treating this as multiple records, but it works, and will
+  # work if we allow multiple discounts at some point
+  my @pkg_discounts = $self->pkg_discount;
+  return if @pkg_discounts == 0;
+  
+  my @ext;
+  my $d = {
+    _is_discount    => 1,
+    description     => $self->mt('Discount'),
+    amount          => 0,
+    ext_description => \@ext,
+    # maybe should show quantity/unit discount?
+  };
+  foreach my $pkg_discount (@pkg_discounts) {
+    push @ext, $pkg_discount->description;
+    my $amount = $pkg_discount->get($setuprecur.'_amount');
+    $d->{amount} -= $amount;
+  }
+  $d->{amount} = sprintf('%.2f', $d->{amount} * $self->quantity);
+  
+  return $d;

 }
 
 }
 

-sub unitsetup {
+sub setup {

   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');
+  ($self->unitsetup - sum(0, map { $_->setup_amount } $self->pkg_discount))
+    * ($self->quantity || 1);

 
 

-  #XXX discounts
-  sprintf('%.2f', $setup);

 }
 
 }
 

-sub unitrecur {
+sub setup_tax {

   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);
+  sum(0, map { $_->setup_amount } $self->quotation_pkg_tax);
+}
+
+sub recur {
+  my $self = shift;
+  ($self->unitrecur - sum(0, map { $_->recur_amount } $self->pkg_discount))
+    * ($self->quantity || 1)
+}
+
+sub recur_tax {
+  my $self = shift;
+  sum(0, map { $_->recur_amount } $self->quotation_pkg_tax);

 }
 
 =item part_pkg_currency_option OPTIONNAME
 }
 
 =item part_pkg_currency_option OPTIONNAME


@@ -253,7 +375,7 @@ Returns the customer (L<FS::cust_main> object).
 
 sub cust_main {
   my $self = shift;
 
 sub cust_main {
   my $self = shift;

-  my $quotation = FS::quotation->by_key($self->quotationnum) or return '';
+  my $quotation = $self->quotation or return '';

   $quotation->cust_main;
 }
 
   $quotation->cust_main;
 }
 


@@ -265,14 +387,38 @@ Returns the prospect (L<FS::prospect_main> object).
 
 sub prospect_main {
   my $self = shift;
 
 sub prospect_main {
   my $self = shift;

-  my $quotation = FS::quotation->by_key($self->quotationnum) or return '';
+  my $quotation = $self->quotation or return '';

   $quotation->prospect_main;
 }
 
   $quotation->prospect_main;
 }
 

+sub tax_locationnum {
+  my $self = shift;
+  $self->locationnum;
+}
+
+sub _upgrade_data {
+  my $class = shift;
+  my @quotation_pkg_without_location =
+    qsearch( 'quotation_pkg', { locationnum => '' } );
+  if (@quotation_pkg_without_location) {
+    warn "setting default location on quotation_pkg records\n";
+    foreach my $quotation_pkg (@quotation_pkg_without_location) {
+      # check() will fix this
+      my $error = $quotation_pkg->replace;
+      if ($error) {
+        die "quotation #".$quotation_pkg->quotationnum.": $error\n";
+      }
+    }
+  }
+  '';
+}
+

 =back
 
 =head1 BUGS
 
 =back
 
 =head1 BUGS
 

+Doesn't support 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.