httemplate/graph/cust_pkg.html

   1 <& elements/monthly.html,
   2   'title'         => $agentname. 'Package Churn',
   3   'items'         => \@items,
   4   'labels'        => \@labels,
   5   'graph_labels'  => \@labels,
   6   'colors'        => \@colors,
   7   'links'         => \@links,
   8   'params'        => \@params,
   9   'agentnum'      => $agentnum,
  10   'sprintf'       => ( $normalize ? '%0.1f%%' : '%u'),
  11   'sprintf_fields' => $sprintf_fields,
  12   'normalize'     => ( $normalize ? 0 : undef ),
  13   'disable_money' => 1,
  14   'remove_empty'  => (scalar(@group_keys) > 1 ? 1 : 0),
  15   'nototal'       => 1,
  16   'no_graph'      => [ 1, 0, 0, 0, 0, 1, 1 ], # don't graph 'active, total_revenue, total_revenue_diff'
  17 &>
  18 <%init>
  19
  20 #XXX use a different ACL for package churn?
  21 my $curuser = $FS::CurrentUser::CurrentUser;
  22 die "access denied"
  23   unless $curuser->access_right('Financial reports');
  24
  25 #false laziness w/money_time.cgi, cust_bill_pkg.cgi
  26
  27 #XXX or virtual
  28 my( $agentnum, $agent ) = ('', '');
  29 if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) {
  30   $agentnum = $1;
  31   $agent = qsearchs('agent', { 'agentnum' => $agentnum } );
  32   die "agentnum $agentnum not found!" unless $agent;
  33 }
  34
  35 my $agentname = $agent ? $agent->agent.' ' : '';
  36
  37 my @base_items = qw( active_pkg setup_pkg susp_pkg unsusp_pkg cancel_pkg total_revenue_pkg total_revenue_diff );
  38
  39 my %base_labels = (
  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',
  47 );
  48
  49 my %base_colors = (
  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
  57 );
  58
  59 my $sprintf_fields = {
  60   'total_revenue_pkg' => '%.2f', #format to 2 decimal places
  61   'total_revenue_diff' => '%.2f', #format to 2 decimal places
  62 };
  63
  64 my %base_links;
  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;";
  68 }
  69
  70 my %filter_params = (
  71   # not agentnum, that's elsewhere
  72   'refnum'      => [ $cgi->param('refnum') ],
  73   'classnum'    => [ $cgi->param('classnum') ],
  74   'towernum'    => [ $cgi->param('towernum') ],
  75 );
  76 if ( $cgi->param('zip') =~ /^(\w+)/ ) {
  77   $filter_params{zip} = $1;
  78 }
  79 foreach my $link (values %base_links) {
  80   foreach my $key (keys(%filter_params)) {
  81     my $value = $filter_params{$key};
  82     if (ref($value)) {
  83       $value = join(',', @$value);
  84     }
  85     $link .= "$key=$value;" if length($value);
  86   }
  87 }
  88
  89
  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
  92 # the report.
  93
  94 my $breakdown = $cgi->param('breakdown_by');
  95 my ($name_col, $table);
  96 if ($breakdown eq 'classnum') {
  97   $table = 'pkg_class';
  98   $name_col = 'classname';
  99 } elsif ($breakdown eq 'refnum') {
 100   $table = 'part_referral';
 101   $name_col = 'referral';
 102 } elsif ($breakdown eq 'towernum') {
 103   $table = 'tower';
 104   $name_col = 'towername';
 105 } elsif ($breakdown) {
 106   die "unknown breakdown column '$breakdown'\n";
 107 }
 108
 109 my @group_keys;
 110 my @group_labels;
 111 if ( $table ) {
 112   my @groups;
 113   if ( $cgi->param($breakdown) ) {
 114     foreach my $key ($cgi->param($breakdown)) {
 115       next if $key =~ /\D/;
 116       push @groups, qsearch( $table, { $breakdown => $key });
 117     }
 118   } else {
 119     @groups = qsearch( $table );
 120   }
 121   foreach (@groups) {
 122     push @group_keys, $_->get($breakdown);
 123     push @group_labels, $_->get($name_col);
 124   }
 125 }
 126
 127 my (@items, @labels, @colors, @links, @params);
 128 if (scalar(@group_keys) > 1) {
 129   my $hue = 180;
 130   foreach my $key (@group_keys) {
 131     # this gives a decent level of contrast as long as there aren't too many
 132     # result sets
 133     my $scheme = Color::Scheme->new
 134       ->scheme('triade')
 135       ->from_hue($hue)
 136       ->distance(0.5);
 137     my $label = shift @group_labels;
 138     my $i = 0; # item index
 139     foreach (@base_items) {
 140       # append the item
 141       push @items, $_;
 142       # and its parameters
 143       push @params, [
 144         %filter_params,
 145         $breakdown => $key
 146       ];
 147       # and a label prefixed with the group label
 148       push @labels, "$label - $base_labels{$_}";
 149       # and colors (?!)
 150       push @colors, $scheme->colorset->[$i]->[1];
 151       # and links...
 152       my $this_link = $base_links{$_};
 153       $this_link .= "$breakdown=$key;";
 154       push @links, $this_link;
 155       $i++;
 156     } #foreach (@base_items
 157     $hue += 35;
 158   } # foreach @group_keys
 159 } else {
 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;
 165 }
 166
 167 my $normalize = $cgi->param('normalize');
 168
 169 </%init>