[freeside-commits] branch master updated. 98ea15536afc6896cce08a41b877d6cb52444d14
Mark Wells
mark at 420.am
Thu Oct 16 16:23:42 PDT 2014
The branch, master has been updated
via 98ea15536afc6896cce08a41b877d6cb52444d14 (commit)
from 83f29f7300305134cb0c2e680ca7346927d4e9fe (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 98ea15536afc6896cce08a41b877d6cb52444d14
Author: Mark Wells <mark at freeside.biz>
Date: Thu Oct 16 16:23:11 2014 -0700
make package churn report actually show package churn, #7990
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;
-
diff --git a/httemplate/graph/cust_pkg.cgi b/httemplate/graph/cust_pkg.html
similarity index 78%
rename from httemplate/graph/cust_pkg.cgi
rename to httemplate/graph/cust_pkg.html
index cdd95e1..3b6552b 100644
--- a/httemplate/graph/cust_pkg.cgi
+++ b/httemplate/graph/cust_pkg.html
@@ -7,9 +7,12 @@
'links' => \@links,
'params' => \@params,
'agentnum' => $agentnum,
- 'sprintf' => '%u',
+ 'sprintf' => ( $normalize ? '%0.1f%%' : '%u'),
+ 'normalize' => ( $normalize ? 0 : undef ),
'disable_money' => 1,
'remove_empty' => (scalar(@group_keys) > 1 ? 1 : 0),
+ 'nototal' => 1,
+ 'no_graph' => [ 1, 0, 0, 0, 0 ], # don't graph 'active'
&>
<%init>
@@ -30,36 +33,29 @@ if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) {
my $agentname = $agent ? $agent->agent.' ' : '';
-my @base_items = qw( setup_pkg susp_pkg cancel_pkg );
+my @base_items = qw( active_pkg setup_pkg susp_pkg unsusp_pkg cancel_pkg );
my %base_labels = (
+ 'active_pkg' => 'Active packages',
'setup_pkg' => 'New orders',
'susp_pkg' => 'Suspensions',
-# 'unsusp' => 'Unsuspensions',
+ 'unsusp_pkg' => 'Unsuspensions',
'cancel_pkg' => 'Cancellations',
);
my %base_colors = (
+ 'active_pkg' => '000000', #black
'setup_pkg' => '00cc00', #green
'susp_pkg' => 'ff9900', #yellow
- #'unsusp' => '', #light green?
- 'cancel_pkg' => 'cc0000', #red ? 'ff0000'
+ 'unsusp_pkg' => '44ff44', #light green
+ 'cancel_pkg' => 'cc0000', #red
);
-my %base_links = (
- 'setup_pkg' => { 'link' => "${p}search/cust_pkg.cgi?agentnum=$agentnum;",
- 'fromparam' => 'setup_begin',
- 'toparam' => 'setup_end',
- },
- 'susp_pkg' => { 'link' => "${p}search/cust_pkg.cgi?agentnum=$agentnum;",
- 'fromparam' => 'susp_begin',
- 'toparam' => 'susp_end',
- },
- 'cancel_pkg' => { 'link' => "${p}search/cust_pkg.cgi?agentnum=$agentnum;",
- 'fromparam' => 'cancel_begin',
- 'toparam' => 'cancel_end',
- },
-);
+my %base_links;
+foreach my $status (qw(active setup cancel susp unsusp)) {
+ $base_links{$status.'_pkg'} =
+ "${p}search/cust_pkg_churn.html?agentnum=$agentnum;status=$status;";
+}
my %filter_params = (
# not agentnum, that's elsewhere
@@ -76,7 +72,7 @@ foreach my $link (values %base_links) {
if (ref($value)) {
$value = join(',', @$value);
}
- $link->{'link'} .= "$key=$value;" if length($value);
+ $link .= "$key=$value;" if length($value);
}
}
@@ -143,9 +139,9 @@ if (scalar(@group_keys) > 1) {
# and colors (?!)
push @colors, $scheme->colorset->[$i]->[1];
# and links...
- my %this_link = %{ $base_links{$_} };
- $this_link{link} .= "$breakdown=$key;";
- push @links, \%this_link;
+ my $this_link = $base_links{$_};
+ $this_link .= "$breakdown=$key;";
+ push @links, $this_link;
$i++;
} #foreach (@base_items
$hue += 35;
@@ -158,4 +154,6 @@ if (scalar(@group_keys) > 1) {
@params = map { [ %filter_params ] } @base_items;
}
+my $normalize = $cgi->param('normalize');
+
</%init>
diff --git a/httemplate/graph/elements/monthly.html b/httemplate/graph/elements/monthly.html
index 939f18a..4b988f1 100644
--- a/httemplate/graph/elements/monthly.html
+++ b/httemplate/graph/elements/monthly.html
@@ -125,6 +125,7 @@ my %reportopts = (
'cust_classnum'=> $opt{'cust_classnum'},
'remove_empty' => $opt{'remove_empty'},
'doublemonths' => $opt{'doublemonths'},
+ 'normalize' => $opt{'normalize'},
);
warn Dumper({ 'REPORTOPTS' => \%reportopts }) if $opt{'debug'};
@@ -147,17 +148,12 @@ $col_labels = $data->{label} if $opt{'daily'};
my @colors;
my @graph_labels;
my @no_graph;
-if ( $opt{'remove_empty'} ) {
+#if ( $opt{'remove_empty'} ) { # no, always do this
# then filter out per-item things for collapsed rows
- foreach my $i (@{ $data->{'indices'} }) {
- push @colors, $opt{'colors'}[$i];
- push @graph_labels, $opt{'graph_labels'}[$i];
- push @no_graph, $opt{'no_graph'}[$i];
- }
-} else {
- @colors = @{ $opt{'colors'} };
- @graph_labels = @{ $opt{'graph_labels'} };
- @no_graph = @{ $opt{'no_graph'} || [] };
+foreach my $i (@{ $data->{'indices'} }) {
+ push @colors, $opt{'colors'}[$i];
+ push @graph_labels, $opt{'graph_labels'}[$i];
+ push @no_graph, $opt{'no_graph'}[$i];
}
my @links;
diff --git a/httemplate/graph/elements/report.html b/httemplate/graph/elements/report.html
index b3ba9ee..cffc828 100644
--- a/httemplate/graph/elements/report.html
+++ b/httemplate/graph/elements/report.html
@@ -108,11 +108,11 @@ any delimiter and linked from the elements in @data.
% foreach ( @{ shift( @data ) } ) {
% $total += $_;
% $bottom_total[$col-1] += $_ unless $opt{no_graph}[$row];
-% $worksheet->write($row, $col++, sprintf($sprintf, $_) );
+% $worksheet->write_number($row, $col++, sprintf($sprintf, $_) );
% }
% if ( !$opt{'nototal'} ) {
% $bottom_total[$col-1] += $total unless $opt{no_graph}[$row];
-% $worksheet->write($row, $col++, sprintf($sprintf, $total) );
+% $worksheet->write_number($row, $col++, sprintf($sprintf, $total) );
% }
% }
%
@@ -120,7 +120,7 @@ any delimiter and linked from the elements in @data.
% if ( $opt{'bottom_total'} ) {
% $row++;
% $worksheet->write($row, $col++, 'Total');
-% $worksheet->write($row, $col++, sprintf($sprintf, $_)) foreach @bottom_total;
+% $worksheet->write_number($row, $col++, sprintf($sprintf, $_)) foreach @bottom_total;
% }
%
% $workbook->close();# or die "Error creating .xls file: $!";
diff --git a/httemplate/graph/report_cust_pkg.html b/httemplate/graph/report_cust_pkg.html
index 1425ff0..0da5016 100644
--- a/httemplate/graph/report_cust_pkg.html
+++ b/httemplate/graph/report_cust_pkg.html
@@ -1,6 +1,6 @@
<% include('/elements/header.html', 'Package Churn Summary' ) %>
-<FORM ACTION="cust_pkg.cgi" METHOD="GET">
+<FORM ACTION="cust_pkg.html" METHOD="GET">
<TABLE BGCOLOR="#cccccc" CELLSPACING=0>
@@ -54,6 +54,12 @@
},
&>
+<& /elements/tr-checkbox.html,
+ 'field' => 'normalize',
+ 'value' => 1,
+ 'label' => 'Show percentages'
+&>
+
</TABLE>
<BR><INPUT TYPE="submit" VALUE="Display">
diff --git a/httemplate/search/cust_pkg_churn.html b/httemplate/search/cust_pkg_churn.html
new file mode 100644
index 0000000..0ab99aa
--- /dev/null
+++ b/httemplate/search/cust_pkg_churn.html
@@ -0,0 +1,186 @@
+<& elements/search.html,
+ 'title' => $title,
+ 'name' => 'packages',
+ 'query' => $sql_query,
+ 'count_query' => $count_query,
+ 'header' => [ emt('#'),
+ emt('Quantity'),
+ emt('Package'),
+ emt('Class'),
+ emt('Sales Person'),
+ emt('Ordered by'),
+ emt('Setup Fee'),
+ emt('Base Recur'),
+ emt('Freq.'),
+ emt('Setup'),
+ emt('Last bill'),
+ emt('Next bill'),
+ emt('Susp.'),
+ emt('Changed'),
+ emt('Cancel'),
+ #emt('Reason'), # hard to do this right
+ FS::UI::Web::cust_header(
+ $cgi->param('cust_fields')
+ ),
+ #emt('Services'), # even harder
+ ],
+ 'fields' => [
+ 'pkgnum',
+ 'quantity',
+ 'pkg',
+ 'classname',
+ 'salesperson',
+ 'otaker',
+ sub { sprintf( $money_char.'%.2f',
+ shift->part_pkg->option('setup_fee'),
+ );
+ },
+ sub { my $c = shift;
+ sprintf( $money_char.'%.2f',
+ $c->part_pkg->base_recur($c)
+ );
+ },
+ sub { FS::part_pkg::freq_pretty(shift); },
+
+ ( map { time_or_blank($_) }
+ qw( setup last_bill bill susp change_date cancel ) ),
+
+ \&FS::UI::Web::cust_fields,
+ ],
+ 'sort_fields' => [
+ 'cust_pkg.pkgnum',
+ ('') x 5, # can use as-is
+ ('') x 3, # can't use at all
+ # use the plain SQL column names
+ qw( setup last_bill bill susp change_date cancel ),
+ # cust_fields can take care of themselves
+ ],
+ 'color' => [
+ ('') x 15,
+ FS::UI::Web::cust_colors(),
+ ],
+ 'style' => [ ('') x 15,
+ FS::UI::Web::cust_styles() ],
+ 'size' => [ '', '', '', '', '-1' ],
+ 'align' => 'rrlcccrrlrrrrrr'. FS::UI::Web::cust_aligns(). 'r',
+ 'links' => [
+ $link,
+ $link,
+ $link,
+ ('') x 12,
+ ( map { $_ ne 'Cust. Status' ? $clink : '' }
+ FS::UI::Web::cust_header(
+ $cgi->param('cust_fields')
+ )
+ ),
+ ],
+&>
+<%once>
+my %title = (
+ 'active' => 'Active packages as of ',
+ 'setup' => 'Packages started between ',
+ 'cancel' => 'Packages canceled between ',
+ 'susp' => 'Packages suspended between ',
+ 'unsusp' => 'Packages unsuspended between ',
+);
+</%once>
+<%init>
+
+my $curuser = $FS::CurrentUser::CurrentUser;
+
+die "access denied"
+ unless $curuser->access_right('List packages');
+
+my $conf = new FS::Conf;
+my $money_char = $conf->config('money_char') || '$';
+
+my %search_hash = ();
+
+# pass a very limited set of parameters through
+#scalars
+for (qw( agentnum zip ))
+{
+ $search_hash{$_} = $cgi->param($_) if length($cgi->param($_));
+}
+
+#arrays / comma-separated lists
+for my $param (qw( pkgpart classnum refnum towernum )) {
+ my @values = map { split(',') } $cgi->param($param);
+ $search_hash{$param} = \@values if scalar(@values);
+}
+
+###
+# do not pass dates to FS::cust_pkg->search; use the special churn_fromwhere
+# logic.
+###
+
+my $pkg_query = FS::cust_pkg->search(\%search_hash);
+#warn Dumper $pkg_query;
+
+my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
+my $status = $cgi->param('status');
+
+my $title = emt($title{$status}) .
+ time2str('%b %o %Y', $beginning);
+if ($status ne 'active') {
+ $title .= emt(' to ') . time2str('%b %o %Y', $ending);
+}
+
+my ($from, @where) = FS::h_cust_pkg->churn_fromwhere_sql($status, $beginning, $ending);
+
+push @where, "freq != '0'";
+
+# split off the primary table name
+$from =~ s/^(\w+)(.*)$/$2/s;
+my $table = $1;
+
+# merge with $pkg_query
+$from .= ' ' . $pkg_query->{addl_from};
+
+my $extra_sql;
+if ($pkg_query->{extra_sql}) {
+ $extra_sql = $pkg_query->{extra_sql} . ' AND ';
+} else {
+ $extra_sql = 'WHERE ';
+}
+$extra_sql .= join(' AND ', @where);
+
+my $sql_query = {
+ 'table' => $table,
+ 'addl_from' => $from,
+ 'extra_sql' => $extra_sql,
+};
+warn (Dumper $sql_query) if $cgi->param('debug');
+
+my $count_query = "SELECT COUNT(*) FROM $table $from $extra_sql";
+
+my $show = $curuser->default_customer_view =~ /^(jumbo|packages)$/
+ ? ''
+ : ';show=packages';
+
+my $link = sub {
+ my $self = shift;
+ my $frag = 'cust_pkg'. $self->pkgnum; #hack for IE ignoring real #fragment
+ [ "${p}view/cust_main.cgi?custnum=".$self->custnum.
+ "$show;fragment=$frag#cust_pkg",
+ 'pkgnum'
+ ];
+};
+
+my $clink = sub {
+ my $cust_pkg = shift;
+ $cust_pkg->cust_main_custnum
+ ? [ "${p}view/cust_main.cgi?", 'custnum' ]
+ : '';
+};
+
+sub time_or_blank {
+ my $column = shift;
+ return sub {
+ my $record = shift;
+ my $value = $record->get($column); #mmm closures
+ $value ? time2str('%b %d %Y', $value ) : '';
+ };
+}
+
+</%init>
-----------------------------------------------------------------------
Summary of changes:
FS/FS/Report/Table.pm | 126 ++++++++-------
FS/FS/Report/Table/Monthly.pm | 43 ++++-
FS/FS/cust_pkg/Search.pm | 15 ++
FS/FS/h_Common.pm | 49 ++++++
FS/FS/h_cust_pkg.pm | 89 ++++++++++-
httemplate/graph/{cust_pkg.cgi => cust_pkg.html} | 44 +++--
httemplate/graph/elements/monthly.html | 16 +-
httemplate/graph/elements/report.html | 6 +-
httemplate/graph/report_cust_pkg.html | 8 +-
httemplate/search/cust_pkg_churn.html | 186 ++++++++++++++++++++++
10 files changed, 476 insertions(+), 106 deletions(-)
rename httemplate/graph/{cust_pkg.cgi => cust_pkg.html} (78%)
create mode 100644 httemplate/search/cust_pkg_churn.html
More information about the freeside-commits
mailing list