clarify interface difference between calc_setup and calc_recur: calc_setup takes...

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

diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
index 3adbc06..bf60784 100644 (file)
--- a/FS/FS/part_pkg.pm
+++ b/FS/FS/part_pkg.pm
@@ -232,6 +232,19 @@ sub insert {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 

+  if ( length($self->classnum) && $self->classnum !~ /^(\d+)$/ ) {
+    my $pkg_class = qsearchs('pkg_class', { 'classname' => $self->classnum } )
+                 || new FS::pkg_class { classname => $self->classnum };
+    unless ( $pkg_class->classnum ) {
+      my $error = $pkg_class->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
+    }
+    $self->classnum( $pkg_class->classnum );
+  }
+

   warn "  inserting part_pkg record" if $DEBUG;
   my $error = $self->SUPER::insert( $options{options} );
   if ( $error ) {
   warn "  inserting part_pkg record" if $DEBUG;
   my $error = $self->SUPER::insert( $options{options} );
   if ( $error ) {


@@ -401,19 +414,20 @@ I<bulk_skip>, I<provision_hold> and I<options>
 
 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
 values, the appropriate FS::pkg_svc records will be replaced.  I<hidden_svc>
 
 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
 values, the appropriate FS::pkg_svc records will be replaced.  I<hidden_svc>

-can be set to a hashref of svcparts and flag values ('Y' or '') to set the 
-'hidden' field in these records.  I<bulk_skip> and I<provision_hold> can be set 
-to a hashref of svcparts and flag values ('Y' or '') to set the respective field 
-in those records.
+can be set to a hashref of svcparts and flag values ('Y' or '') to set the
+'hidden' field in these records.  I<bulk_skip> and I<provision_hold> can be
+set to a hashref of svcparts and flag values ('Y' or '') to set the
+respective field in those records.

 
 

-If I<primary_svc> is set to the svcpart of the primary service, the appropriate
-FS::pkg_svc record will be updated.
+If I<primary_svc> is set to the svcpart of the primary service, the
+appropriate FS::pkg_svc record will be updated.

 
 

-If I<options> is set to a hashref, the appropriate FS::part_pkg_option records
-will be replaced.
+If I<options> is set to a hashref, the appropriate FS::part_pkg_option
+records will be replaced.

 
 If I<part_pkg_currency> is set to a hashref of options (with the keys as
 
 If I<part_pkg_currency> is set to a hashref of options (with the keys as

-option_CURRENCY), appropriate FS::part_pkg::currency records will be replaced.
+option_CURRENCY), appropriate FS::part_pkg::currency records will be
+replaced.

 
 =cut
 
 
 =cut
 


@@ -679,6 +693,25 @@ sub replace {
   '';
 }
 
   '';
 }
 

+sub validate_number {
+  my ($option, $valref) = @_;
+
+  $$valref = 0 unless $$valref;
+  return "Invalid $option"
+    unless ($$valref) = ($$valref =~ /^\s*(\d+)\s*$/);
+  return '';
+}
+
+sub validate_number_blank {
+  my ($option, $valref) = @_;
+
+  if ($$valref) {
+    return "Invalid $option"
+      unless ($$valref) = ($$valref =~ /^\s*(\d+)\s*$/);
+  }
+  return '';
+}
+

 =item check
 
 Checks all fields to make sure this is a valid package definition.  If
 =item check
 
 Checks all fields to make sure this is a valid package definition.  If


@@ -735,6 +768,7 @@ sub check {
     || $self->ut_floatn('pay_weight')
     || $self->ut_floatn('credit_weight')
     || $self->ut_numbern('taxproductnum')
     || $self->ut_floatn('pay_weight')
     || $self->ut_floatn('credit_weight')
     || $self->ut_numbern('taxproductnum')

+    || $self->ut_numbern('units_taxproductnum')

     || $self->ut_foreign_keyn('classnum',       'pkg_class', 'classnum')
     || $self->ut_foreign_keyn('addon_classnum', 'pkg_class', 'classnum')
     || $self->ut_foreign_keyn('taxproductnum',
     || $self->ut_foreign_keyn('classnum',       'pkg_class', 'classnum')
     || $self->ut_foreign_keyn('addon_classnum', 'pkg_class', 'classnum')
     || $self->ut_foreign_keyn('taxproductnum',


@@ -770,6 +804,46 @@ sub check {
   '';
 }
 
   '';
 }
 

+=item check_options
+
+Pass an I<$options> hashref that contains the values to be
+inserted or updated for any FS::part_pkg::MODULE.pm.
+
+For each key in I<$options>, validates the value by calling
+the 'validate' subroutine defined for that option e.g.
+FS::part_pkg::MODULE::plan_info()->{$KEY}->{validate}.  The
+option validation function is only called when the hashkey for
+that option exists in I<$options>.
+
+Then the module validation function is called, from
+FS::part_pkg::MODULE::plan_info()->{validate}
+
+Returns error message, or empty string if valid.
+
+Invoked by L</insert> and L</replace> via the equivalent
+methods in L<FS::option_Common>.
+
+=cut
+
+sub check_options {
+  my ($self,$options) = @_;
+  foreach my $option (keys %$options) {
+    if (exists $plans{ $self->plan }->{fields}->{$option}) {
+      if (exists($plans{$self->plan}->{fields}->{$option}->{'validate'})) {
+        # pass option name for use in error message
+        # pass a reference to the $options value, so it can be cleaned up
+        my $error = &{$plans{$self->plan}->{fields}->{$option}->{'validate'}}($option,\($options->{$option}));
+        return $error if $error;
+      }
+    } # else "option does not exist" error?
+  }
+  if (exists($plans{$self->plan}->{'validate'})) {
+    my $error = &{$plans{$self->plan}->{'validate'}}($options);
+    return $error if $error;
+  }
+  return '';
+}
+

 =item check_pkg_svc
 
 Checks pkg_svc records as a whole (for part_svc_link dependencies).
 =item check_pkg_svc
 
 Checks pkg_svc records as a whole (for part_svc_link dependencies).


@@ -1119,14 +1193,11 @@ sub pkg_svc {
 #      qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 
   my $opt = ref($_[0]) ? $_[0] : { @_ };
 #      qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 
   my $opt = ref($_[0]) ? $_[0] : { @_ };

-  my %pkg_svc = map  { $_->svcpart => $_ }
-                grep { $_->quantity }
-                qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
+  my %pkg_svc = map  { $_->svcpart => $_ } $self->_pkg_svc;

 
   unless ( $opt->{disable_linked} ) {
     foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
 
   unless ( $opt->{disable_linked} ) {
     foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {

-      my @pkg_svc = grep { $_->quantity }
-                    qsearch( 'pkg_svc', { pkgpart=>$dst_pkg->pkgpart } );
+      my @pkg_svc = $dst_pkg->_pkg_svc;

       foreach my $pkg_svc ( @pkg_svc ) {
         if ( $pkg_svc{$pkg_svc->svcpart} ) {
           my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
       foreach my $pkg_svc ( @pkg_svc ) {
         if ( $pkg_svc{$pkg_svc->svcpart} ) {
           my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;


@@ -1146,6 +1217,17 @@ sub pkg_svc {
 
 }
 
 
 }
 

+sub _pkg_svc {
+  my $self = shift;
+  grep { $_->quantity }
+    qsearch({
+      'select'    => 'pkg_svc.*, part_svc.*',
+      'table'     => 'pkg_svc',
+      'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )',
+      'hashref'   => { 'pkgpart' => $self->pkgpart },
+    });
+}
+

 =item svcpart [ SVCDB ]
 
 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
 =item svcpart [ SVCDB ]
 
 Returns the svcpart of the primary service definition (see L<FS::part_svc>)


@@ -1416,9 +1498,8 @@ sub option {
   my( $self, $opt, $ornull ) = @_;
 
   #cache: was pulled up in the original part_pkg query
   my( $self, $opt, $ornull ) = @_;
 
   #cache: was pulled up in the original part_pkg query

-  if ( $opt =~ /^(setup|recur)_fee$/ && defined($self->hashref->{"_$opt"}) ) {
-    return $self->hashref->{"_$opt"};
-  }
+  return $self->hashref->{"_opt_$opt"}
+    if exists $self->hashref->{"_opt_$opt"};

 
   cluck "$self -> option: searching for $opt" if $DEBUG;
   my $part_pkg_option =
 
   cluck "$self -> option: searching for $opt" if $DEBUG;
   my $part_pkg_option =


@@ -1690,6 +1771,19 @@ sub taxproduct_description {
   $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
 }
 
   $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
 }
 

+=item units_taxproduct
+
+Returns the L<FS::part_pkg_taxproduct> record used to report the taxable
+service units (usually phone lines) on this package.
+
+=cut
+
+sub units_taxproduct {
+  my $self = shift;
+  $self->units_taxproductnum
+    ? FS::part_pkg_taxproduct->by_key($self->units_taxproductnum)
+    : '';
+}

 
 =item tax_rates DATA_PROVIDER, GEOCODE, [ CLASS ]
 
 
 =item tax_rates DATA_PROVIDER, GEOCODE, [ CLASS ]
 


@@ -1786,7 +1880,7 @@ sub _rebless {
 
 =item calc_setup CUST_PKG START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
 
 
 =item calc_setup CUST_PKG START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
 

-=item calc_recur CUST_PKG START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
+=item calc_recur CUST_PKG START_DATE_SCALARREF DETAILS_ARRAYREF OPTIONS_HASHREF

 
 Calculates and returns the setup or recurring fees, respectively, for this
 package.  Implementation is in the FS::part_pkg:* module specific to this price
 
 Calculates and returns the setup or recurring fees, respectively, for this
 package.  Implementation is in the FS::part_pkg:* module specific to this price


@@ -1806,11 +1900,11 @@ Frequency override (for calc_recur)
 
 This option is filled in by the method rather than controlling its operation.
 It is an arrayref.  Applicable discounts will be added to the arrayref, as
 
 This option is filled in by the method rather than controlling its operation.
 It is an arrayref.  Applicable discounts will be added to the arrayref, as

-L<FS::cust_bill_pkg_discount|FS::cust_bill_pkg_discount records>.
+L<FS::cust_bill_pkg_discount> records.

 
 =item real_pkgpart
 
 
 =item real_pkgpart
 

-For package add-ons, is the base L<FS::part_pkg|package definition>, otherwise
+For package add-ons, is the base L<FS::part_pkg> package definition, otherwise

 no different than pkgpart.
 
 =item precommit_hooks
 no different than pkgpart.
 
 =item precommit_hooks


@@ -1834,7 +1928,7 @@ plan option prorate_defer_bill).
 =back
 
 Note: Don't calculate prices when not actually billing the package.  For that,
 =back
 
 Note: Don't calculate prices when not actually billing the package.  For that,

-see the L</base_setup|base_setup> and L</base_recur|base_recur> methods.
+see the L<FS::cust_pkg/base_setup> and L<FS::cust_pkg/base_recur> methods.

 
 =cut
 
 
 =cut
 


@@ -1876,13 +1970,27 @@ sub calc_remain { 0; }
 =item calc_units CUST_PKG
 
 This returns the number of provisioned svc_phone records, or, of the package
 =item calc_units CUST_PKG
 
 This returns the number of provisioned svc_phone records, or, of the package

-count_available_phones option is set, the number available to be provisoined
+count_available_phones option is set, the number available to be provisioned

 in the package.
 
 =cut
 
 in the package.
 
 =cut
 

-#fallback that returns 0 for old legacy packages with no plan
-sub calc_units  { 0; }
+sub calc_units {
+  my($self, $cust_pkg ) = @_;
+  my $count = 0;
+  if ( $self->option('count_available_phones', 1)) {
+    foreach my $pkg_svc ($cust_pkg->part_pkg->pkg_svc) {
+      if ($pkg_svc->part_svc->svcdb eq 'svc_phone') { # svc_pbx?
+        $count += $pkg_svc->quantity || 0;
+      }
+    }
+    $count *= $cust_pkg->quantity;
+  } else {
+    $count =
+      scalar(grep { $_->part_svc->svcdb eq 'svc_phone' } $cust_pkg->cust_svc);
+  }
+  $count;
+}

 
 #fallback for everything not based on flat.pm
 sub recur_temporality { 'upcoming'; }
 
 #fallback for everything not based on flat.pm
 sub recur_temporality { 'upcoming'; }


@@ -1974,6 +2082,18 @@ sub recur_margin_permonth {
   $self->base_recur_permonth(@_) - $self->recur_cost_permonth(@_);
 }
 
   $self->base_recur_permonth(@_) - $self->recur_cost_permonth(@_);
 }
 

+=item intro_end PACKAGE
+
+Takes an L<FS::cust_pkg> object.  If this plan has an introductory rate,
+returns the expected date the intro period will end. If there is no intro
+rate, returns zero.
+
+=cut
+
+sub intro_end {
+  0;
+}
+

 =item format OPTION DATA
 
 Returns data formatted according to the function 'format' described
 =item format OPTION DATA
 
 Returns data formatted according to the function 'format' described


@@ -2278,6 +2398,56 @@ sub queueable_upgrade {
       die $error if $error;
     }
   }
       die $error if $error;
     }
   }

+
+  # remove custom flag from one-time charge packages that were accidentally
+  # flagged as custom
+  $search = FS::Cursor->new({
+    'table'   => 'part_pkg',
+    'hashref' => { 'freq'   => '0',
+                   'custom' => 'Y',
+                   'family_pkgpart' => { op => '!=', value => '' },
+                 },
+    'addl_from' => ' JOIN
+  (select pkgpart from cust_pkg group by pkgpart having count(*) = 1)
+    AS singular_pkg USING (pkgpart)',
+  });
+  my @fields = grep {     $_ ne 'pkgpart'
+                      and $_ ne 'custom'
+                      and $_ ne 'disabled' } FS::part_pkg->fields;
+  PKGPART: while (my $part_pkg = $search->fetch) {
+    # can't merge the package back into its parent (too late for that)
+    # but we can remove the custom flag if it's not actually customized,
+    # i.e. nothing has been changed.
+
+    my $family_pkgpart = $part_pkg->family_pkgpart;
+    next PKGPART if $family_pkgpart == $part_pkg->pkgpart;
+    my $parent_pkg = FS::part_pkg->by_key($family_pkgpart);
+    foreach my $field (@fields) {
+      if ($part_pkg->get($field) ne $parent_pkg->get($field)) {
+        next PKGPART;
+      }
+    }
+    # options have to be identical too
+    # but links, FCC options, discount plans, and usage packages can't be
+    # changed through the "modify charge" UI, so skip them
+    my %newopt = $part_pkg->options;
+    my %oldopt = $parent_pkg->options;
+    OPTION: foreach my $option (keys %newopt) {
+      if (delete $newopt{$option} ne delete $oldopt{$option}) {
+        next PKGPART;
+      }
+    }
+    if (keys(%newopt) or keys(%oldopt)) {
+      next PKGPART;
+    }
+    # okay, now replace it
+    warn "Removing custom flag from part_pkg#".$part_pkg->pkgpart."\n";
+    $part_pkg->set('custom', '');
+    my $error = $part_pkg->replace;
+    die $error if $error;
+  } # $search->fetch
+
+  return;

 }
 
 =item curuser_pkgs_sql
 }
 
 =item curuser_pkgs_sql


@@ -2332,6 +2502,26 @@ sub _pkgs_sql {
 
 }
 
 
 }
 

+=item join_options_sql
+
+Returns an SQL fragment for JOINing the part_pkg_option records for this
+package's setup_fee and recur_fee (as setup_option and recur_option,
+respectively).  Useful for optimization.
+
+=cut
+
+sub join_options_sql {
+  #my $class = shift;
+  "
+    LEFT JOIN part_pkg_option AS setup_option
+      ON (     part_pkg.pkgpart = setup_option.pkgpart
+           AND setup_option.optionname = 'setup_fee' )
+    LEFT JOIN part_pkg_option AS recur_option
+      ON (     part_pkg.pkgpart = recur_option.pkgpart
+           AND recur_option.optionname = 'recur_fee' )
+  ";
+}
+

 =back
 
 =head1 SUBROUTINES
 =back
 
 =head1 SUBROUTINES


@@ -2445,4 +2635,3 @@ schema.html from the base documentation.
 =cut
 
 1;
 =cut
 
 1;

-