+<& 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'),
+ 'normalize' => ( $normalize ? 0 : undef ),
+ 'disable_money' => 1,
+ 'remove_empty' => (scalar(@group_keys) > 1 ? 1 : 0),
+ 'nototal' => 1,
+ 'no_graph' => [ 1, 0, 0, 0, 0 ], # don't graph 'active'
+&>
+<%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 );
+
+my %base_labels = (
+ 'active_pkg' => 'Active packages',
+ 'setup_pkg' => 'New orders',
+ 'susp_pkg' => 'Suspensions',
+ 'unsusp_pkg' => 'Unsuspensions',
+ 'cancel_pkg' => 'Cancellations',
+);
+
+my %base_colors = (
+ 'active_pkg' => '000000', #black
+ 'setup_pkg' => '00cc00', #green
+ 'susp_pkg' => 'ff9900', #yellow
+ 'unsusp_pkg' => '44ff44', #light green
+ 'cancel_pkg' => 'cc0000', #red
+);
+
+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');
+
+</%init>
projects / freeside.git / commitdiff