1 <& elements/monthly.html,
2 'title' => $agentname. 'Package Churn',
5 'graph_labels' => \@labels,
9 'agentnum' => $agentnum,
10 'sprintf' => ( $normalize ? '%0.1f%%' : '%u'),
11 'sprintf_fields' => $sprintf_fields,
12 'normalize' => ( $normalize ? 0 : undef ),
14 'remove_empty' => (scalar(@group_keys) > 1 ? 1 : 0),
16 'no_graph' => [ 1, 0, 0, 0, 0, 1, 1 ], # don't graph 'active, total_revenue, total_revenue_diff'
20 #XXX use a different ACL for package churn?
21 my $curuser = $FS::CurrentUser::CurrentUser;
23 unless $curuser->access_right('Financial reports');
25 #false laziness w/money_time.cgi, cust_bill_pkg.cgi
28 my( $agentnum, $agent ) = ('', '');
29 if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) {
31 $agent = qsearchs('agent', { 'agentnum' => $agentnum } );
32 die "agentnum $agentnum not found!" unless $agent;
35 my $agentname = $agent ? $agent->agent.' ' : '';
37 my @base_items = qw( active_pkg setup_pkg susp_pkg unsusp_pkg cancel_pkg total_revenue_pkg total_revenue_diff );
40 'active_pkg' => 'Active packages',
41 'setup_pkg' => 'New orders',
42 'susp_pkg' => 'Suspensions',
43 'unsusp_pkg' => 'Unsuspensions',
44 'cancel_pkg' => 'Cancellations',
45 'total_revenue_pkg' => 'Total Revenue',
46 'total_revenue_diff' => 'Revenue Difference',
50 'active_pkg' => '000000', #black
51 'setup_pkg' => '00cc00', #green
52 'susp_pkg' => 'ff9900', #yellow
53 'unsusp_pkg' => '44ff44', #light green
54 'cancel_pkg' => 'cc0000', #red
55 'total_revenue_pkg' => '0000ff', #blue
56 'total_revenue_diff' => '0000ff', #blue
59 my $sprintf_fields = {
60 'total_revenue_pkg' => '%.2f', #format to 2 decimal places
61 'total_revenue_diff' => '%.2f', #format to 2 decimal places
65 foreach my $status (qw(active setup cancel susp unsusp)) {
66 $base_links{$status.'_pkg'} =
67 "${p}search/cust_pkg_churn.html?agentnum=$agentnum;status=$status;";
71 # not agentnum, that's elsewhere
72 'refnum' => [ $cgi->param('refnum') ],
73 'classnum' => [ $cgi->param('classnum') ],
74 'towernum' => [ $cgi->param('towernum') ],
76 if ( $cgi->param('zip') =~ /^(\w+)/ ) {
77 $filter_params{zip} = $1;
79 foreach my $link (values %base_links) {
80 foreach my $key (keys(%filter_params)) {
81 my $value = $filter_params{$key};
83 $value = join(',', @$value);
85 $link .= "$key=$value;" if length($value);
90 # In order to keep this from being the same trainwreck as cust_bill_pkg.cgi,
91 # we allow ONE breakdown axis, besides the setup/susp/cancel inherent in
94 my $breakdown = $cgi->param('breakdown_by');
95 my ($name_col, $table);
96 if ($breakdown eq 'classnum') {
98 $name_col = 'classname';
99 } elsif ($breakdown eq 'refnum') {
100 $table = 'part_referral';
101 $name_col = 'referral';
102 } elsif ($breakdown eq 'towernum') {
104 $name_col = 'towername';
105 } elsif ($breakdown) {
106 die "unknown breakdown column '$breakdown'\n";
113 if ( $cgi->param($breakdown) ) {
114 foreach my $key ($cgi->param($breakdown)) {
115 next if $key =~ /\D/;
116 push @groups, qsearch( $table, { $breakdown => $key });
119 @groups = qsearch( $table );
122 push @group_keys, $_->get($breakdown);
123 push @group_labels, $_->get($name_col);
127 my (@items, @labels, @colors, @links, @params);
128 if (scalar(@group_keys) > 1) {
130 foreach my $key (@group_keys) {
131 # this gives a decent level of contrast as long as there aren't too many
133 my $scheme = Color::Scheme->new
137 my $label = shift @group_labels;
138 my $i = 0; # item index
139 foreach (@base_items) {
147 # and a label prefixed with the group label
148 push @labels, "$label - $base_labels{$_}";
150 push @colors, $scheme->colorset->[$i]->[1];
152 my $this_link = $base_links{$_};
153 $this_link .= "$breakdown=$key;";
154 push @links, $this_link;
156 } #foreach (@base_items
158 } # foreach @group_keys
160 @items = @base_items;
161 @labels = @base_labels{@base_items};
162 @colors = @base_colors{@base_items};
163 @links = @base_links{@base_items};
164 @params = map { [ %filter_params ] } @base_items;
167 my $normalize = $cgi->param('normalize');