1 <& elements/monthly.html,
2 'title' => $agentname. 'Package Churn',
5 'graph_labels' => \@labels,
9 'agentnum' => $agentnum,
12 'remove_empty' => (scalar(@group_keys) > 1 ? 1 : 0),
16 #XXX use a different ACL for package churn?
17 my $curuser = $FS::CurrentUser::CurrentUser;
19 unless $curuser->access_right('Financial reports');
21 #false laziness w/money_time.cgi, cust_bill_pkg.cgi
24 my( $agentnum, $agent ) = ('', '');
25 if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) {
27 $agent = qsearchs('agent', { 'agentnum' => $agentnum } );
28 die "agentnum $agentnum not found!" unless $agent;
31 my $agentname = $agent ? $agent->agent.' ' : '';
33 my @base_items = qw( setup_pkg susp_pkg cancel_pkg );
36 'setup_pkg' => 'New orders',
37 'susp_pkg' => 'Suspensions',
38 # 'unsusp' => 'Unsuspensions',
39 'cancel_pkg' => 'Cancellations',
43 'setup_pkg' => '00cc00', #green
44 'susp_pkg' => 'ff9900', #yellow
45 #'unsusp' => '', #light green?
46 'cancel_pkg' => 'cc0000', #red ? 'ff0000'
50 'setup_pkg' => { 'link' => "${p}search/cust_pkg.cgi?agentnum=$agentnum;",
51 'fromparam' => 'setup_begin',
52 'toparam' => 'setup_end',
54 'susp_pkg' => { 'link' => "${p}search/cust_pkg.cgi?agentnum=$agentnum;",
55 'fromparam' => 'susp_begin',
56 'toparam' => 'susp_end',
58 'cancel_pkg' => { 'link' => "${p}search/cust_pkg.cgi?agentnum=$agentnum;",
59 'fromparam' => 'cancel_begin',
60 'toparam' => 'cancel_end',
65 # not agentnum, that's elsewhere
66 'refnum' => [ $cgi->param('refnum') ],
67 'classnum' => [ $cgi->param('classnum') ],
68 'towernum' => [ $cgi->param('towernum') ],
70 if ( $cgi->param('zip') =~ /^(\w+)/ ) {
71 $filter_params{zip} = $1;
73 foreach my $link (values %base_links) {
74 foreach my $key (keys(%filter_params)) {
75 my $value = $filter_params{$key};
77 $value = join(',', @$value);
79 $link->{'link'} .= "$key=$value;" if length($value);
84 # In order to keep this from being the same trainwreck as cust_bill_pkg.cgi,
85 # we allow ONE breakdown axis, besides the setup/susp/cancel inherent in
88 my $breakdown = $cgi->param('breakdown_by');
89 my ($name_col, $table);
90 if ($breakdown eq 'classnum') {
92 $name_col = 'classname';
93 } elsif ($breakdown eq 'refnum') {
94 $table = 'part_referral';
95 $name_col = 'referral';
96 } elsif ($breakdown eq 'towernum') {
98 $name_col = 'towername';
99 } elsif ($breakdown) {
100 die "unknown breakdown column '$breakdown'\n";
107 if ( $cgi->param($breakdown) ) {
108 foreach my $key ($cgi->param($breakdown)) {
109 next if $key =~ /\D/;
110 push @groups, qsearch( $table, { $breakdown => $key });
113 @groups = qsearch( $table );
116 push @group_keys, $_->get($breakdown);
117 push @group_labels, $_->get($name_col);
121 my (@items, @labels, @colors, @links, @params);
122 if (scalar(@group_keys) > 1) {
124 foreach my $key (@group_keys) {
125 # this gives a decent level of contrast as long as there aren't too many
127 my $scheme = Color::Scheme->new
131 my $label = shift @group_labels;
132 my $i = 0; # item index
133 foreach (@base_items) {
141 # and a label prefixed with the group label
142 push @labels, "$label - $base_labels{$_}";
144 push @colors, $scheme->colorset->[$i]->[1];
146 my %this_link = %{ $base_links{$_} };
147 $this_link{link} .= "$breakdown=$key;";
148 push @links, \%this_link;
150 } #foreach (@base_items
152 } # foreach @group_keys
154 @items = @base_items;
155 @labels = @base_labels{@base_items};
156 @colors = @base_colors{@base_items};
157 @links = @base_links{@base_items};
158 @params = map { [ %filter_params ] } @base_items;