From 98ea15536afc6896cce08a41b877d6cb52444d14 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 16 Oct 2014 16:23:11 -0700 Subject: make package churn report actually show package churn, #7990 --- httemplate/graph/cust_pkg.cgi | 161 --------------------------------- httemplate/graph/cust_pkg.html | 159 ++++++++++++++++++++++++++++++++ httemplate/graph/elements/monthly.html | 16 ++-- httemplate/graph/elements/report.html | 6 +- httemplate/graph/report_cust_pkg.html | 8 +- 5 files changed, 175 insertions(+), 175 deletions(-) delete mode 100644 httemplate/graph/cust_pkg.cgi create mode 100644 httemplate/graph/cust_pkg.html (limited to 'httemplate/graph') diff --git a/httemplate/graph/cust_pkg.cgi b/httemplate/graph/cust_pkg.cgi deleted file mode 100644 index cdd95e10a..000000000 --- a/httemplate/graph/cust_pkg.cgi +++ /dev/null @@ -1,161 +0,0 @@ -<& elements/monthly.html, - 'title' => $agentname. 'Package Churn', - 'items' => \@items, - 'labels' => \@labels, - 'graph_labels' => \@labels, - 'colors' => \@colors, - 'links' => \@links, - 'params' => \@params, - 'agentnum' => $agentnum, - 'sprintf' => '%u', - 'disable_money' => 1, - 'remove_empty' => (scalar(@group_keys) > 1 ? 1 : 0), -&> -<%init> - -#XXX use a different ACL for package churn? -my $curuser = $FS::CurrentUser::CurrentUser; -die "access denied" - unless $curuser->access_right('Financial reports'); - -#false laziness w/money_time.cgi, cust_bill_pkg.cgi - -#XXX or virtual -my( $agentnum, $agent ) = ('', ''); -if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) { - $agentnum = $1; - $agent = qsearchs('agent', { 'agentnum' => $agentnum } ); - die "agentnum $agentnum not found!" unless $agent; -} - -my $agentname = $agent ? $agent->agent.' ' : ''; - -my @base_items = qw( setup_pkg susp_pkg cancel_pkg ); - -my %base_labels = ( - 'setup_pkg' => 'New orders', - 'susp_pkg' => 'Suspensions', -# 'unsusp' => 'Unsuspensions', - 'cancel_pkg' => 'Cancellations', -); - -my %base_colors = ( - 'setup_pkg' => '00cc00', #green - 'susp_pkg' => 'ff9900', #yellow - #'unsusp' => '', #light green? - 'cancel_pkg' => 'cc0000', #red ? 'ff0000' -); - -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 %filter_params = ( - # not agentnum, that's elsewhere - 'refnum' => [ $cgi->param('refnum') ], - 'classnum' => [ $cgi->param('classnum') ], - 'towernum' => [ $cgi->param('towernum') ], -); -if ( $cgi->param('zip') =~ /^(\w+)/ ) { - $filter_params{zip} = $1; -} -foreach my $link (values %base_links) { - foreach my $key (keys(%filter_params)) { - my $value = $filter_params{$key}; - if (ref($value)) { - $value = join(',', @$value); - } - $link->{'link'} .= "$key=$value;" if length($value); - } -} - - -# In order to keep this from being the same trainwreck as cust_bill_pkg.cgi, -# we allow ONE breakdown axis, besides the setup/susp/cancel inherent in -# the report. - -my $breakdown = $cgi->param('breakdown_by'); -my ($name_col, $table); -if ($breakdown eq 'classnum') { - $table = 'pkg_class'; - $name_col = 'classname'; -} elsif ($breakdown eq 'refnum') { - $table = 'part_referral'; - $name_col = 'referral'; -} elsif ($breakdown eq 'towernum') { - $table = 'tower'; - $name_col = 'towername'; -} elsif ($breakdown) { - die "unknown breakdown column '$breakdown'\n"; -} - -my @group_keys; -my @group_labels; -if ( $table ) { - my @groups; - if ( $cgi->param($breakdown) ) { - foreach my $key ($cgi->param($breakdown)) { - next if $key =~ /\D/; - push @groups, qsearch( $table, { $breakdown => $key }); - } - } else { - @groups = qsearch( $table ); - } - foreach (@groups) { - push @group_keys, $_->get($breakdown); - push @group_labels, $_->get($name_col); - } -} - -my (@items, @labels, @colors, @links, @params); -if (scalar(@group_keys) > 1) { - my $hue = 180; - foreach my $key (@group_keys) { - # this gives a decent level of contrast as long as there aren't too many - # result sets - my $scheme = Color::Scheme->new - ->scheme('triade') - ->from_hue($hue) - ->distance(0.5); - my $label = shift @group_labels; - my $i = 0; # item index - foreach (@base_items) { - # append the item - push @items, $_; - # and its parameters - push @params, [ - %filter_params, - $breakdown => $key - ]; - # and a label prefixed with the group label - push @labels, "$label - $base_labels{$_}"; - # and colors (?!) - push @colors, $scheme->colorset->[$i]->[1]; - # and links... - my %this_link = %{ $base_links{$_} }; - $this_link{link} .= "$breakdown=$key;"; - push @links, \%this_link; - $i++; - } #foreach (@base_items - $hue += 35; - } # foreach @group_keys -} else { - @items = @base_items; - @labels = @base_labels{@base_items}; - @colors = @base_colors{@base_items}; - @links = @base_links{@base_items}; - @params = map { [ %filter_params ] } @base_items; -} - - diff --git a/httemplate/graph/cust_pkg.html b/httemplate/graph/cust_pkg.html new file mode 100644 index 000000000..3b6552ba8 --- /dev/null +++ b/httemplate/graph/cust_pkg.html @@ -0,0 +1,159 @@ +<& elements/monthly.html, + 'title' => $agentname. 'Package Churn', + 'items' => \@items, + 'labels' => \@labels, + 'graph_labels' => \@labels, + 'colors' => \@colors, + 'links' => \@links, + 'params' => \@params, + 'agentnum' => $agentnum, + '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> + +#XXX use a different ACL for package churn? +my $curuser = $FS::CurrentUser::CurrentUser; +die "access denied" + unless $curuser->access_right('Financial reports'); + +#false laziness w/money_time.cgi, cust_bill_pkg.cgi + +#XXX or virtual +my( $agentnum, $agent ) = ('', ''); +if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) { + $agentnum = $1; + $agent = qsearchs('agent', { 'agentnum' => $agentnum } ); + die "agentnum $agentnum not found!" unless $agent; +} + +my $agentname = $agent ? $agent->agent.' ' : ''; + +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_pkg' => 'Unsuspensions', + 'cancel_pkg' => 'Cancellations', +); + +my %base_colors = ( + 'active_pkg' => '000000', #black + 'setup_pkg' => '00cc00', #green + 'susp_pkg' => 'ff9900', #yellow + 'unsusp_pkg' => '44ff44', #light green + 'cancel_pkg' => 'cc0000', #red +); + +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 + 'refnum' => [ $cgi->param('refnum') ], + 'classnum' => [ $cgi->param('classnum') ], + 'towernum' => [ $cgi->param('towernum') ], +); +if ( $cgi->param('zip') =~ /^(\w+)/ ) { + $filter_params{zip} = $1; +} +foreach my $link (values %base_links) { + foreach my $key (keys(%filter_params)) { + my $value = $filter_params{$key}; + if (ref($value)) { + $value = join(',', @$value); + } + $link .= "$key=$value;" if length($value); + } +} + + +# In order to keep this from being the same trainwreck as cust_bill_pkg.cgi, +# we allow ONE breakdown axis, besides the setup/susp/cancel inherent in +# the report. + +my $breakdown = $cgi->param('breakdown_by'); +my ($name_col, $table); +if ($breakdown eq 'classnum') { + $table = 'pkg_class'; + $name_col = 'classname'; +} elsif ($breakdown eq 'refnum') { + $table = 'part_referral'; + $name_col = 'referral'; +} elsif ($breakdown eq 'towernum') { + $table = 'tower'; + $name_col = 'towername'; +} elsif ($breakdown) { + die "unknown breakdown column '$breakdown'\n"; +} + +my @group_keys; +my @group_labels; +if ( $table ) { + my @groups; + if ( $cgi->param($breakdown) ) { + foreach my $key ($cgi->param($breakdown)) { + next if $key =~ /\D/; + push @groups, qsearch( $table, { $breakdown => $key }); + } + } else { + @groups = qsearch( $table ); + } + foreach (@groups) { + push @group_keys, $_->get($breakdown); + push @group_labels, $_->get($name_col); + } +} + +my (@items, @labels, @colors, @links, @params); +if (scalar(@group_keys) > 1) { + my $hue = 180; + foreach my $key (@group_keys) { + # this gives a decent level of contrast as long as there aren't too many + # result sets + my $scheme = Color::Scheme->new + ->scheme('triade') + ->from_hue($hue) + ->distance(0.5); + my $label = shift @group_labels; + my $i = 0; # item index + foreach (@base_items) { + # append the item + push @items, $_; + # and its parameters + push @params, [ + %filter_params, + $breakdown => $key + ]; + # and a label prefixed with the group label + push @labels, "$label - $base_labels{$_}"; + # and colors (?!) + push @colors, $scheme->colorset->[$i]->[1]; + # and links... + my $this_link = $base_links{$_}; + $this_link .= "$breakdown=$key;"; + push @links, $this_link; + $i++; + } #foreach (@base_items + $hue += 35; + } # foreach @group_keys +} else { + @items = @base_items; + @labels = @base_labels{@base_items}; + @colors = @base_colors{@base_items}; + @links = @base_links{@base_items}; + @params = map { [ %filter_params ] } @base_items; +} + +my $normalize = $cgi->param('normalize'); + + diff --git a/httemplate/graph/elements/monthly.html b/httemplate/graph/elements/monthly.html index 939f18a35..4b988f166 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 b3ba9ee22..cffc82816 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 1425ff089..0da5016a7 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' ) %> -
+ @@ -54,6 +54,12 @@ }, &> +<& /elements/tr-checkbox.html, + 'field' => 'normalize', + 'value' => 1, + 'label' => 'Show percentages' +&> +

-- cgit v1.2.1