keep package dates when changing packages and not crediting, from #16066
[freeside.git] / FS / FS / cust_pkg.pm
index 627a7fc..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
@@ -970,21 +1007,25 @@ sub uncancel {
     }
 
     my $svc_error = $svc_x->insert;
-    if ( $svc_error && $options{svc_fatal} ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $svc_error;
-    } else {
-      my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum });
-      if ( $cust_svc ) {
-        my $cs_error = $cust_svc->delete;
-        if ( $cs_error ) {
-          $dbh->rollback if $oldAutoCommit;
-          return $cs_error;
+    if ( $svc_error ) {
+      if ( $options{svc_fatal} ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $svc_error;
+      } else {
+        push @svc_errors, $svc_error;
+        # is this necessary? svc_Common::insert already deletes the 
+        # cust_svc if inserting svc_x fails.
+        my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum });
+        if ( $cust_svc ) {
+          my $cs_error = $cust_svc->delete;
+          if ( $cs_error ) {
+            $dbh->rollback if $oldAutoCommit;
+            return $cs_error;
+          }
         }
-      }
-    }
-    push @svc_errors, $svc_error if $svc_error;
-  }
+      } # svc_fatal
+    } # svc_error
+  } #foreach $h_cust_svc
 
   #these are pretty rare, but should handle them
   # - dsl_device (mac addresses)
@@ -1016,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
   ##
 
@@ -1104,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.
@@ -1114,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'; 
@@ -1264,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
@@ -1315,7 +1386,8 @@ sub credit_remaining {
 
 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 package, then unsuspends the package itself (clears the susp field and the
-adjourn field if it is in the past).
+adjourn field if it is in the past).  If the suspend reason includes an 
+unsuspension package, that package will be ordered.
 
 Available options are:
 
@@ -1345,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'; 
@@ -1419,6 +1496,9 @@ sub unsuspend {
 
   }
 
+  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'};
 
@@ -1445,6 +1525,33 @@ sub unsuspend {
     return $error;
   }
 
+  my $unsusp_pkg;
+
+  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.";
+    my $start_date = $self->cust_main->next_bill_date 
+      if $reason->unsuspend_hold;
+
+    if ( $part_pkg ) {
+      $unsusp_pkg = FS::cust_pkg->new({
+          'custnum'     => $self->custnum,
+          'pkgpart'     => $reason->unsuspend_pkgpart,
+          'start_date'  => $start_date,
+          'locationnum' => $self->locationnum,
+          # discount? probably not...
+      });
+      
+      $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
+    }
+
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
   if ( $conf->config('unsuspend_email_admin') ) {
  
     my $error = send_email(
@@ -1458,6 +1565,11 @@ sub unsuspend {
         'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
         'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
         ( map { "Service : $_\n" } @labels ),
+        ($unsusp_pkg ?
+          "An unsuspension fee was charged: ".
+            $unsusp_pkg->part_pkg->pkg_comment."\n"
+          : ''
+        ),
       ],
     );
 
@@ -1468,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
@@ -1633,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);
   }
 
@@ -1657,7 +1779,6 @@ sub change {
     locationnum  => ( $opt->{'locationnum'}                        ),
     %hash,
   };
-
   $error = $cust_pkg->insert( 'change' => 1 );
   if ($error) {
     $dbh->rollback if $oldAutoCommit;
@@ -1706,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,
@@ -1723,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;
@@ -2607,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
@@ -2705,7 +2892,7 @@ sub seconds_since_sqlradacct {
     grep {
       my $part_svc = $_->part_svc;
       $part_svc->svcdb eq 'svc_acct'
-        && scalar($part_svc->part_export('sqlradius'));
+        && scalar($part_svc->part_export_usage);
     } $self->cust_svc
   ) {
     $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
@@ -2737,7 +2924,7 @@ sub attribute_since_sqlradacct {
     grep {
       my $part_svc = $_->part_svc;
       $part_svc->svcdb eq 'svc_acct'
-        && scalar($part_svc->part_export('sqlradius'));
+        && scalar($part_svc->part_export_usage);
     } $self->cust_svc
   ) {
     $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
@@ -2834,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);
@@ -3083,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
@@ -3275,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
 
@@ -3449,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 )";
   }
 
@@ -3462,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'";
     }
   }
 
@@ -3591,24 +3821,38 @@ 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;
+  if ( $params->{'select_zip5'} ) {
+    my $zip = 'cust_location.zip';
+
+    $select = "DISTINCT substr($zip,1,5) as zip";
+    $orderby = "ORDER BY substr($zip,1,5)";
+    $count_query = "SELECT COUNT( DISTINCT substr($zip,1,5) )";
+  } else {
+    $select = join(', ',
+                         'cust_pkg.*',
+                         ( map "part_pkg.$_", qw( pkg freq ) ),
+                         'pkg_class.classname',
+                         'cust_main.custnum AS cust_main_custnum',
+                         FS::UI::Web::cust_sql_fields(
+                           $params->{'cust_fields'}
+                         ),
+                  );
+    $count_query = 'SELECT COUNT(*)';
+  }
 
-  my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
+  $count_query .= " FROM cust_pkg $addl_from $extra_sql";
 
   my $sql_query = {
     'table'       => 'cust_pkg',
     'hashref'     => {},
-    'select'      => join(', ',
-                                'cust_pkg.*',
-                                ( map "part_pkg.$_", qw( pkg freq ) ),
-                                'pkg_class.classname',
-                                'cust_main.custnum AS cust_main_custnum',
-                                FS::UI::Web::cust_sql_fields(
-                                  $params->{'cust_fields'}
-                                ),
-                     ),
+    'select'      => $select,
     'extra_sql'   => $extra_sql,
     'order_by'    => $orderby,
     'addl_from'   => $addl_from,
@@ -3864,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.