<& 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'), 'sprintf_fields' => $sprintf_fields, 'normalize' => ( $normalize ? 0 : undef ), 'disable_money' => 1, 'remove_empty' => (scalar(@group_keys) > 1 ? 1 : 0), 'nototal' => 1, 'no_graph' => [ 1, 0, 0, 0, 0, 1, 1 ], # don't graph 'active, total_revenue, total_revenue_diff' &> <%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 total_revenue_pkg total_revenue_diff ); my %base_labels = ( 'active_pkg' => 'Active packages', 'setup_pkg' => 'New orders', 'susp_pkg' => 'Suspensions', 'unsusp_pkg' => 'Unsuspensions', 'cancel_pkg' => 'Cancellations', 'total_revenue_pkg' => 'Total Revenue', 'total_revenue_diff' => 'Revenue Difference', ); my %base_colors = ( 'active_pkg' => '000000', #black 'setup_pkg' => '00cc00', #green 'susp_pkg' => 'ff9900', #yellow 'unsusp_pkg' => '44ff44', #light green 'cancel_pkg' => 'cc0000', #red 'total_revenue_pkg' => '0000ff', #blue 'total_revenue_diff' => '0000ff', #blue ); my $sprintf_fields = { 'total_revenue_pkg' => '%.2f', #format to 2 decimal places 'total_revenue_diff' => '%.2f', #format to 2 decimal places }; 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');