make package churn report actually show package churn, #7990

5 files changed, 253 insertions, 69 deletions

diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm
index 98f66e9..3a4a169 100644
--- a/FS/FS/Report/Table.pm
+++ b/FS/FS/Report/Table.pm
@@ -664,37 +664,10 @@ sub cust_bill_pkg_discount {
 
 }
 
-sub pkg_field_where {
-  my( $self, $field, $speriod, $eperiod, $agentnum, %opt ) = @_;
-  # someday this will use an aggregate query and return all the columns
-  # at once
-  # and I will drive a Tesla and have a live-in sushi chef who is also a 
-  # ninja bodyguard
-  my @where = (
-    $self->in_time_period_and_agent($speriod,
-                                    $eperiod,
-                                    $agentnum,
-                                    "cust_pkg.$field",
-                                   ),
-    $self->with_refnum(%opt),
-    $self->with_towernum(%opt),
-    $self->with_zip(%opt),
-    # can't use with_classnum here...
-  );
-  if ($opt{classnum}) {
-    my $classnum = $opt{classnum};
-    $classnum = [ $classnum ] if !ref($classnum);
-    @$classnum = grep /^\d+$/, @$classnum;
-    my $in = 'IN ('. join(',', @$classnum). ')';
-    push @where, "COALESCE(part_pkg.classnum, 0) $in" if scalar @$classnum;
-  }
+##### churn report #####
 
-  ' WHERE ' . join(' AND ', grep $_, @where);
-}
-
-=item setup_pkg: The number of packages with setup dates in the period.
-
-This excludes packages created by package changes. Options:
+=item active_pkg: The number of packages that were active at the start of 
+the period. The end date of the period is ignored. Options:
 
 - refnum: Limit to customers with this advertising source.
 - classnum: Limit to packages with this class.
@@ -704,61 +677,86 @@ This excludes packages created by package changes. Options:
 Except for zip, any of these can be an arrayref to allow multiple values for
 the field.
 
-=item susp_pkg: The number of suspended packages that were last suspended
-in the period. Options are as for setup_pkg.
+=item setup_pkg: The number of packages with setup dates in the period. This 
+excludes packages created by package changes. Options are as for active_pkg.
+
+=item susp_pkg: The number of packages that were suspended in the period
+(and not canceled).  Options are as for active_pkg.
+
+=item unsusp_pkg: The number of packages that were unsuspended in the period.
+Options are as for active_pkg.
 
 =item cancel_pkg: The number of packages with cancel dates in the period.
 Excludes packages that were canceled to be changed to a new package. Options
-are as for setup_pkg.
+are as for active_pkg.
 
 =cut
 
+sub active_pkg {
+  my $self = shift;
+  $self->churn_pkg('active', @_);
+}
+
 sub setup_pkg {
   my $self = shift;
-  my $sql = 'SELECT COUNT(*) FROM cust_pkg
-              LEFT JOIN part_pkg USING (pkgpart)
-              LEFT JOIN cust_main USING (custnum)'.
-              $self->pkg_field_where('setup', @_) .
-              ' AND change_pkgnum IS NULL';
+  $self->churn_pkg('setup', @_);
+}
 
-  $self->scalar_sql($sql);
+sub cancel_pkg {
+  my $self = shift;
+  $self->churn_pkg('cancel', @_);
 }
 
 sub susp_pkg {
-  # number of currently suspended packages that were suspended in the period
   my $self = shift;
-  my $sql = 'SELECT COUNT(*) FROM cust_pkg
-              LEFT JOIN part_pkg USING (pkgpart)
-              LEFT JOIN cust_main USING (custnum) '.
-              $self->pkg_field_where('susp', @_);
+  $self->churn_pkg('susp', @_);
+}
 
-  $self->scalar_sql($sql);
+sub unsusp_pkg {
+  my $self = shift;
+  $self->churn_pkg('unsusp', @_);
 }
 
