keep package dates when changing packages and not crediting, from #16066
[freeside.git] / FS / FS / cust_pkg.pm
index ba6120b..9c3d16a 100644 (file)
@@ -197,6 +197,15 @@ Previous locationnum
 
 =item waive_setup
 
+=item main_pkgnum
+
+The pkgnum of the package that this package is supplemental to, if any.
+
+=item pkglinknum
+
+The package link (L<FS::part_pkg_link>) that defines this supplemental
+package, if it is one.
+
 =back
 
 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
@@ -338,6 +347,9 @@ sub insert {
 
   if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
 
+    #this init stuff is still inefficient, but at least its limited to 
+    # the small number (any?) folks using ticket emailing on pkg order
+
     #eval '
     #  use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
     #  use RT;
@@ -591,7 +603,9 @@ replace methods.
 sub check {
   my $self = shift;
 
-  $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
+  if ( !$self->locationnum or $self->locationnum == -1 ) {
+    $self->set('locationnum', $self->cust_main->ship_locationnum);
+  }
 
   my $error = 
     $self->ut_numbern('pkgnum')
@@ -613,6 +627,8 @@ sub check {
     || $self->ut_numbern('agent_pkgid')
     || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ])
     || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ])
+    || $self->ut_foreign_keyn('main_pkgnum', 'cust_pkg', 'pkgnum')
+    || $self->ut_foreign_keyn('pkglinknum', 'part_pkg_link', 'pkglinknum')
   ;
   return $error if $error;
 
@@ -727,6 +743,11 @@ sub cancel {
   my( $self, %options ) = @_;
   my $error;
 
+  # pass all suspend/cancel actions to the main package
+  if ( $self->main_pkgnum and !$options{'from_main'} ) {
+    return $self->main_pkg->cancel(%options);
+  }
+
   my $conf = new FS::Conf;
 
   warn "cust_pkg::cancel called with options".
@@ -832,6 +853,14 @@ sub cancel {
     return $error;
   }
 
+  foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+    $error = $supp_pkg->cancel(%options, 'from_main' => 1);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error";
+    }
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   return '' if $date; #no errors
 
@@ -891,6 +920,9 @@ svc_fatal: service provisioning errors are fatal
 
 svc_errors: pass an array reference, will be filled in with any provisioning errors
 
