add package churn report/graph

1 files changed, 258 insertions, 217 deletions

diff --git a/httemplate/graph/elements/monthly.html b/httemplate/graph/elements/monthly.html
index 035bd0314..8e20b1c86 100644
--- a/httemplate/graph/elements/monthly.html
+++ b/httemplate/graph/elements/monthly.html
@@ -1,200 +1,182 @@
+<%doc>
+
+Example:
+
+  include('elements/monthly.html',
+    #required
+    'title'           => 'Page title',
+    'items'           => \@items,
+    'labels'          => \@labels,       # or \%labels (keys are items)
+
+    #required?
+    'colors'          => \@colors,       # or \%colors,
+
+    #recommended
+    'graph_labels'    => \@graph_labels, # or \%graph_labels,
+
+    #optional
+    'params'          => \@params, # opt,
+    'links'           => \@links,      # or \%link, #opt
+    'link_fromparam'  => 'param_from', #defaults to 'begin'
+    'link_toparam'    => 'param_to',   #defaults to 'end'
+
+    #optional, pulled from CGI params if not specified
+    'start_month'     => $smonth,
+    'start_year'      => $syear,
+    'end_month'       => $emonth,
+    'end_year'        => $eyear,
+
+    #optional
+    'agentnum'        => $agentnum,
+    'nototal'         => 1,
+    'graph_type'      => 'LinesPoints',
+    'remove_empty'    => 1,
+    'bottom_total'    => 1,
+    'sprintf'         => '%u', #sprintf format, overrides default %.2f
+    'disable_money'   => 1,
+  );
+
+</%doc>
+% if ( $cgi->param('_type') =~ /^(csv)$/ ) {
 %
+%   #http_header('Content-Type' => 'text/comma-separated-values' ); #IE chokes
+%   http_header('Content-Type' => 'text/plain' );
 %
-%  # options example...
-%  #
-%  # 'title'        => 'Page title',
-%  # 'items'        => \@items,
-%  # 'params'       => \@params, # opt,
-%  # 'labels'       => \@labels,       # or \%labels (keys are items)
-%  # 'graph_labels' => \@graph_labels, # or \%graph_labels,
-%  # 'colors'       => \@colors,       # or \%colors,
-%  # 'links         => \@links,        # or \%link, #opt
-%  # 'start_month'  => $smonth,
-%  # 'start_year'   => $syear,
-%  # 'end_month'    => $emonth,
-%  # 'end_year'     => $eyear,
-%  # 'agentnum'     => $agentnum, #opt
-%  # 'nototal'      => 1, #opt,
-%  # 'graph_type'   => 'LinesPoints', #opt
-%  # 'remove_empty' => 1, #opt,
-%  # 'bottom_total' => 1, #opt,
-%
-%  my(%opt) = @_;
-%  my @items = @{ $opt{'items'} };
-%
-%  foreach my $other (qw( labels graph_labels colors links )) {
-%  #foreach my $other (qw( labels graph_labels colors )) {
-%    if ( ref($opt{$other}) eq 'HASH' ) {
-%      $opt{$other} = [ map $opt{$other}{$_}, @items ];
-%    }
-%  }
-%
-%  my @mon = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
-%
-%  my $report = new FS::Report::Table::Monthly (
-%
-%    #'items'       => $opt{'items'},
-%    'items'        => \@items,
-%    'params'       => $opt{'params'},
-%    'item_labels'  => ( $cgi->param('_type') =~ /^(png)$/
-%                          ? $opt{'graph_labels'}
-%                          : $opt{'labels'}
-%                      ),
-%    'colors'       => $opt{'colors'},
-%    'links'        => $opt{'links'},
-%
-%    'start_month'  => $opt{'start_month'},
-%    'start_year'   => $opt{'start_year'},
-%    'end_month'    => $opt{'end_month'},
-%    'end_year'     => $opt{'end_year'},
-%
-%    'agentnum'     => $opt{'agentnum'},
-%    'remove_empty' => $opt{'remove_empty'},
-%  );
-%  my $data = $report->data;
-%
-%  if ( $cgi->param('_type') =~ /^(csv)$/ ) {
-%
-%    #http_header('Content-Type' => 'text/comma-separated-values' ); #IE chokes
-%    http_header('Content-Type' => 'text/plain' );
-%
-%    my $csv = new Text::CSV_XS { 'always_quote' => 1,
-%                                 'eol'          => "\n", #"\015\012", #"\012"
-%                               };
+%   my $csv = new Text::CSV_XS { 'always_quote' => 1,
+%                                'eol'          => "\n", #"\015\012", #"\012"
+%                              };
 %
-%    $csv->combine(map { my $m=$_; $m =~ s/^(\d+)\//$mon[$1-1] /; $m; }
-%                      ('', @{$data->{label}}, $opt{'nototal'} ? () : 'Total')
-%                 );
-%    
+%   $csv->combine(map { my $m=$_; $m =~ s/^(\d+)\//$mon[$1-1] /; $m; }
+%                     ('', @{$data->{label}}, $opt{'nototal'} ? () : 'Total')
+%                );
+%   
 <% $csv->string %>
-
-%    my @bottom_total = ();
-%    foreach ( @{ $data->{'items'} } ) {
 %
-%      my $col = 0;
-%      my $total = 0;
-%      $csv->combine(
-%        shift( @{ $data->{'item_labels'} } ),
-%        map { $total += $_; $bottom_total[$col++] += $_; sprintf("%.2f", $_); }
-%          ( @{ shift( @{$data->{data}} ) } ),
-%        ( $opt{'nototal'} ? () : sprintf("%.2f", $total) ),
-%      );
-%      unless ( $opt{'nototal'} ) { 
-%        $bottom_total[$col++] += $total; 
-%      } 
+%   my @bottom_total = ();
+%   foreach ( @{ $data->{'items'} } ) {
+%
+%     my $col = 0;
+%     my $total = 0;
+%     $csv->combine(
+%       shift( @{ $data->{'item_labels'} } ),
+%       map { $total += $_; $bottom_total[$col++] += $_; sprintf($sprintf, $_); }
+%         ( @{ shift( @{$data->{data}} ) } ),
+%       ( $opt{'nototal'} ? () : sprintf($sprintf, $total) ),
+%     );
+%     unless ( $opt{'nototal'} ) { 
+%       $bottom_total[$col++] += $total; 
+%     } 
 %
 <% $csv->string %>
-
-%    }
+%
+%   }
 % 
-%    if ( $opt{'bottom_total'} ) {
-%      $csv->combine(
-%        'Total',
-%        map { sprintf("%.2f", $_) } @bottom_total,
-%      );
+%   if ( $opt{'bottom_total'} ) {
+%     $csv->combine(
+%       'Total',
+%       map { sprintf($sprintf, $_) } @bottom_total,
+%     );
 %
 <% $csv->string %>
-
-%    } 
-%    
-%  } elsif ( $cgi->param('_type') =~ /(\.xls)$/ ) {
-%
-%    #http_header('Content-Type' => 'application/excel' ); #eww
-%    http_header('Content-Type' => 'application/vnd.ms-excel' );
-%    #http_header('Content-Type' => 'application/msexcel' ); #alas
-%
-%    my $output = '';
-%    my $XLS = new IO::Scalar \$output;
-%    my $workbook = Spreadsheet::WriteExcel->new($XLS)
-%      or die "Error opening .xls file: $!";
 %
-%    my $worksheet = $workbook->add_worksheet(substr($opt{'title'},0,31));
-%
-%    my($r,$c) = (0,0);
-%
-%    foreach ('', @{$data->{label}}, ($opt{'nototal'} ? () : 'Total') ) {
-%      my $header = $_;
-%      $header =~ s/^(\d+)\//$mon[$1-1] /;
-%      $worksheet->write($r, $c++, $header)
-%    }
-%
-%    my @bottom_total = ();
-%    foreach ( @{ $data->{'items'} } ) {
-%      $r++;
-%      $c = 0;
-%      my $total = 0;
-%      $worksheet->write( $r, $c++, shift( @{ $data->{'item_labels'} } ) );
-%      foreach ( @{ shift( @{$data->{data}} ) } ) {
-%        $total += $_;
-%        $bottom_total[$c] += $_;
-%        $worksheet->write($r, $c++,  sprintf("%.2f", $_) );
-%      }
-%      unless ( $opt{'nototal'} ) { 
-%        $bottom_total[$c] += $total; 
-%        $worksheet->write($r, $c++,  sprintf("%.2f", $total) );
-%      } 
-%    }
+%   } 
+%   
+% } elsif ( $cgi->param('_type') =~ /(\.xls)$/ ) {
+%
+%   #http_header('Content-Type' => 'application/excel' ); #eww
+%   http_header('Content-Type' => 'application/vnd.ms-excel' );
+%   #http_header('Content-Type' => 'application/msexcel' ); #alas
+%
+%   my $output = '';
+%   my $XLS = new IO::Scalar \$output;
+%   my $workbook = Spreadsheet::WriteExcel->new($XLS)
+%     or die "Error opening .xls file: $!";
+%
+%   my $worksheet = $workbook->add_worksheet(substr($opt{'title'},0,31));
+%
+%   my($r,$c) = (0,0);
+%
+%   foreach ('', @{$data->{label}}, ($opt{'nototal'} ? () : 'Total') ) {
+%     my $header = $_;
+%     $header =~ s/^(\d+)\//$mon[$1-1] /;
+%     $worksheet->write($r, $c++, $header)
+%   }
+%
+%   my @bottom_total = ();
+%   foreach ( @{ $data->{'items'} } ) {
+%     $r++;
+%     $c = 0;
+%     my $total = 0;
+%     $worksheet->write( $r, $c++, shift( @{ $data->{'item_labels'} } ) );
+%     foreach ( @{ shift( @{$data->{data}} ) } ) {
+%       $total += $_;
+%       $bottom_total[$c] += $_;
+%       $worksheet->write($r, $c++,  sprintf($sprintf, $_) );
+%     }
+%     unless ( $opt{'nototal'} ) { 
+%       $bottom_total[$c] += $total; 
+%       $worksheet->write($r, $c++,  sprintf($sprintf, $total) );
+%     } 
+%   }
 % 
-%    $c = 0;
-%    if ( $opt{'bottom_total'} ) {
-%      $r++;
-%      $worksheet->write($r, $c++, 'Total');
-%      $worksheet->write($r, $c++, sprintf("%.2f", $_)) foreach @bottom_total;
-%    } 
-%    
-%    $workbook->close();# or die "Error creating .xls file: $!";
-%
-%    http_header('Content-Length' => length($output) );
-%    
+%   $c = 0;
+%   if ( $opt{'bottom_total'} ) {
+%     $r++;
+%     $worksheet->write($r, $c++, 'Total');
+%     $worksheet->write($r, $c++, sprintf($sprintf, $_)) foreach @bottom_total;
+%   } 
+%   
+%   $workbook->close();# or die "Error creating .xls file: $!";
+%
+%   http_header('Content-Length' => length($output) );
+%   
 <% $output %>
-%  } elsif ( $cgi->param('_type') =~ /^(png)$/ ) {
-%
-%    #my $chart = Chart::LinesPoints->new(1024,480);
-%    #my $chart = Chart::LinesPoints->new(768,480);
-%
-%    my $graph_type = 'LinesPoints';
-%    if ( $opt{'graph_type'} =~ /^(LinesPoints|Mountain)$/ ) {
-%      $graph_type = $1;
-%    }
-%    my $class = "Chart::$graph_type";
-%
-%    my $chart = $class->new(976,384);
-%    
-%    my $d = 0;
-%    $chart->set(
-%      #'min_val' => 0,
-%      'legend' => 'bottom',
-%      'colors' => { ( 
-%                      map { my $color = $_;
-%                            'dataset'.$d++ =>
-%                              [ map hex($_), unpack 'a2a2a2', $color ]
-%                          }
-%                          #@{ $opt{'colors'} }
-%                          @{ $data->{'colors'} }
-%                    ),
-%                    #'grey_background' => [ 211, 211, 211 ],
-%                    'grey_background' => 'white',
-%                    'background' => [ 0xe8, 0xe8, 0xe8 ], #grey
-%                  },
-%      #'grey_background' => 'false',
-%      'legend_labels' => $data->{'item_labels'},
-%      'brush_size' => 4,
-%      #'pt_size' => 12,
-%    );
-%
-%    #my @data = map { $data->{$_} } ( 'label', @items );
-%    my @data = @{ $data->{data} };
-%    unshift @data, $data->{'label'};
-%    
-%    http_header('Content-Type' => 'image/png' );
-%
-%    $chart->_set_colors();
-%
-%    
+% } elsif ( $cgi->param('_type') =~ /^(png)$/ ) {
+%
+%   #my $chart = Chart::LinesPoints->new(1024,480);
+%   #my $chart = Chart::LinesPoints->new(768,480);
+%
+%   my $graph_type = 'LinesPoints';
+%   if ( $opt{'graph_type'} =~ /^(LinesPoints|Mountain)$/ ) {
+%     $graph_type = $1;
+%   }
+%   my $class = "Chart::$graph_type";
+%
+%   my $chart = $class->new(976,384);
+%   
+%   my $d = 0;
+%   $chart->set(
+%     #'min_val' => 0,
+%     'legend' => 'bottom',
+%     'colors' => { ( 
+%                     map { my $color = $_;
+%                           'dataset'.$d++ =>
+%                             [ map hex($_), unpack 'a2a2a2', $color ]
+%                         }
+%                         #@{ $opt{'colors'} }
+%                         @{ $data->{'colors'} }
+%                   ),
+%                   #'grey_background' => [ 211, 211, 211 ],
+%                   'grey_background' => 'white',
+%                   'background' => [ 0xe8, 0xe8, 0xe8 ], #grey
+%                 },
+%     #'grey_background' => 'false',
+%     'legend_labels' => $data->{'item_labels'},
+%     'brush_size' => 4,
+%     #'pt_size' => 12,
+%   );
+%
+%   #my @data = map { $data->{$_} } ( 'label', @items );
+%   my @data = @{ $data->{data} };
+%   unshift @data, $data->{'label'};
+%   
+%   http_header('Content-Type' => 'image/png' );
+%
+%   $chart->_set_colors();
+%   
 <% $chart->scalar_png(\@data) %>
 %
-%
-%  } else {
+% } else {
 %
 <% include('/elements/header.html', $opt{'title'} ) %>
 % $cgi->param('_type', 'png'); 
@@ -217,94 +199,153 @@
 <TR>
 
   <TD></TD>
+
 % foreach my $column ( @{$data->{label}} ) {
 %       #$column =~ s/^(\d+)\//$mon[$1-1]<BR>/e;
 %       $column =~ s/^(\d+)\//$mon[$1-1]<BR>/;
-%  
-
     <TH><% $column %></TH>
 % } 
-% unless ( $opt{'nototal'} ) { 
 
+% unless ( $opt{'nototal'} ) { 
     <TH>Total</TH>
 % } 
 
-
 </TR>
+
 % my @bottom_total = ();
-%   foreach my $row ( @{ $data->{'items'} } ) {
+% foreach my $row ( @{ $data->{'items'} } ) {
 %
 %     #my $color = shift( @{ $opt{'colors'} } );
 %     my $color = shift( @{ $data->{'colors'} } );
 %     my $link = shift( @{ $data->{'links'} } );
+%     my ( $begin, $end ) = ( $fromparam, $toparam );
+%     if ( ref($link) ) {
+%       my $ref = $link;
+%       $link =  $ref->{link};
+%       $begin = $ref->{fromparam};
+%       $end =   $ref->{toparam};
+%     }
 %     $link = $link ? qq(<A HREF="$link) : '';
-%
+%     my $label = shift( @{ $data->{'item_labels'} } );
 
+      <TR>
 
-  <TR>
+        <TH>
+          <FONT COLOR="#<% $color %>"><% $label %></FONT>
+        </TH>
 
-    <TH><FONT COLOR="#<% $color %>"><% shift( @{ $data->{'item_labels'} } ) %></FONT></TH>
-% #my $link = exists($opt{'links'}{$row})
-%       #  ? qq(<A HREF="$opt{'links'}{$row})
-%       #  : '';
+%       #my $link = exists($opt{'links'}{$row})
+%             #  ? qq(<A HREF="$opt{'links'}{$row})
+%             #  : '';
 %       my @speriod = @{$data->{speriod}};
 %       my @eperiod = @{$data->{eperiod}};
 %       my $total = 0;
 %    
-% my $col = 0;
-%       foreach my $column ( @{ shift( @{$data->{data}} ) } ) { # ( @{$data->{$row}} ) {
-%    
-
+%       my $col = 0;
+%       foreach my $column ( @{ shift( @{$data->{data}} ) } ) {
 
-      <TD ALIGN="right" BGCOLOR="#ffffff">
-        <% $link ? $link. 'begin='. shift(@speriod). ';end='. shift(@eperiod). '">' : '' %><FONT COLOR="#<% $color %>">$<% sprintf("%.2f", $column) %></FONT><% $link ? '</A>' : '' %>
-      </TD>
+          <TD ALIGN="right" BGCOLOR="#ffffff">
+            <% $link ? $link. "$begin=". shift(@speriod). ";$end=". shift(@eperiod). '">' : '' %><FONT COLOR="#<% $color %>"><% $money_char %><% sprintf($sprintf,, $column) %></FONT><% $link ? '</A>' : '' %>
+          </TD>
 %
 %         $total += $column;
 %         $bottom_total[$col++] += $column;
 %      
-% } 
-% unless ( $opt{'nototal'} ) { 
+%       } 
 
+%       unless ( $opt{'nototal'} ) { 
+            <TD ALIGN="right" BGCOLOR="#f5f6be">
+              <% $link ? $link. "$begin=". ${$data->{speriod}}[0]. ";$end=". ${$data->{eperiod}}[-1]. '">' : '' %><FONT COLOR="#<% $color %>"><% $money_char %><% sprintf($sprintf, $total) %></FONT><% $link ? '</A>' : '' %>
+            </TD>
+%           $bottom_total[$col++] += $total; 
+%       } 
 
-      <TD ALIGN="right" BGCOLOR="#f5f6be">
-        <% $link ? $link. 'begin='. ${$data->{speriod}}[0]. ';end='. ${$data->{eperiod}}[-1]. '">' : '' %><FONT COLOR="#<% $color %>">$<% sprintf("%.2f", $total) %></FONT><% $link ? '</A>' : '' %>
-      </TD>
-% $bottom_total[$col++] += $total; 
-% } 
-
+      </TR>
 
-  </TR>
 % } 
+
 % if ( $opt{'bottom_total'} ) {
 %     my @speriod = ( @{$data->{speriod}}, ${$data->{speriod}}[0] );
 %     my @eperiod = ( @{$data->{eperiod}}, ${$data->{eperiod}}[-1] );
-%
-
 
   <TR>
     <TH>Total</TH>
-% foreach my $total ( @bottom_total ) { 
 
+% foreach my $total ( @bottom_total ) { 
 
       <TD ALIGN="right" BGCOLOR="#f5f6be">
         <% $opt{'bottom_link'}
               ? '<A HREF="'. $opt{'bottom_link'}.
-                'begin='. shift(@speriod).
-                ';end='. shift(@eperiod). '">'
+                "$fromparam=". shift(@speriod).
+                ";$toparam=". shift(@eperiod). '">'
               : ''
-        %>$<% sprintf("%.2f", $total) %><% $opt{'bottom_link'} ? '</A>' : '' %>
+        %>$<% sprintf($sprintf, $total) %><% $opt{'bottom_link'} ? '</A>' : '' %>
 
       </TD>
-% } 
 
+% } 
 
   </TR>
-% } 
 
+% } 
 
 </TABLE>
 
 <% include('/elements/footer.html') %>
 % } 
+<%once>
+
+</%once>
+<%init>
+
+my(%opt) = @_;
+
+my $sprintf = $opt{'sprintf'} || '%.2f';
+my $fromparam = $opt{'link_fromparam'} || 'begin';
+my $toparam =   $opt{'link_toparam'}   || 'end';
+
+my $conf = new FS::Conf;
+my $money_char = $opt{'disable_money'} ? '' : $conf->config('money_char');
+
+my @items = @{ $opt{'items'} };
+
+foreach my $other (qw( labels graph_labels colors links )) {
+#foreach my $other (qw( labels graph_labels colors )) {
+  if ( ref($opt{$other}) eq 'HASH' ) {
+    $opt{$other} = [ map $opt{$other}{$_}, @items ];
+  }
+}
+
+my @mon = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
+
+#find first month
+$opt{'start_month'} ||= $cgi->param('start_month'); # || $curmon+1;
+$opt{'start_year'}  ||= $cgi->param('start_year'); # || 1899+$curyear;
+
+#find last month
+$opt{'end_month'} ||= $cgi->param('end_month'); # || $curmon+1;
+$opt{'end_year'}  ||= $cgi->param('end_year'); # || 1900+$curyear;
+
+my $report = new FS::Report::Table::Monthly (
+
+  #'items'       => $opt{'items'},
+  'items'        => \@items,
+  'params'       => $opt{'params'},
+  'item_labels'  => ( $cgi->param('_type') =~ /^(png)$/
+                        ? $opt{'graph_labels'}
+                        : $opt{'labels'}
+                    ),
+  'colors'       => $opt{'colors'},
+  'links'        => $opt{'links'},
+
+  'start_month'  => $opt{'start_month'},
+  'start_year'   => $opt{'start_year'},
+  'end_month'    => $opt{'end_month'},
+  'end_year'     => $opt{'end_year'},
+
+  'agentnum'     => $opt{'agentnum'},
+  'remove_empty' => $opt{'remove_empty'},
+);
+my $data = $report->data;
 
+</%init>