diff options
Diffstat (limited to 'httemplate/graph/cust_pkg.cgi')
| -rw-r--r-- | httemplate/graph/cust_pkg.cgi | 134 |
1 files changed, 116 insertions, 18 deletions
diff --git a/httemplate/graph/cust_pkg.cgi b/httemplate/graph/cust_pkg.cgi index 21ce07d21..cdd95e10a 100644 --- a/httemplate/graph/cust_pkg.cgi +++ b/httemplate/graph/cust_pkg.cgi @@ -1,20 +1,22 @@ -<% include('elements/monthly.html', - 'title' => $agentname. 'Package Churn', - 'items' => \@items, - 'labels' => \%label, - 'graph_labels' => \%graph_label, - 'colors' => \%color, - 'links' => \%link, - 'agentnum' => $agentnum, - 'sprintf' => '%u', - 'disable_money' => 1, - ) -%> +<& 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 $FS::CurrentUser::CurrentUser->access_right('Financial reports'); + unless $curuser->access_right('Financial reports'); #false laziness w/money_time.cgi, cust_bill_pkg.cgi @@ -28,24 +30,23 @@ if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) { my $agentname = $agent ? $agent->agent.' ' : ''; -my @items = qw( setup_pkg susp_pkg cancel_pkg ); +my @base_items = qw( setup_pkg susp_pkg cancel_pkg ); -my %label = ( +my %base_labels = ( 'setup_pkg' => 'New orders', 'susp_pkg' => 'Suspensions', # 'unsusp' => 'Unsuspensions', 'cancel_pkg' => 'Cancellations', ); -my %graph_label = %label; -my %color = ( +my %base_colors = ( 'setup_pkg' => '00cc00', #green 'susp_pkg' => 'ff9900', #yellow #'unsusp' => '', #light green? 'cancel_pkg' => 'cc0000', #red ? 'ff0000' ); -my %link = ( +my %base_links = ( 'setup_pkg' => { 'link' => "${p}search/cust_pkg.cgi?agentnum=$agentnum;", 'fromparam' => 'setup_begin', 'toparam' => 'setup_end', @@ -60,4 +61,101 @@ my %link = ( }, ); +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; +} + </%init> |