+main_pkgnum: link the package as a supplemental package of this one.  For 
+internal use only.
+
 =cut
 
 sub uncancel {
@@ -899,6 +931,10 @@ sub uncancel {
   #in case you try do do $uncancel-date = $cust_pkg->uncacel 
   return '' unless $self->get('cancel');
 
+  if ( $self->main_pkgnum and !$options{'main_pkgnum'} ) {
+    return $self->main_pkg->uncancel(%options);
+  }
+
   ##
   # Transaction-alize
   ##
@@ -923,6 +959,7 @@ sub uncancel {
     bill            => ( $options{'bill'}      || $self->get('bill')      ),
     uncancel        => time,
     uncancel_pkgnum => $self->pkgnum,
+    main_pkgnum     => ($options{'main_pkgnum'} || ''),
     map { $_ => $self->get($_) } qw(
       custnum pkgpart locationnum
       setup
@@ -1020,6 +1057,20 @@ sub uncancel {
   }
 
   ##
+  # Uncancel any supplemental packages, and make them supplemental to the 
+  # new one.
+  ##
+
+  foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+    my $new_pkg;
+    $error = $supp_pkg->uncancel(%options, 'main_pkgnum' => $cust_pkg->pkgnum);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error";
+    }
+  }
+
+  ##
   # Finish
   ##
 
@@ -1108,6 +1159,9 @@ of final invoices or unused-time credits
 unsuspended.  This may be more convenient than calling C<unsuspend()>
 separately.
 
+=item from_main - allows a supplemental package to be suspended, rather
+than redirecting the method call to its main package.  For internal use.
+
 =back
 
 If there is an error, returns the error, otherwise returns false.
@@ -1118,6 +1172,11 @@ sub suspend {
   my( $self, %options ) = @_;
   my $error;
 
+  # pass all suspend/cancel actions to the main package
+  if ( $self->main_pkgnum and !$options{'from_main'} ) {
+    return $self->main_pkg->suspend(%options);
+  }
+
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 
@@ -1268,6 +1327,14 @@ sub suspend {
 
   }
 
+  foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+    $error = $supp_pkg->suspend(%options, 'from_main' => 1);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "suspending supplemental pkg#".$supp_pkg->pkgnum.": $error";
+    }
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   ''; #no errors
@@ -1350,6 +1417,11 @@ sub unsuspend {
   my( $self, %opt ) = @_;
   my $error;
 
+  # pass all suspend/cancel actions to the main package
+  if ( $self->main_pkgnum and !$opt{'from_main'} ) {
+    return $self->main_pkg->unsuspend(%opt);
+  }
+
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 
@@ -1424,7 +1496,8 @@ sub unsuspend {
 
   }
 
-  my $reason = $self->last_cust_pkg_reason('susp')->reason;
+  my $cust_pkg_reason = $self->last_cust_pkg_reason('susp');
+  my $reason = $cust_pkg_reason ? $cust_pkg_reason->reason : '';
 
   my %hash = $self->hash;
   my $inactive = time - $hash{'susp'};
@@ -1454,7 +1527,7 @@ sub unsuspend {
 
   my $unsusp_pkg;
 
-  if ( $reason->unsuspend_pkgpart ) {
+  if ( $reason && $reason->unsuspend_pkgpart ) {
     my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
       or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
                   " not found.";
@@ -1507,6 +1580,14 @@ sub unsuspend {
 
   }
 
+  foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+    $error = $supp_pkg->unsuspend(%opt, 'from_main' => 1);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "unsuspending supplemental pkg#".$supp_pkg->pkgnum.": $error";
+    }
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   ''; #no errors
@@ -1672,9 +1753,11 @@ sub change {
   # going to be credited for remaining time, don't keep setup, bill, 
   # or last_bill dates, and DO pass the flag to cancel() to credit 
   # the customer.
-  if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
+  if ( $opt->{'pkgpart'} 
+       and $opt->{'pkgpart'} != $self->pkgpart
+       and $self->part_pkg->option('unused_credit_change', 1) ) {
+    $unused_credit = 1;
     $keep_dates = 0;
-    $unused_credit = 1 if $self->part_pkg->option('unused_credit_change', 1);
     $hash{$_} = '' foreach qw(setup bill last_bill);
   }
 
@@ -1696,7 +1779,6 @@ sub change {
     locationnum  => ( $opt->{'locationnum'}                        ),
     %hash,
   };
-
   $error = $cust_pkg->insert( 'change' => 1 );
   if ($error) {
     $dbh->rollback if $oldAutoCommit;
@@ -1745,11 +1827,63 @@ sub change {
     }
   }
 
+  # Order any supplemental packages.
+  my $part_pkg = $cust_pkg->part_pkg;
+  my @old_supp_pkgs = $self->supplemental_pkgs;
+  my @new_supp_pkgs;
+  foreach my $link ($part_pkg->supp_part_pkg_link) {
+    my $old;
+    foreach (@old_supp_pkgs) {
+      if ($_->pkgpart == $link->dst_pkgpart) {
+        $old = $_;
+        $_->pkgpart(0); # so that it can't match more than once
+      }
+      last if $old;
+    }
+    # false laziness with FS::cust_main::Packages::order_pkg
+    my $new = FS::cust_pkg->new({
+        pkgpart       => $link->dst_pkgpart,
+        pkglinknum    => $link->pkglinknum,
+        custnum       => $self->custnum,
+        main_pkgnum   => $cust_pkg->pkgnum,
+        locationnum   => $cust_pkg->locationnum,
+        start_date    => $cust_pkg->start_date,
+        order_date    => $cust_pkg->order_date,
+        expire        => $cust_pkg->expire,
+        adjourn       => $cust_pkg->adjourn,
+        contract_end  => $cust_pkg->contract_end,
+        refnum        => $cust_pkg->refnum,
+        discountnum   => $cust_pkg->discountnum,
+        waive_setup   => $cust_pkg->waive_setup
+    });
+    if ( $old and $opt->{'keep_dates'} ) {
+      foreach (qw(setup bill last_bill)) {
+        $new->set($_, $old->get($_));
+      }
+    }
+    $error = $new->insert;
+    # transfer services
+    if ( $old ) {
+      $error ||= $old->transfer($new);
+    }
+    if ( $error and $error > 0 ) {
+      # no reason why this should ever fail, but still...
+      $error = "Unable to transfer all services from supplemental package ".
+        $old->pkgnum;
+    }
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+    push @new_supp_pkgs, $new;
+  }
+
   #Good to go, cancel old package.  Notify 'cancel' of whether to credit 
   #remaining time.
   #Don't allow billing the package (preceding period packages and/or 
   #outstanding usage) if we are keeping dates (i.e. location changing), 
   #because the new package will be billed for the same date range.
+  #Supplemental packages are also canceled here.
   $error = $self->cancel(
     quiet         => 1, 
     unused_credit => $unused_credit,
@@ -1762,7 +1896,9 @@ sub change {
 
   if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
     #$self->cust_main
-    my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
+    my $error = $cust_pkg->cust_main->bill( 
+      'pkg_list' => [ $cust_pkg, @new_supp_pkgs ]
+    );
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
       return $error;
@@ -2646,6 +2782,18 @@ sub cust_main {
   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 }
 
+=item balance
+
+Returns the balance for this specific package, when using
+experimental package balance.
+
+=cut
+
+sub balance {
+  my $self = shift;
+  $self->cust_main->balance_pkgnum( $self->pkgnum );
+}
+
 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
 
 =item cust_location
@@ -2873,7 +3021,8 @@ sub transfer {
   }
 
   foreach my $cust_svc ($self->cust_svc) {
-    if($target{$cust_svc->svcpart} > 0) {
+    if($target{$cust_svc->svcpart} > 0
+       or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
       $target{$cust_svc->svcpart}--;
       my $new = new FS::cust_svc { $cust_svc->hash };
       $new->pkgnum($dest_pkgnum);
@@ -3122,6 +3271,31 @@ sub cust_pkg_discount_active {
 
 =back
 
+=item supplemental_pkgs
+
+Returns a list of all packages supplemental to this one.
+
+=cut
+
+sub supplemental_pkgs {
+  my $self = shift;
+  qsearch('cust_pkg', { 'main_pkgnum' => $self->pkgnum });
+}
+
+=item main_pkg
+
+Returns the package that this one is supplemental to, if any.
+
+=cut
+
+sub main_pkg {
+  my $self = shift;
+  if ( $self->main_pkgnum ) {
+    return FS::cust_pkg->by_key($self->main_pkgnum);
+  }
+  return;
+}
+
 =head1 CLASS METHODS
 
 =over 4
@@ -3314,7 +3488,12 @@ specifies the user for agent virtualization
 
 =item fcc_line
 
- boolean selects packages containing fcc form 477 telco lines
+boolean; if true, returns only packages with more than 0 FCC phone lines.
+
+=item state, country
+
+Limit to packages with a service location in the specified state and country.
+For FCC 477 reporting, mostly.
 
 =back
 
@@ -3488,8 +3667,8 @@ sub search {
 
   if ( exists($params->{'censustract'}) ) {
     $params->{'censustract'} =~ /^([.\d]*)$/;
-    my $censustract = "cust_main.censustract = '$1'";
-    $censustract .= ' OR cust_main.censustract is NULL' unless $1;
+    my $censustract = "cust_location.censustract = '$1'";
+    $censustract .= ' OR cust_location.censustract is NULL' unless $1;
     push @where,  "( $censustract )";
   }
 
@@ -3501,10 +3680,22 @@ sub search {
      )
   {
     if ($1) {
-      push @where, "cust_main.censustract LIKE '$1%'";
+      push @where, "cust_location.censustract LIKE '$1%'";
     } else {
       push @where,
-        "( cust_main.censustract = '' OR cust_main.censustract IS NULL )";
+        "( cust_location.censustract = '' OR cust_location.censustract IS NULL )";
+    }
+  }
+
+  ###
+  # parse country/state
+  ###
+  for (qw(state country)) { # parsing rules are the same for these
+  if ( exists($params->{$_}) 
+    && uc($params->{$_}) =~ /^([A-Z]{2})$/ )
+    {
+      # XXX post-2.3 only--before that, state/country may be in cust_main
+      push @where, "cust_location.$_ = '$1'";
     }
   }
 
@@ -3630,9 +3821,10 @@ sub search {
 
   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
 
-  my $addl_from = 'LEFT JOIN cust_main USING ( custnum  ) '.
-                  'LEFT JOIN part_pkg  USING ( pkgpart  ) '.
-                  'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
+  my $addl_from = 'LEFT JOIN part_pkg  USING ( pkgpart  ) '.
+                  'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '.
+                  'LEFT JOIN cust_location USING ( locationnum ) '.
+                  FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg');
 
   my $select;
   my $count_query;
@@ -3641,13 +3833,6 @@ sub search {
 
     $select = "DISTINCT substr($zip,1,5) as zip";
     $orderby = "ORDER BY substr($zip,1,5)";
-    $addl_from .= 'LEFT JOIN cust_location ON (
-                     cust_location.locationnum = COALESCE(
-                                                   cust_pkg.locationnum,
-                                                   cust_main.ship_locationnum,
-                                                   cust_main.bill_locationnum
-                                                 )
-                                              )';
     $count_query = "SELECT COUNT( DISTINCT substr($zip,1,5) )";
   } else {
     $select = join(', ',
@@ -3923,11 +4108,25 @@ sub order {
                                       %hash,
                                     };
     $error = $cust_pkg->insert( 'change' => $change );
+    push @$return_cust_pkg, $cust_pkg;
+
+    foreach my $link ($cust_pkg->part_pkg->supp_part_pkg_link) {
+      my $supp_pkg = FS::cust_pkg->new({
+          custnum => $custnum,
+          pkgpart => $link->dst_pkgpart,
+          refnum  => $refnum,
+          main_pkgnum => $cust_pkg->pkgnum,
+          %hash,
+      });
+      $error ||= $supp_pkg->insert( 'change' => $change );
+      push @$return_cust_pkg, $supp_pkg;
+    }
+
     if ($error) {
       $dbh->rollback if $oldAutoCommit;
       return $error;
     }
-    push @$return_cust_pkg, $cust_pkg;
+
   }
   # $return_cust_pkg now contains refs to all of the newly 
   # created packages.