-sub cancel_pkg {
-  # number of packages canceled in the period and not changed to another
-  # package
+sub churn_pkg {
   my $self = shift;
-  my $sql = 'SELECT COUNT(*) FROM cust_pkg
-              LEFT JOIN part_pkg USING (pkgpart)
-              LEFT JOIN cust_main USING (custnum)
-              LEFT JOIN cust_pkg changed_to_pkg ON(
-                cust_pkg.pkgnum = changed_to_pkg.change_pkgnum
-              ) '.
-              $self->pkg_field_where('cancel', @_) .
-              ' AND changed_to_pkg.pkgnum IS NULL';
+  my ( $status, $speriod, $eperiod, $agentnum, %opt ) = @_;
+  my ($from, @where) =
+    FS::h_cust_pkg->churn_fromwhere_sql( $status, $speriod, $eperiod);
+
+  push @where, $self->pkg_where(%opt, 'agentnum' => $agentnum);
+
+  my $sql = "SELECT COUNT(*) FROM $from
+    JOIN part_pkg ON (cust_pkg.pkgpart = part_pkg.pkgpart)
+    JOIN cust_main ON (cust_pkg.custnum = cust_main.custnum)";
+  $sql .= ' WHERE '.join(' AND ', @where)
+    if scalar(@where);
 
   $self->scalar_sql($sql);
 }
 
-#this is going to be harder..
-#sub unsusp_pkg {
-#  my( $self, $speriod, $eperiod, $agentnum ) = @_;
-#  $self->scalar_sql("
-#    SELECT COUNT(*) FROM h_cust_pkg
-#      WHERE 
-#
-#}
+sub pkg_where {
+  my $self = shift;
+  my %opt = @_;
+  my @where = (
+    "part_pkg.freq != '0'",
+    $self->with_refnum(%opt),
+    $self->with_towernum(%opt),
+    $self->with_zip(%opt),
+  );
+  if ($opt{agentnum} =~ /^(\d+)$/) {
+    push @where, "cust_main.agentnum = $1";
+  }
+  if ($opt{classnum}) {
+    my $classnum = $opt{classnum};
+    $classnum = [ $classnum ] if !ref($classnum);
+    @$classnum = grep /^\d+$/, @$classnum;
+    my $in = 'IN ('. join(',', @$classnum). ')';
+    push @where, "COALESCE(part_pkg.classnum, 0) $in" if scalar @$classnum;
+  }
+  @where;
+}
+
+##### end of churn report stuff #####
 
 sub in_time_period_and_agent {
   my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4);
diff --git a/FS/FS/Report/Table/Monthly.pm b/FS/FS/Report/Table/Monthly.pm
index b8e52ae..0ff7efd 100644
--- a/FS/FS/Report/Table/Monthly.pm
+++ b/FS/FS/Report/Table/Monthly.pm
@@ -88,6 +88,13 @@ hidden rows (due to C<remove_empty>) filtered out, which is the only
 reason to do this.  Now that we have C<indices> it's probably better to 
 use that.
 
+=item PROCESSING
+
+=item normalize: Set this to an item index to have all other items expressed
+as a percentage of that one.  That item will then be omitted from the output.
+If the normalization item is zero in some period, all the values in that
+period will be undef.
+
 =head1 RETURNED DATA
 
 The C<data> method runs the report and returns a hashref of the following:
@@ -180,7 +187,7 @@ sub data {
     my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear);
     push @{$data{eperiod}}, $eperiod;
 
-    my $col = 0;
+    my $col = 0; # a "column" here is the data corresponding to an item
     my @items = @{$self->{'items'}};
     my $i;
 
@@ -214,7 +221,30 @@ sub data {
   $data{'colors'}      = $self->{'colors'};
   $data{'links'}       = $self->{'links'} || [];
 
-  if ( !$self->{'cross_params'} and $self->{'remove_empty'} ) {
+  if ( defined $self->{'normalize'} ) {
+    my $norm_col = $self->{'normalize'};
+    my $norm_data = $data{data}->[$norm_col];
+
+    my $row = 0;
+    while ( exists $data{speriod}->[$row] ) {
+      my $col = 0;
+      while ( exists $data{items}->[$col ] ) {
+        if ( $col != $norm_col ) {
+          if ( $norm_data->[$row] == 0 ) {
+            $data{data}->[$col][$row] = undef;
+          } else {
+            $data{data}->[$col][$row] = 
+              ( $data{data}->[$col][$row] * 100 / $norm_data->[$row] );
+          }
+        }
+        $col++;
+      }
+      $row++;
+    }
+  }
+
+  if ( !$self->{'cross_params'} ) {
+    # remove unnecessary rows
 
     my $col = 0;
     #these need to get generalized, sheesh
@@ -228,6 +258,12 @@ sub data {
     my @indices = ();
     foreach my $item ( @{$self->{'items'}} ) {
 
+      # if remove_empty, then remove rows of zeroes
+      my $is_nonzero = scalar( grep { $_ != 0 } @{ $data{'data'}->[$col] });
+      next if ($self->{'remove_empty'} and $is_nonzero == 0);
+      # if normalizing, strip out the norm column
+      next if (defined($self->{'normalize'}) and $self->{'normalize'} == $col);
+
       if ( grep { $_ != 0 } @{$data{'data'}->[$col]} ) {
         push @newitems,  $data{'items'}->[$col];
         push @newlabels, $data{'item_labels'}->[$col];
@@ -236,7 +272,7 @@ sub data {
         push @newlinks,  $data{'links'}->[$col];
         push @indices,   $col;
       }
-
+    } continue {
       $col++;
     }
 
@@ -248,6 +284,7 @@ sub data {
     $data{'indices'}     = \@indices;
 
   }
+
   # clean up after ourselves
   #dbh->rollback;
   # leave in until development is finished, for diagnostics
diff --git a/FS/FS/cust_pkg/Search.pm b/FS/FS/cust_pkg/Search.pm
index 7719656..9cd1ff0 100644
--- a/FS/FS/cust_pkg/Search.pm
+++ b/FS/FS/cust_pkg/Search.pm
@@ -281,6 +281,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
   ###
 
diff --git a/FS/FS/h_Common.pm b/FS/FS/h_Common.pm
index ca13e1b..9b5ad09 100644
--- a/FS/FS/h_Common.pm
+++ b/FS/FS/h_Common.pm
@@ -110,6 +110,55 @@ sub sql_h_searchs {
   ($select, $where, $cacheobj, $as);
 }
 
+=item sql_diff START_TIMESTAMP, END_TIMESTAMP[, WHERE]
+
+Returns a complete SQL statement to find all records that were changed 
+between START_TIMESTAMP and END_TIMESTAMP. This finds only replacements,
+not new or deleted records.
+
+For each modified record, this will return I<one> row (not two rows as in
+the history table) with the primary key of the record, "old_historynum"
+(the historynum of the last modification before START_TIMESTAMP), and
+"new_historynum" (the last modification before END_TIMESTAMP). Join these
+back to the h_* table to retrieve the actual field values.
+
+Within the query, the last history records as of START and END are aliased
+as "old" and "new"; you can append a WHERE clause to take advantage of this.
+
+=cut
+
+sub sql_diff {
+  my $class = shift;
+  my $table = $class->table;
+  my ($real_table) = ($table =~ /^h_(\w+)$/);
+  my $pkey = dbdef->table($real_table)->primary_key;
+  my @fields = "FS::$real_table"->fields;
+
+  my ($sdate, $edate) = @_;
+  ($sdate, $edate) = ($edate, $sdate) if $edate < $sdate;
+
+  my @select = (
+    "old.$pkey",
+    'old.historynum   AS old_historynum',
+    'new.historynum   AS new_historynum',
+  );
+  my $new = 
+    "SELECT DISTINCT ON ($pkey) * FROM $table
+      WHERE history_action = 'replace_new'
+        AND history_date >= $sdate AND history_date <  $edate
+      ORDER BY $pkey ASC, history_date DESC";
+  my $old =
+    "SELECT DISTINCT ON ($pkey) * FROM $table
+      WHERE (history_action = 'replace_new' OR history_action = 'insert')
+        AND history_date <  $sdate
+      ORDER BY $pkey ASC, history_date DESC";
+
+  my $from = "($new) AS new JOIN ($old) AS old USING ($pkey)";
+
+  return "SELECT ".join(',', @select)." FROM $from";
+}
+
+
 =back
 
 =head1 BUGS
diff --git a/FS/FS/h_cust_pkg.pm b/FS/FS/h_cust_pkg.pm
index 99037c2..0c3db10 100644
--- a/FS/FS/h_cust_pkg.pm
+++ b/FS/FS/h_cust_pkg.pm
@@ -67,7 +67,7 @@ sub search {
 
   # make some adjustments
   $query->{'table'} = 'h_cust_pkg';
-  foreach (qw(select addl_from extra_sql count_query)) {
+  foreach (qw(select addl_from extra_sql count_query order_by)) {
     $query->{$_} =~ s/cust_pkg\b/h_cust_pkg/g;
     $query->{$_} =~ s/cust_main\b/h_cust_main/g;
   }
@@ -92,9 +92,95 @@ sub search {
   $query;
 }
 
+=item churn_fromwhere_sql STATUS, START, END
+
+Returns SQL fragments to do queries related to "package churn". STATUS
+is one of "active", "setup", "cancel", "susp", or "unsusp". These do NOT
+correspond directly to package statuses. START and END define a date range.
+
+- active: limit to packages that were active on START. END is ignored.
+- setup: limit to packages that were set up between START and END, except
+those created by package changes.
+- cancel: limit to packages that were canceled between START and END, except
+those changed into other packages.
+- susp: limit to packages that were suspended between START and END.
+- unsusp: limit to packages that were unsuspended between START and END.
+
+The logic of these may change in the future, especially with respect to 
+package changes. Watch this space.
+
+Returns a list of:
+- a fragment usable as a FROM clause (without the keyword FROM), in which
+  the package table is named or aliased to 'cust_pkg'
+- one or more conditions to include in the WHERE clause
+
+=cut
+
+sub churn_fromwhere_sql {
+  my ($self, $status, $speriod, $eperiod) = @_;
+
+  my ($from, @where);
+  if ( $status eq 'active' ) {
+    # for all packages that were setup before $speriod, find the pkgnum
+    # and the most recent update of the package before $speriod
+    my $setup_before = "SELECT DISTINCT ON (pkgnum) pkgnum, historynum
+      FROM h_cust_pkg
+      WHERE setup < $speriod
+        AND history_date < $speriod
+        AND history_action IN('insert', 'replace_new')
+      ORDER BY pkgnum ASC, history_date DESC";
+    # for each of these, exclude if the package was suspended or canceled
+    # in the most recent update before $speriod
+    $from = "h_cust_pkg AS cust_pkg
+      JOIN ($setup_before) AS setup_before USING (historynum)";
+    @where = ( 'susp IS NULL', 'cancel IS NULL' );
+  } elsif ( $status eq 'setup' ) {
+    # the simple case, because packages should only get set up once
+    # (but exclude those that were created due to a package change)
+    # XXX or should we include if they were created by a pkgpart change?
+    $from = "cust_pkg";
+    @where = (
+      "setup >= $speriod",
+      "setup < $eperiod",
+      "change_pkgnum IS NULL"
+    );
+  } elsif ( $status eq 'cancel' ) {
+    # also simple, because packages should only be canceled once
+    # (exclude those that were canceled due to a package change)
+    $from = "cust_pkg";
+    @where = (
+      "cust_pkg.cancel >= $speriod",
+      "cust_pkg.cancel < $eperiod",
+      "NOT EXISTS(SELECT 1 FROM cust_pkg AS changed_to_pkg ".
+        "WHERE cust_pkg.pkgnum = changed_to_pkg.change_pkgnum)",
+    );
+  } elsif ( $status eq 'susp' ) {
+    # more complicated
+    # find packages that were changed from susp = null to susp != null
+    my $susp_during = $self->sql_diff($speriod, $eperiod) .
+      ' WHERE old.susp IS NULL AND new.susp IS NOT NULL';
+    $from = "h_cust_pkg AS cust_pkg
+      JOIN ($susp_during) AS susp_during
+        ON (susp_during.new_historynum = cust_pkg.historynum)";
+    @where = ( 'cust_pkg.cancel IS NULL' );
+  } elsif ( $status eq 'unsusp' ) {
+    # similar to 'susp'
+    my $unsusp_during = $self->sql_diff($speriod, $eperiod) .
+      ' WHERE old.susp IS NOT NULL AND new.susp IS NULL';
+    $from = "h_cust_pkg AS cust_pkg
+      JOIN ($unsusp_during) AS unsusp_during
+        ON (unsusp_during.new_historynum = cust_pkg.historynum)";
+    @where = ( 'cust_pkg.cancel IS NULL' );
+  } else {
+    die "'$status' makes no sense";
+  }
+  return ($from, @where);
+}
 
 =head1 BUGS
 
+churn_fromwhere_sql fails on MySQL.
+
 =head1 SEE ALSO
 
 L<FS::cust_pkg>,  L<FS::h_Common>, L<FS::Record>, schema.html from the base
@@ -104,4 +190,3 @@ documentation.
 
 1;
 
-