clean up existing packages when changing supplemental package defs, #31194
[freeside.git] / FS / FS / cust_pkg.pm
index a1f2cb1..ffcfd4e 100644 (file)
@@ -243,6 +243,39 @@ sub cust_unlinked_msg {
   ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
 }
 
+=item set_initial_timers
+
+If required by the package definition, sets any automatic expire, adjourn,
+or contract_end timers to some number of months after the start date 
+(or setup date, if the package has already been setup). If the package has
+a delayed setup fee after a period of "free days", will also set the 
+start date to the end of that period.
+
+=cut
+
+sub set_initial_timers {
+  my $self = shift;
+  my $part_pkg = $self->part_pkg;
+  foreach my $action ( qw(expire adjourn contract_end) ) {
+    my $months = $part_pkg->option("${action}_months",1);
+    if($months and !$self->get($action)) {
+      my $start = $self->start_date || $self->setup || time;
+      $self->set($action, $part_pkg->add_freq($start, $months) );
+    }
+  }
+
+  # if this package has "free days" and delayed setup fee, then
+  # set start date that many days in the future.
+  # (this should have been set in the UI, but enforce it here)
+  if ( $part_pkg->option('free_days',1)
+       && $part_pkg->option('delay_setup',1)
+     )
+  {
+    $self->start_date( $part_pkg->default_start_date );
+  }
+  '';
+}
+
 =item insert [ OPTION => VALUE ... ]
 
 Adds this billing item to the database ("Orders" the item).  If there is an
