make package churn report actually show package churn, #7990
[freeside.git] / httemplate / graph / cust_bill_pkg.cgi
1 <% include('elements/monthly.html',
2    #Dumper(
3                 'title'        => $title,
4                 'graph_type'   => $graph_type,
5                 'items'        => \@items,
6                 'params'       => \@params,
7                 'labels'       => \@labels,
8                 'graph_labels' => \@labels,
9                 'colors'       => \@colors,
10                 'links'        => \@links,
11                 'no_graph'     => \@no_graph,
12                 'remove_empty' => 1,
13                 'bottom_total' => $show_total,
14                 'nototal'      => !$show_total,
15                 'bottom_link'  => $bottom_link,
16                 'agentnum'     => $agentnum,
17                 'cust_classnum'=> \@cust_classnums,
18              )
19 %>
20 <%init>
21
22 die "access denied"
23   unless $FS::CurrentUser::CurrentUser->access_right('Financial reports');
24
25 my $link = "${p}search/cust_bill_pkg.cgi?nottax=1";
26 my $bottom_link = "$link;";
27
28 my $use_usage = $cgi->param('use_usage') || 0;
29 my $use_setup = $cgi->param('use_setup') || 0;
30 my $use_override         = $cgi->param('use_override')         ? 1 : 0;
31 my $average_per_cust_pkg = $cgi->param('average_per_cust_pkg') ? 1 : 0;
32 my $distribute           = $cgi->param('distribute')           ? 1 : 0;
33
34 my $show_total = 1;
35 my $graph_type = 'Mountain';
36
37 if ( $average_per_cust_pkg ) {
38   # then the rows are not additive
39   $show_total = 0;
40   $graph_type = 'LinesPoints';
41 }
42
43 my %charge_labels = (
44   'SR' => 'setup + recurring',
45   'RU' => 'recurring',
46   'S'  => 'setup',
47   'R'  => 'recurring',
48   'U'  => 'usage',
49 );
50
51 #XXX or virtual
52 my( $agentnum, $sel_agent, $all_agent ) = ('', '', '');
53 if ( $cgi->param('agentnum') eq 'all' ) {
54   $agentnum = 0;
55   $all_agent = 'ALL';
56 }
57 elsif ( $cgi->param('agentnum') =~ /^(\d+)$/ ) {
58   $agentnum = $1;
59   $bottom_link .= "agentnum=$agentnum;";
60   $sel_agent = qsearchs('agent', { 'agentnum' => $agentnum } );
61   die "agentnum $agentnum not found!" unless $sel_agent;
62 }
63 my $title = $sel_agent ? $sel_agent->agent.' ' : '';
64
65 my( $refnum, $sel_part_referral, $all_part_referral ) = ('', '', '');
66 if ( $cgi->param('refnum') eq 'all' ) {
67   $refnum = 0;
68   $all_part_referral = 'ALL';
69 }
70 elsif ( $cgi->param('refnum') =~ /^(\d+)$/ ) {
71   $refnum = $1;
72   $bottom_link .= "refnum=$refnum;";
73   $sel_part_referral = qsearchs('part_referral', { 'refnum' => $refnum } );
74   die "part_referral $refnum not found!" unless $sel_part_referral;
75 }
76 $title .= $sel_part_referral->referral.' '
77   if $sel_part_referral;
78
79 $title .= 'Sales Report (Gross)';
80 $title .= ', average per customer package'  if $average_per_cust_pkg;
81
82 my @cust_classnums = grep /^\d+$/, $cgi->param('cust_classnum');
83 $bottom_link .= "cust_classnum=$_;" foreach @cust_classnums;
84
85 #classnum (here)
86 # not specified: no longer happens (unless you de-select all classes)
87 # 0: empty class
88 # N: classnum
89 #classnum (link)
90 # not specified: all classes
91 # 0: empty class
92 # N: classnum
93
94 #started out as false lazinessish w/FS::cust_pkg::search_sql (previously search/cust_pkg.cgi), but not much left the sane now after #24776
95
96 my ($class_table, $name_col, $value_col, $class_param);
97 my $all_report_options;
98
99 if ( $cgi->param('class_mode') eq 'report' ) {
100   $class_param = 'report_optionnum'; # CGI param name, also used in the report engine
101   $class_table = 'part_pkg_report_option'; # table containing classes
102   $name_col = 'name'; # the column of that table containing the label
103   $value_col = 'num'; # the column containing the class number
104   # in 'exact' mode we want to run the query in ALL mode.
105   # in 'breakdown' mode want to run the query in ALL mode but using the 
106   # power set of the classes selected.
107   $all_report_options = 1
108     unless $cgi->param('class_agg_break') eq 'aggregate';
109 } else { # class_mode eq 'pkg'
110   $class_param = 'classnum';
111   $class_table = 'pkg_class';
112   $name_col = 'classname';
113   $value_col = 'classnum';
114 }
115
116 my @classnums = sort {$a <=> $b} grep /^\d+$/, $cgi->param($class_param);
117 my @classnames = map { if ( $_ ) {
118                          my $class = qsearchs($class_table, {$value_col=>$_} );
119                          $class->$name_col;
120                        } else {
121                          '(empty class)';
122                        }
123                      }
124                    @classnums;
125 my @not_classnums;
126
127 $bottom_link .= "$class_param=$_;" foreach @classnums;
128
129 if ( $cgi->param('class_agg_break') eq 'aggregate' or
130      $cgi->param('class_agg_break') eq 'exact' ) {
131
132   $title .= ' '. join(', ', @classnames)
133     unless scalar(@classnames) > scalar(qsearch($class_table,{'disabled'=>''}));
134                                  #not efficient for lots of package classes
135
136 } elsif ( $cgi->param('class_agg_break') eq 'breakdown' ) {
137
138   if ( $cgi->param('class_mode') eq 'report' ) {
139     # The new way:
140     # Actually break down all subsets of the (selected) report classes.
141     my @subsets = FS::part_pkg_report_option->subsets(@classnums);
142     my @classnum_space = @classnums;
143     @classnums = @classnames = ();
144     while(@subsets) {
145       my $these = shift @subsets;
146       # applied topology!
147       my $not_these = [ @classnum_space ];
148       my $i = 0;
149       foreach (@$these) {
150         $i++ until $not_these->[$i] == $_;
151         splice(@$not_these, $i, 1);
152       }
153       push @classnums, $these;
154       push @not_classnums, $not_these;
155       push @classnames, shift @subsets;
156     } #while subsets
157   }
158   # else it's 'pkg', i.e. part_pkg.classnum, which is singular on pkgpart
159   # and much simpler
160
161 } else {
162   die "guru meditation #434";
163 }
164
165 #eslaf
166
167 my @items  = ();
168 my @params = ();
169 my @labels = ();
170 my @colors = ();
171 my @links  = ();
172 my @no_graph;
173
174 my @components = ( 'SRU' );
175 # split/omit components as appropriate
176 if ( $use_setup == 1 ) {
177   @components = ( 'S', 'RU' );
178 }
179 elsif ( $use_setup == 2 ) {
180   @components = ( 'RU' );
181 }
182 if ( $use_usage == 1 ) {
183   $components[-1] =~ s/U//; push @components, 'U';
184 }
185 elsif ( $use_usage == 2 ) {
186   $components[-1] =~ s/U//;
187 }
188
189 # Categorization of line items goes
190 # Agent -> Referral -> Package class -> Component (setup/recur/usage)
191 # If per-agent totals are enabled, they go under the Agent level.
192 # There aren't any other kinds of subtotals.
193
194 my $anum = 0;
195 foreach my $agent ( $all_agent || $sel_agent || $FS::CurrentUser::CurrentUser->agents ) {
196
197   my @agent_colors = map { my $col = $cgi->param("agent$anum-color$_");
198                            $col =~ s/^#//;
199                            $col;
200                          }
201                        (0 .. 5);
202   my @colorbuf = ();
203
204   ### fixup the color handling for package classes...
205   ### and usage
206
207   foreach my $part_referral (
208     $all_part_referral ||
209     $sel_part_referral ||
210     qsearch('part_referral', { 'disabled' => '' } ) 
211   ) {
212
213     my @base_params = (
214                         'use_override'         => $use_override,
215                         'average_per_cust_pkg' => $average_per_cust_pkg,
216                         'distribute'           => $distribute,
217                       );
218
219     if ( $cgi->param('class_agg_break') eq 'aggregate' or
220          $cgi->param('class_agg_break') eq 'exact' ) {
221       # the only difference between 'aggregate' and 'exact' is whether
222       # we pass the 'all_report_options' flag.
223
224       foreach my $component ( @components ) {
225
226         push @items, 'cust_bill_pkg';
227
228         push @labels,
229           ( $all_agent || $sel_agent ? '' : $agent->agent.' ' ).
230           ( $all_part_referral || $sel_part_referral ? '' : $part_referral->referral.' ' ).
231           $charge_labels{$component};
232
233         my $row_agentnum = $all_agent || $agent->agentnum;
234         my $row_refnum = $all_part_referral || $part_referral->refnum;
235         my @row_params = (
236                         @base_params,
237                         $class_param => \@classnums,
238                         ($all_agent ? () : ('agentnum' => $row_agentnum) ),
239                         ($all_part_referral ? () : ('refnum' => $row_refnum) ),
240                         'charges'               => $component,
241         );
242
243         # XXX this is very silly.  we should cache it server-side and 
244         # just put a cache identifier in the link
245         my $rowlink = "$link;".
246                       ($all_agent ? '' : "agentnum=$row_agentnum;").
247                       ($all_part_referral ? '' : "refnum=$row_refnum;").
248                       (join('',map {"cust_classnum=$_;"} @cust_classnums)).
249                       "distribute=$distribute;".
250                       "use_override=$use_override;charges=$component;";
251         $rowlink .= "$class_param=$_;" foreach @classnums;
252         if ( $all_report_options ) {
253           push @row_params, 'all_report_options', 1;
254           $rowlink .= 'all_report_options=1';
255         }
256         push @params, \@row_params;
257         push @links, $rowlink;
258
259         @colorbuf = @agent_colors unless @colorbuf;
260         push @colors, shift @colorbuf;
261         push @no_graph, 0;
262
263       } #foreach $component
264
265     } elsif ( $cgi->param('class_agg_break') eq 'breakdown' ) {
266
267       for (my $i = 0; $i < scalar @classnums; $i++) {
268         my $row_classnum = $classnums[$i];
269         my $row_classname = $classnames[$i];
270         my $not_row_classnum = '';
271         if ( $class_param eq 'report_optionnum' ) {
272           # if we're working with report options, @classnums here contains 
273           # arrays of multiple classnums
274           $row_classnum = join(',', @$row_classnum);
275           $row_classname = join(', ', @$row_classname);
276           $not_row_classnum = join(',', @{ $not_classnums[$i] });
277         }
278         foreach my $component ( @components ) {
279
280           push @items, 'cust_bill_pkg';
281
282           push @labels,
283             ( $all_agent || $sel_agent ? '' : $agent->agent.' ' ).
284             ( $all_part_referral || $sel_part_referral ? '' : $part_referral->referral.' ' ).
285             $row_classname .  ' ' . $charge_labels{$component};
286
287           my $row_agentnum = $all_agent || $agent->agentnum;
288           my $row_refnum = $all_part_referral || $part_referral->refnum;
289           my @row_params = (
290                           @base_params,
291                           $class_param => $row_classnum,
292                           ($all_agent ? () : ('agentnum' => $row_agentnum) ),
293                           ($all_part_referral ? () : ('refnum' => $row_refnum)),
294                           'charges'              => $component,
295           );
296           my $row_link = "$link;".
297                        ($all_agent ? '' : "agentnum=$row_agentnum;").
298                        ($all_part_referral ? '' : "refnum=$row_refnum;").
299                        (join('',map {"cust_classnum=$_;"} @cust_classnums)).
300                        "$class_param=$row_classnum;".
301                        "distribute=$distribute;".
302                        "use_override=$use_override;charges=$component;";
303           if ( $class_param eq 'report_optionnum' ) {
304             push @row_params,
305                           'all_report_options' => 1,
306                           'not_report_optionnum' => $not_row_classnum,
307             ;
308             $row_link .= "all_report_options=1;".
309                          "not_report_optionnum=$not_row_classnum;";
310           }
311           push @params, \@row_params;
312           push @links, $row_link;
313
314           @colorbuf = @agent_colors unless @colorbuf;
315           push @colors, shift @colorbuf;
316           push @no_graph, 0;
317
318         } #foreach $component
319       } #foreach $row_classnum
320
321     } #$cgi->param('class_agg_break')
322
323   } #foreach $part_referral
324
325   if ( $cgi->param('agent_totals') and !$all_agent ) {
326     my $row_agentnum = $agent->agentnum;
327     # Include all components that are anywhere on this report
328     my $component = join('', @components);
329
330     my @row_params = (  'agentnum'              => $row_agentnum,
331                         'cust_classnum'         => \@cust_classnums,
332                         'use_override'          => $use_override,
333                         'average_per_cust_pkg'  => $average_per_cust_pkg,
334                         'distribute'            => $distribute,
335                         'charges'               => $component,
336                      );
337     my $row_link = "$link;".
338                    "agentnum=$row_agentnum;".
339                    "distribute=$distribute;".
340                    "charges=$component;";
341     
342     # package class filters
343     if ( $cgi->param('class_agg_break') eq 'aggregate' ) {
344       push @row_params, $class_param => \@classnums;
345       $row_link .= "$class_param=$_;" foreach @classnums;
346     }
347
348     # refnum filters
349     if ( $sel_part_referral ) {
350       push @row_params, 'refnum' => $sel_part_referral->refnum;
351       $row_link .= "refnum=;".$sel_part_referral->refnum;
352     }
353
354     # customer class filters
355     $row_link .= "cust_classnum=$_;" foreach @cust_classnums;
356
357     push @items, 'cust_bill_pkg';
358     push @labels, mt('[_1] - Subtotal', $agent->agent);
359     push @params, \@row_params;
360     push @links, $row_link;
361     push @colors, '000000'; # better idea?
362     push @no_graph, 1;
363   }
364
365   $anum++;
366
367 }
368
369 # may be useful at some point...
370 #if ( $average_per_cust_pkg ) {
371 #  @items = map { ('cust_bill_pkg', 'cust_bill_pkg_count_pkgnum') } @items;
372 #  @labels = map { $_, "Packages" } @labels;
373 #  @params = map { $_, $_ } @params;
374 #  @links = map { $_, $_ } @links;
375 #  @colors = map { $_, $_ } @colors;
376 #  @no_graph = map { $_, 1 } @no_graph;
377 #}
378 #
379
380 #use Data::Dumper;
381 if ( $cgi->param('debug') == 1 ) {
382   $FS::Report::Table::DEBUG = 1;
383 }
384 </%init>