diff options
author | Mark Wells <mark@freeside.biz> | 2014-10-16 16:23:11 -0700 |
---|---|---|
committer | Mark Wells <mark@freeside.biz> | 2014-10-16 16:23:11 -0700 |
commit | 98ea15536afc6896cce08a41b877d6cb52444d14 (patch) | |
tree | 55dc39e6c6fddc530adb764e3d1f4558feb2532f /FS | |
parent | 83f29f7300305134cb0c2e680ca7346927d4e9fe (diff) |
make package churn report actually show package churn, #7990
Diffstat (limited to 'FS')
-rw-r--r-- | FS/FS/Report/Table.pm | 126 | ||||
-rw-r--r-- | FS/FS/Report/Table/Monthly.pm | 43 | ||||
-rw-r--r-- | FS/FS/cust_pkg/Search.pm | 15 | ||||
-rw-r--r-- | FS/FS/h_Common.pm | 49 | ||||
-rw-r--r-- | FS/FS/h_cust_pkg.pm | 89 |
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; - |