@@ -301,6 +334,9 @@ sub insert {
 
   if ( ! $options{'change'} ) {
 
+    # set order date to now
+    $self->order_date(time);
+
     # if the package def says to start only on the first of the month:
     if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
       my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
@@ -309,32 +345,17 @@ sub insert {
       $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
     }
 
-    # set up any automatic expire/adjourn/contract_end timers
-    # based on the start date
-    foreach my $action ( qw(expire adjourn contract_end) ) {
-      my $months = $part_pkg->option("${action}_months",1);
-      if($months and !$self->$action) {
-        my $start = $self->start_date || $self->setup || time;
-        $self->$action( $part_pkg->add_freq($start, $months) );
-      }
-    }
-
-    # if this package has "free days" and delayed setup fee, then
-    # set start date that many days in the future.
-    # (this should have been set in the UI, but enforce it here)
-    if (    ! $options{'change'}
-         && $part_pkg->option('free_days',1)
-         && $part_pkg->option('delay_setup',1)
-         #&& ! $self->start_date
-       )
-    {
-      $self->start_date( $part_pkg->default_start_date );
+    if ($self->susp eq 'now' or $part_pkg->start_on_hold) {
+      # if the package was ordered on hold:
+      # - suspend it
+      # - don't set the start date (it will be started manually)
+      $self->set('susp', $self->order_date);
+      $self->set('start_date', '');
+    } else {
+      # set expire/adjourn/contract_end timers, and free days, if appropriate
+      $self->set_initial_timers;
     }
-
-  }
-
-  # set order date unless this was previously a different package
-  $self->order_date(time) unless $self->change_pkgnum;
+  } # else this is a package change, and shouldn't have "new package" behavior
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -343,8 +364,6 @@ sub insert {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
-  $self->susp( $self->order_date ) if $self->susp eq 'now';
-
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
@@ -782,7 +801,9 @@ sub cancel {
   my $error;
 
   # pass all suspend/cancel actions to the main package
-  if ( $self->main_pkgnum and !$options{'from_main'} ) {
+  # (unless the pkglinknum has been removed, then the link is defunct and
+  # this package can be canceled on its own)
+  if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) {
     return $self->main_pkg->cancel(%options);
   }
 
@@ -890,6 +911,12 @@ sub cancel {
   }
   $hash{'change_custnum'} = $options{'change_custnum'};
 
+  # if this is a supplemental package that's lost its part_pkg_link, and it's
+  # being canceled for real, unlink it completely
+  if ( !$date and ! $self->pkglinknum ) {
+    $hash{main_pkgnum} = '';
+  }
+
   my $new = new FS::cust_pkg ( \%hash );
   $error = $new->replace( $self, options => { $self->options } );
   if ( $self->change_to_pkgnum ) {
@@ -1510,6 +1537,8 @@ sub unsuspend {
     return "";  # no error                     # complain instead?
   }
 
+  # handle the case of setting a future unsuspend (resume) date
+  # and do not continue to actually unsuspend the package
   my $date = $opt{'date'};
   if ( $date and $date > time ) { # return an error if $date <= time?
 
@@ -1533,6 +1562,11 @@ sub unsuspend {
   
   } #if $date 
 
+  if (!$self->setup) {
+    # then this package is being released from on-hold status
+    $self->set_initial_timers;
+  }
+
   my @labels = ();
 
   foreach my $cust_svc (
@@ -2757,7 +2791,7 @@ sub set_cust_pkg_detail {
 
 =item cust_event
 
-Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
+Returns the customer billing events (see L<FS::cust_event>) for this invoice.
 
 =cut
 
@@ -2774,19 +2808,41 @@ sub cust_event {
 
 =item num_cust_event
 
-Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
+Returns the number of customer billing events (see L<FS::cust_event>) for this package.
 
 =cut
 
 #false laziness w/cust_bill.pm
 sub num_cust_event {
   my $self = shift;
-  my $sql =
-    "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
-    "  WHERE tablenum = ? AND eventtable = 'cust_pkg'";
+  my $sql = "SELECT COUNT(*) ". $self->_from_cust_event_where;
+  $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref->[0];
+}
+
+=item exists_cust_event
+
+Returns true if there are customer billing events (see L<FS::cust_event>) for this package.  More efficient than using num_cust_event.
+
+=cut
+
+sub exists_cust_event {
+  my $self = shift;
+  my $sql = "SELECT 1 ". $self->_from_cust_event_where. " LIMIT 1";
+  my $row = $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref;
+  $row ? $row->[0] : '';
+}
+
+sub _from_cust_event_where {
+  #my $self = shift;
+  " FROM cust_event JOIN part_event USING ( eventpart ) ".
+  "  WHERE tablenum = ? AND eventtable = 'cust_pkg' ";
+}
+
+sub _prep_ex {
+  my( $self, $sql, @args ) = @_;
   my $sth = dbh->prepare($sql) or die  dbh->errstr. " preparing $sql"; 
-  $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
-  $sth->fetchrow_arrayref->[0];
+  $sth->execute(@args)         or die $sth->errstr. " executing $sql";
+  $sth;
 }
 
 =item cust_svc [ SVCPART ] (old, deprecated usage)
@@ -2818,7 +2874,7 @@ sub cust_svc_unsorted {
 sub cust_svc_unsorted_arrayref {
   my $self = shift;
 
-  return () unless $self->num_cust_svc(@_);
+  return [] unless $self->num_cust_svc(@_);
 
   my %opt = ();
   if ( @_ && $_[0] =~ /^\d+/ ) {
@@ -3182,7 +3238,7 @@ Class method that returns the list of possible status strings for packages
 tie my %statuscolor, 'Tie::IxHash', 
   'on hold'         => '7E0079', #purple!
   'not yet billed'  => '009999', #teal? cyan?
-  'one-time charge' => '000000',
+  'one-time charge' => '0000CC', #blue  #'000000',
   'active'          => '00CC00',
   'suspended'       => 'FF9900',
   'cancelled'       => 'FF0000',
@@ -3195,6 +3251,11 @@ sub statuses {
     keys %statuscolor;
 }
 
+sub statuscolors {
+  #my $self = shift;
+  \%statuscolor;
+}
+
 =item statuscolor
 
 Returns a hex triplet color string for this package's status.
@@ -3612,7 +3673,7 @@ sub transfer {
   return ('Package does not exist: '.$dest_pkgnum) unless $dest;
 
   foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
-    $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
+    $target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 );
   }
 
   foreach my $cust_svc ($dest->cust_svc) {
@@ -4325,13 +4386,15 @@ Valid parameters are
 
 =item agentnum
 
-=item magic
+=item status
 
-on hold, active, inactive (or one-time charge), suspended, cancel (or cancelled)
+on hold, active, inactive (or one-time charge), suspended, canceled (or cancelled)
 
-=item status
+=item magic
 
-on hold, active, inactive (or one-time charge), suspended, cancel (or cancelled)
+Equivalent to "status", except that "canceled"/"cancelled" will exclude 
+packages that were changed into a new package with the same pkgpart (i.e.
+location or quantity changes).
 
 =item custom
 
@@ -4418,6 +4481,21 @@ Limit to packages whose locations have geocodes.
 
 Limit to packages whose locations do not have geocodes.
 
+=item towernum
+
+Limit to packages associated with a svc_broadband, associated with a sector,
+associated with this towernum (or any of these, if it's an arrayref) (or NO
+towernum, if it's zero). This is an extreme niche case.
+
+=item 477part, 477rownum, date
+
+Limit to packages included in a specific row of one of the FCC 477 reports.
+'477part' is the section name (see L<FS::Report::FCC_477> methods), 'date'
+is the report as-of date (completely unrelated to the package setup/bill/
+other date fields), and '477rownum' is the row number of the report starting
+with zero. Row numbers have no inherent meaning, so this is useful only 
+for explaining a 477 report you've already run.
+
 =back
 
 =cut
@@ -4516,6 +4594,19 @@ sub search {
     push @where, FS::cust_pkg->cancelled_sql();
 
   }
+  
+  ### special case: "magic" is used in detail links from browse/part_pkg,
+  # where "cancelled" has the restriction "and not replaced with a package
+  # of the same pkgpart".  Be consistent with that.
+  ###
+
+  if ( $params->{'magic'} =~ /^cancell?ed$/ ) {
+    my $new_pkgpart = "SELECT pkgpart FROM cust_pkg AS cust_pkg_next ".
+                      "WHERE cust_pkg_next.change_pkgnum = cust_pkg.pkgnum";
+    # ...may not exist, if this was just canceled and not changed; in that
+    # case give it a "new pkgpart" that never equals the old pkgpart
+    push @where, "COALESCE(($new_pkgpart), 0) != cust_pkg.pkgpart";
+  }
 
   ###
   # parse package class
@@ -4559,6 +4650,21 @@ sub search {
   }
 
   ###
+  # parse refnum (advertising source)
+  ###
+
+  if ( exists($params->{'refnum'}) ) {
+    my @refnum;
+    if (ref $params->{'refnum'}) {
+      @refnum = @{ $params->{'refnum'} };
+    } else {
+      @refnum = ( $params->{'refnum'} );
+    }
+    my $in = join(',', grep /^\d+$/, @refnum);
+    push @where, "refnum IN($in)" if length $in;
+  }
+
+  ###
   # parse package report options
   ###
 
@@ -4644,7 +4750,7 @@ sub search {
   }
 
   ###
-  # parse country/state
+  # parse country/state/zip
   ###
   for (qw(state country)) { # parsing rules are the same for these
   if ( exists($params->{$_}) 
@@ -4654,6 +4760,9 @@ sub search {
       push @where, "cust_location.$_ = '$1'";
     }
   }
+  if ( exists($params->{zip}) ) {
+    push @where, "cust_location.zip = " . dbh->quote($params->{zip});
+  }
 
   ###
   # location_* flags
@@ -4726,6 +4835,9 @@ sub search {
       "NOT (".FS::cust_pkg->onetime_sql . ")";
   }
   else {
+    my $exclude_change_from = 0;
+    my $exclude_change_to = 0;
+
     foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) {
 
       next unless exists($params->{$field});
@@ -4741,6 +4853,27 @@ sub search {
 
       $orderby ||= "ORDER BY cust_pkg.$field";
 
+      if ( $field eq 'setup' ) {
+        $exclude_change_from = 1;
+      } elsif ( $field eq 'cancel' ) {
+        $exclude_change_to = 1;
+      } elsif ( $field eq 'change_date' ) {
+        # if we are given setup and change_date ranges, and the setup date
+        # falls in _both_ ranges, then include the package whether it was 
+        # a change or not
+        $exclude_change_from = 0;
+      }
+    }
+
+    if ($exclude_change_from) {
+      push @where, "change_pkgnum IS NULL";
+    }
+    if ($exclude_change_to) {
+      # a join might be more efficient here
+      push @where, "NOT EXISTS(
+        SELECT 1 FROM cust_pkg AS changed_to_pkg
+        WHERE cust_pkg.pkgnum = changed_to_pkg.change_pkgnum
+      )";
     }
   }
 
@@ -4780,6 +4913,60 @@ sub search {
   }
 
   ##
+  # parse the extremely weird 'towernum' param
+  ##
+
+  if ($params->{towernum}) {
+    my $towernum = $params->{towernum};
+    $towernum = [ $towernum ] if !ref($towernum);
+    my $in = join(',', grep /^\d+$/, @$towernum);
+    if (length $in) {
+      # inefficient, but this is an obscure feature
+      eval "use FS::Report::Table";
+      FS::Report::Table->_init_tower_pkg_cache; # probably does nothing
+      push @where, "EXISTS(
+      SELECT 1 FROM tower_pkg_cache
+      WHERE tower_pkg_cache.pkgnum = cust_pkg.pkgnum
+        AND tower_pkg_cache.towernum IN ($in)
+      )"
+    }
+  }
+
+  ##
+  # parse the 477 report drill-down options
+  ##
+
+  if ($params->{'477part'} =~ /^([a-z]+)$/) {
+    my $section = $1;
+    my ($date, $rownum, $agentnum);
+    if ($params->{'date'} =~ /^(\d+)$/) {
+      $date = $1;
+    }
+    if ($params->{'477rownum'} =~ /^(\d+)$/) {
+      $rownum = $1;
+    }
+    if ($params->{'agentnum'} =~ /^(\d+)$/) {
+      $agentnum = $1;
+    }
+    if ($date and defined($rownum)) {
+      my $report = FS::Report::FCC_477->report($section,
+        'date'      => $date,
+        'agentnum'  => $agentnum,
+        'detail'    => 1
+      );
+      my $row = $report->[$rownum]
+        or die "row $rownum is past the end of the report";
+      my $pkgnums = $row->[-1] || '0';
+        # '0' so that if there are no pkgnums (empty string) it will create
+        # a valid query that returns nothing
+      warn "PKGNUMS:\n$pkgnums\n\n"; # XXX debug
+
+      # and this overrides everything
+      @where = ( "cust_pkg.pkgnum IN($pkgnums)" );
+    } # else we're missing some params, ignore the whole business
+  }
+
+  ##
   # setup queries, links, subs, etc. for the search
   ##
 
@@ -5236,6 +5423,23 @@ sub _upgrade_data {  # class method
     my $sth = dbh->prepare($sql);
     $sth->execute or die $sth->errstr;
   }
+
+  # RT31194: supplemental package links that are deleted don't clean up 
+  # linked records
+  my @pkglinknums = qsearch({
+      'select'    => 'DISTINCT cust_pkg.pkglinknum',
+      'table'     => 'cust_pkg',
+      'addl_from' => ' LEFT JOIN part_pkg_link USING (pkglinknum) ',
+      'extra_sql' => ' WHERE cust_pkg.pkglinknum IS NOT NULL 
+                        AND part_pkg_link.pkglinknum IS NULL',
+  });
+  foreach (@pkglinknums) {
+    my $pkglinknum = $_->pkglinknum;
+    warn "cleaning part_pkg_link #$pkglinknum\n";
+    my $part_pkg_link = FS::part_pkg_link->new({pkglinknum => $pkglinknum});
+    my $error = $part_pkg_link->remove_linked;
+    die $error if $error;
+  }
 }
 
 =back