httemplate/graph/cust_pkg.cgi

   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'       => '%u',
  11   'disable_money' => 1,
  12   'remove_empty'  => (scalar(@group_keys) > 1 ? 1 : 0),
  13 &>
  14 <%init>
  15
  16 #XXX use a different ACL for package churn?
  17 my $curuser = $FS::CurrentUser::CurrentUser;
  18 die "access denied"
  19   unless $curuser->access_right('Financial reports');
  20
  21 #false laziness w/money_time.cgi, cust_bill_pkg.cgi
  22
  23 #XXX or virtual
  24 my( $agentnum, $agent ) = ('', '');
  25 if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) {
  26   $agentnum = $1;
  27   $agent = qsearchs('agent', { 'agentnum' => $agentnum } );
  28   die "agentnum $agentnum not found!" unless $agent;
  29 }
  30
  31 my $agentname = $agent ? $agent->agent.' ' : '';
  32
  33 my @base_items = qw( setup_pkg susp_pkg cancel_pkg );
  34
  35 my %base_labels = (
  36   'setup_pkg'  => 'New orders',
  37   'susp_pkg'   => 'Suspensions',
  38 #  'unsusp' => 'Unsuspensions',
  39   'cancel_pkg' => 'Cancellations',
  40 );
  41
  42 my %base_colors = (
  43   'setup_pkg'   => '00cc00', #green
  44   'susp_pkg'    => 'ff9900', #yellow
  45   #'unsusp'  => '', #light green?
  46   'cancel_pkg'  => 'cc0000', #red ? 'ff0000'
  47 );
  48
  49 my %base_links = (
  50   'setup_pkg'  => { 'link' => "${p}search/cust_pkg.cgi?agentnum=$agentnum;",
  51                     'fromparam' => 'setup_begin',
  52                     'toparam'   => 'setup_end',
  53                   },
  54   'susp_pkg'   => { 'link' => "${p}search/cust_pkg.cgi?agentnum=$agentnum;",
  55                     'fromparam' => 'susp_begin',
  56                     'toparam'   => 'susp_end',
  57                   },
  58   'cancel_pkg' => { 'link' => "${p}search/cust_pkg.cgi?agentnum=$agentnum;",
  59                     'fromparam' => 'cancel_begin',
  60                     'toparam'   => 'cancel_end',
  61                   },
  62 );
  63
  64 my %filter_params = (
  65   # not agentnum, that's elsewhere
  66   'refnum'      => [ $cgi->param('refnum') ],
  67   'classnum'    => [ $cgi->param('classnum') ],
  68   'towernum'    => [ $cgi->param('towernum') ],
  69 );
  70 if ( $cgi->param('zip') =~ /^(\w+)/ ) {
  71   $filter_params{zip} = $1;
  72 }
  73 foreach my $link (values %base_links) {
  74   foreach my $key (keys(%filter_params)) {
  75     my $value = $filter_params{$key};
  76     if (ref($value)) {
  77       $value = join(',', @$value);
  78     }
  79     $link->{'link'} .= "$key=$value;" if length($value);
  80   }
  81 }
  82
  83
  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
  86 # the report.
  87
  88 my $breakdown = $cgi->param('breakdown_by');
  89 my ($name_col, $table);
  90 if ($breakdown eq 'classnum') {
  91   $table = 'pkg_class';
  92   $name_col = 'classname';
  93 } elsif ($breakdown eq 'refnum') {
  94   $table = 'part_referral';
  95   $name_col = 'referral';
  96 } elsif ($breakdown eq 'towernum') {
  97   $table = 'tower';
  98   $name_col = 'towername';
  99 } elsif ($breakdown) {
 100   die "unknown breakdown column '$breakdown'\n";
 101 }
 102
 103 my @group_keys;
 104 my @group_labels;
 105 if ( $table ) {
 106   my @groups;
 107   if ( $cgi->param($breakdown) ) {
 108     foreach my $key ($cgi->param($breakdown)) {
 109       next if $key =~ /\D/;
 110       push @groups, qsearch( $table, { $breakdown => $key });
 111     }
 112   } else {
 113     @groups = qsearch( $table );
 114   }
 115   foreach (@groups) {
 116     push @group_keys, $_->get($breakdown);
 117     push @group_labels, $_->get($name_col);
 118   }
 119 }
 120
 121 my (@items, @labels, @colors, @links, @params);
 122 if (scalar(@group_keys) > 1) {
 123   my $hue = 180;
 124   foreach my $key (@group_keys) {
 125     # this gives a decent level of contrast as long as there aren't too many
 126     # result sets
 127     my $scheme = Color::Scheme->new
 128       ->scheme('triade')
 129       ->from_hue($hue)
 130       ->distance(0.5);
 131     my $label = shift @group_labels;
 132     my $i = 0; # item index
 133     foreach (@base_items) {
 134       # append the item
 135       push @items, $_;
 136       # and its parameters
 137       push @params, [
 138         %filter_params,
 139         $breakdown => $key
 140       ];
 141       # and a label prefixed with the group label
 142       push @labels, "$label - $base_labels{$_}";
 143       # and colors (?!)
 144       push @colors, $scheme->colorset->[$i]->[1];
 145       # and links...
 146       my %this_link = %{ $base_links{$_} };
 147       $this_link{link} .= "$breakdown=$key;";
 148       push @links, \%this_link;
 149       $i++;
 150     } #foreach (@base_items
 151     $hue += 35;
 152   } # foreach @group_keys
 153 } else {
 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;
 159 }
 160
 161 </%init>