sales report improvements, #15393

diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm
index 113bf8d..c9ad7c6 100644 (file)
--- a/FS/FS/Report/Table.pm
+++ b/FS/FS/Report/Table.pm
@@ -17,7 +17,22 @@ FS::Report::Table - Tables of report data
 
 =head1 SYNOPSIS
 
-See the more specific report objects, currently only FS::Report::Table::Monthly
+See the more specific report objects, currently only 
+FS::Report::Table::Monthly and FS::Report::Table::Daily.
+
+=head1 OBSERVABLES
+
+The common interface for an observable named 'foo' is:
+
+$report->foo($startdate, $enddate, $agentnum, %options)
+
+This returns a scalar value for foo, over the period from 
+$startdate to $enddate, limited to agent $agentnum, subject to 
+options in %opt.
+
+=over 4
+
+=item invoiced: The total amount charged on all invoices.
 
 =cut
 
@@ -34,6 +49,10 @@ sub invoiced { #invoiced
   
 }
 
+=item netsales: invoiced - netcredits
+
+=cut
+
 sub netsales { #net sales
   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 
@@ -41,7 +60,9 @@ sub netsales { #net sales
   - $self->netcredits($speriod,$eperiod,$agentnum,%opt);
 }
 
-#deferred revenue
+=item cashflow: payments - refunds
+
+=cut
 
 sub cashflow {
   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
@@ -50,6 +71,10 @@ sub cashflow {
   - $self->refunds( $speriod, $eperiod, $agentnum, %opt);
 }
 
+=item netcashflow: payments - netrefunds
+
+=cut
+
 sub netcashflow {
   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 
@@ -57,6 +82,10 @@ sub netcashflow {
   - $self->netrefunds( $speriod, $eperiod, $agentnum);
 }
 
+=item payments: The sum of payments received in the period.
+
+=cut
+
 sub payments {
   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
   $self->scalar_sql("
@@ -68,6 +97,10 @@ sub payments {
   );
 }
 
+=item credits: The sum of credits issued in the period.
+
+=cut
+
 sub credits {
   my( $self, $speriod, $eperiod, $agentnum ) = @_;
   $self->scalar_sql("
@@ -78,6 +111,10 @@ sub credits {
   );
 }
 
+=item refunds: The sum of refunds paid in the period.
+
+=cut
+
 sub refunds {
   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
   $self->scalar_sql("
@@ -89,6 +126,10 @@ sub refunds {
   );
 }
 
+=item netcredits: The sum of credit applications to invoices in the period.
+
+=cut
+
 sub netcredits {
   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
   $self->scalar_sql("
@@ -105,6 +146,10 @@ sub netcredits {
   );
 }
 
+=item receipts: The sum of payment applications to invoices in the period.
+
+=cut
+
 sub receipts { #net payments
   my( $self, $speriod, $eperiod, $agentnum ) = @_;
   $self->scalar_sql("
@@ -120,6 +165,10 @@ sub receipts { #net payments
   );
 }
 
+=item netrefunds: The sum of refund applications to credits in the period.
+
+=cut
+
 sub netrefunds {
   my( $self, $speriod, $eperiod, $agentnum ) = @_;
   $self->scalar_sql("
@@ -135,6 +184,8 @@ sub netrefunds {
   );
 }
 
+#XXX docs
+
 #these should be auto-generated or $AUTOLOADed or something
 sub invoiced_12mo {
   my( $self, $speriod, $eperiod, $agentnum ) = @_;
@@ -206,6 +257,12 @@ sub _subtract_11mo {
   timelocal($sec,$min,$hour,$mday,$mon,$year);
 }
 
+=item cust_pkg_setup_cost: The total setup costs of packages setup in the period
+
+'classnum': limit to this package class.
+
+=cut
+
 sub cust_pkg_setup_cost {
   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
   my $where = '';
@@ -232,6 +289,12 @@ sub cust_pkg_setup_cost {
   return $self->scalar_sql($total_sql);
 }
 
+=item cust_pkg_recur_cust: the total recur costs of packages in the period
+
+'classnum': limit to this package class.
+
+=cut
+
 sub cust_pkg_recur_cost {
   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
   my $where = '';
@@ -263,95 +326,142 @@ sub cust_pkg_recur_cost {
                   ";
   return $self->scalar_sql($total_sql);
 }
- 
+
+=item cust_bill_pkg: the total package charges on invoice line items.
+
+'charges': limit the type of charges included (setup, recur, usage).
+Should be a string containing one or more of 'S', 'R', or 'U'; if 
+unspecified, defaults to all three.
+
+'classnum': limit to this package class.
+
+'use_override': for line items generated by an add-on package, use the class
+of the add-on rather than the base package.
+
+'freq': limit to packages with this frequency.  Currently uses the part_pkg 
+frequency, so term discounted packages may give odd results.
+
+'distribute': for non-monthly recurring charges, ignore the invoice 
+date.  Instead, consider the line item's starting/ending dates.  Determine 
+the fraction of the line item duration that falls within the specified 
+interval and return that fraction of the recurring charges.  This is 
+somewhat experimental.
+
+=cut
+
 sub cust_bill_pkg {
-  my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
+  my $self = shift;
+  my( $speriod, $eperiod, $agentnum, %opt ) = @_;
 
-  my $where = '';
-  my $comparison = '';
-  if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
-    if ( $1 == 0 ) {
-      $comparison = "IS NULL";
-    } else {
-      $comparison = "= $1";
-    }
+  my %charges = map {$_=>1} split('', $opt{'charges'} || 'SRU');
 
-    if ( $opt{'use_override'} ) {
-      $where = "AND (
-        part_pkg.classnum $comparison AND pkgpart_override IS NULL OR
-        override.classnum $comparison AND pkgpart_override IS NOT NULL
-      )";
-    } else {
-      $where = "AND part_pkg.classnum $comparison";
-    }
-  }
+  my $sum = 0;
+  $sum += $self->cust_bill_pkg_setup(@_) if $charges{S};
+  $sum += $self->cust_bill_pkg_recur(@_) if $charges{R};
+  $sum += $self->cust_bill_pkg_detail(@_) if $charges{U};
+  $sum;
+}
+
+my $cust_bill_pkg_from =
+  ' cust_bill_pkg
+    LEFT JOIN cust_bill USING ( invnum )
+    LEFT JOIN cust_main USING ( custnum )
+    LEFT JOIN cust_pkg USING ( pkgnum )
+    LEFT JOIN part_pkg USING ( pkgpart )
+    LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart';
+
+sub cust_bill_pkg_setup {
+  my $self = shift;
+  my ($speriod, $eperiod, $agentnum, %opt) = @_;
 
   $agentnum ||= $opt{'agentnum'};
 
-  my $total_sql =
-    " SELECT COALESCE( SUM(cust_bill_pkg.setup + cust_bill_pkg.recur), 0 ) ";
+  my @where = (
+    'pkgnum != 0',
+    $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
+    $self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
+  );
 
-  $total_sql .=
-    " / CASE COUNT(cust_pkg.*) WHEN 0 THEN 1 ELSE COUNT(cust_pkg.*) END "
-      if $opt{average_per_cust_pkg};
+  my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0)
+  FROM $cust_bill_pkg_from
+  WHERE " . join(' AND ', grep $_, @where);
 
-  $total_sql .=
-    " FROM cust_bill_pkg
-        LEFT JOIN cust_bill USING ( invnum )
-        LEFT JOIN cust_main USING ( custnum )
-        LEFT JOIN cust_pkg USING ( pkgnum )
-        LEFT JOIN part_pkg USING ( pkgpart )
-        LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
-      WHERE pkgnum != 0
-        $where
-        AND ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum);
-  
-  if ($opt{use_usage} && $opt{use_usage} eq 'recurring') {
-    my $total = $self->scalar_sql($total_sql);
-    my $usage = cust_bill_pkg_detail(@_); #$speriod, $eperiod, $agentnum, %opt 
-    return $total-$usage;
-  } elsif ($opt{use_usage} && $opt{use_usage} eq 'usage') {
-    return cust_bill_pkg_detail(@_); #$speriod, $eperiod, $agentnum, %opt 
-  } else {
-    return $self->scalar_sql($total_sql);
+  $self->scalar_sql($total_sql);
+}
+
+sub cust_bill_pkg_recur {
+  my $self = shift;
+  my ($speriod, $eperiod, $agentnum, %opt) = @_;
+
+  $agentnum ||= $opt{'agentnum'};
+
+  my @where = (
+    'pkgnum != 0',
+    $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
+  );
+
+  # subtract all usage from the line item regardless of date
+  my $item_usage = '( SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
+    FROM cust_bill_pkg_detail
+    WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum )';
+  my $recur_fraction = '';
+
+  if ( $opt{'distribute'} ) {
+    push @where, "cust_main.agentnum = $agentnum" if $agentnum;
+    push @where,
+      "cust_bill_pkg.sdate < $eperiod",
+      "cust_bill_pkg.edate > $speriod",
+    ;
+    # the fraction of edate - sdate that's within [speriod, eperiod]
+    $recur_fraction = " * 
+      CAST(LEAST($eperiod, cust_bill_pkg.edate) - 
+       GREATEST($speriod, cust_bill_pkg.sdate) AS DECIMAL) / 
+      (cust_bill_pkg.edate - cust_bill_pkg.sdate)";
   }
+  else {
+    push @where, 
+      $self->in_time_period_and_agent($speriod, $eperiod, $agentnum);
+  }
+
+  my $total_sql = "SELECT COALESCE(SUM(
+  (cust_bill_pkg.recur - $item_usage) $recur_fraction),0)
+  FROM $cust_bill_pkg_from
+  WHERE ".join(' AND ', grep $_, @where);
+
+  $self->scalar_sql($total_sql);
 }
 
+=item cust_bill_pkg_detail: the total usage charges in detail lines.
+
+Arguments as for C<cust_bill_pkg>, plus:
+
+'usageclass': limit to this usage class number.
+
+=cut
+
 sub cust_bill_pkg_detail {
   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 
   my @where = ( "cust_bill_pkg.pkgnum != 0" );
-  my $comparison = '';
-  if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
-    if ( $1 == 0 ) {
-      $comparison = "IS NULL";
-    } else {
-      $comparison = "= $1";
-    }
 
-    if ( $opt{'use_override'} ) {
-      push @where, "(
-        part_pkg.classnum $comparison AND pkgpart_override IS NULL OR
-        override.classnum $comparison AND pkgpart_override IS NOT NULL
-      )";
-    } else {
-      push @where, "part_pkg.classnum $comparison";
-    }
-  }
+  $agentnum ||= $opt{'agentnum'};
 
-  if ( $opt{'usageclass'} =~ /^(\d+)$/ ) {
-    if ( $1 == 0 ) {
-      $comparison = "IS NULL";
-    } else {
-      $comparison = "= $1";
-    }
+  push @where,
+    $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
+    $self->with_usageclass($opt{'usageclass'}),
+    ;
 
-    push @where, "cust_bill_pkg_detail.classnum $comparison";
+  if ( $opt{'distribute'} ) {
+    # then limit according to the usage time, not the billing date
+    push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
+      'cust_bill_pkg_detail.startdate'
+    );
+  }
+  else {
+    push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
+      'cust_bill._date'
+    );
   }
-
-  $agentnum ||= $opt{'agentnum'};
-
-  my $where = join( ' AND ', @where );
 
   my $total_sql = " SELECT SUM(amount) ";
 
@@ -367,8 +477,7 @@ sub cust_bill_pkg_detail {
         LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum
         LEFT JOIN part_pkg USING ( pkgpart )
         LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
-      WHERE $where
-        AND ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum);
+      WHERE ".join( ' AND ', grep $_, @where );
 
   $self->scalar_sql($total_sql);
   
@@ -471,10 +580,46 @@ sub for_custnum {
     $opt{'custnum'} =~ /^\d+$/ ? " and custnum = $opt{custnum} " : '';
 }
 
+sub with_classnum {
+  my $self = shift;
+  my ($classnum, $use_override) = @_;
+  return '' unless $classnum =~ /^\d+$/;
+  my $comparison;
+  if ( $classnum == 0 ) {
+    $comparison = 'IS NULL';
+  }
+  else {
+    $comparison = "= $classnum";
+  }
+  if ( $use_override ) {
+    return "(
+      part_pkg.classnum $comparison AND pkgpart_override IS NULL OR
+      override.classnum $comparison AND pkgpart_override IS NOT NULL
+    )";
+  }
+  else {
+    return "part_pkg.classnum $comparison";
+  }
+}
+
+sub with_usageclass {
+  my $self = shift;
+  my ($classnum, $use_override) = @_;
+  return '' unless $classnum =~ /^\d+$/;
+  my $comparison;
+  if ( $classnum == 0 ) {
+    $comparison = 'IS NULL';
+  }
+  else {
+    $comparison = "= $classnum";
+  }
+  return "cust_bill_pkg_detail.classnum $comparison";
+}
+
 sub scalar_sql {
   my( $self, $sql ) = ( shift, shift );
   my $sth = dbh->prepare($sql) or die dbh->errstr;
-  warn "FS::Report::Table::Monthly\n$sql\n" if $DEBUG;
+  warn "FS::Report::Table\n$sql\n" if $DEBUG;
   $sth->execute
     or die "Unexpected error executing statement $sql: ". $sth->errstr;
   $sth->fetchrow_arrayref->[0] || 0;

diff --git a/FS/FS/Report/Table/Monthly.pm b/FS/FS/Report/Table/Monthly.pm
index f57fb06..d9d8754 100644 (file)
--- a/FS/FS/Report/Table/Monthly.pm
+++ b/FS/FS/Report/Table/Monthly.pm
@@ -102,11 +102,14 @@ sub data {
 
     my $col = 0;
     #these need to get generalized, sheesh
+    #(though we now return a list of item indices that are present in the 
+    #output, so the front-end code could do this)
     my @newitems = ();
     my @newlabels = ();
     my @newdata = ();
     my @newcolors = ();
     my @newlinks = ();
+    my @indices = ();
     foreach my $item ( @{$self->{'items'}} ) {
 
       if ( grep { $_ != 0 } @{$data{'data'}->[$col]} ) {
@@ -115,6 +118,7 @@ sub data {
         push @newdata,   $data{'data'}->[$col];
         push @newcolors, $data{'colors'}->[$col];
         push @newlinks,  $data{'links'}->[$col];
+        push @indices,   $col;
       }
 
       $col++;
@@ -125,6 +129,7 @@ sub data {
     $data{'data'}        = \@newdata;
     $data{'colors'}      = \@newcolors;
     $data{'links'}       = \@newlinks;
+    $data{'indices'}     = \@indices;
 
   }
 

diff --git a/httemplate/graph/cust_bill_pkg.cgi b/httemplate/graph/cust_bill_pkg.cgi
index 03e29b9..af4d045 100644 (file)
--- a/httemplate/graph/cust_bill_pkg.cgi
+++ b/httemplate/graph/cust_bill_pkg.cgi
@@ -22,9 +22,19 @@ die "access denied"
 my $link = "${p}search/cust_bill_pkg.cgi?nottax=1";
 my $bottom_link = "$link;";
 
+my $use_usage = $cgi->param('use_usage') || 0;
+my $use_setup = $cgi->param('use_setup') || 0;
 my $use_override         = $cgi->param('use_override')         ? 1 : 0;
-my $use_usage            = $cgi->param('use_usage')            ? 1 : 0;
 my $average_per_cust_pkg = $cgi->param('average_per_cust_pkg') ? 1 : 0;
+my $distribute           = $cgi->param('distribute')           ? 1 : 0;
+
+my %charge_labels = (
+  'SR' => 'setup + recurring',
+  'RU' => 'recurring',
+  'S'  => 'setup',
+  'R'  => 'recurring',
+  'U'  => 'usage',
+);
 
 #XXX or virtual
 my( $agentnum, $sel_agent, $all_agent ) = ('', '', '');
@@ -94,6 +104,21 @@ my @labels = ();
 my @colors = ();
 my @links  = ();
 
+my @components = ( 'SRU' );
+# split/omit components as appropriate
+if ( $use_setup == 1 ) {
+  @components = ( 'S', 'RU' );
+}
+elsif ( $use_setup == 2 ) {
+  @components = ( 'RU' );
+}
+if ( $use_usage == 1 ) {
+  $components[-1] =~ s/U//; push @components, 'U';
+}
+elsif ( $use_usage == 2 ) {
+  $components[-1] =~ s/U//;
+}
+
 foreach my $agent ( $all_agent || $sel_agent || qsearch('agent', { 'disabled' => '' } ) ) {
 
   my $col_scheme = Color::Scheme->new
@@ -108,7 +133,7 @@ foreach my $agent ( $all_agent || $sel_agent || qsearch('agent', { 'disabled' =>
   my $n = 0;
 
   foreach my $pkg_class ( @pkg_class ) {
-    foreach my $component ( $use_usage ? ('recurring', 'usage') : ('') ) {
+    foreach my $component ( @components ) {
 
       push @items, 'cust_bill_pkg';
 
@@ -118,20 +143,22 @@ foreach my $agent ( $all_agent || $sel_agent || qsearch('agent', { 'disabled' =>
             ? ( ref($pkg_class) ? $pkg_class->classname : $pkg_class ) 
             : ''
         ).
-        " $component";
+        ' '.$charge_labels{$component};
 
       my $row_classnum = ref($pkg_class) ? $pkg_class->classnum : 0;
       my $row_agentnum = $all_agent || $agent->agentnum;
       push @params, [ ($all_class ? () : ('classnum' => $row_classnum) ),
                       ($all_agent ? () : ('agentnum' => $row_agentnum) ),
                       'use_override'         => $use_override,
-                      'use_usage'            => $component,
+                      'charges'              => $component,
                       'average_per_cust_pkg' => $average_per_cust_pkg,
+                      'distribute'           => $distribute,
                     ];
 
       push @links, "$link;".($all_agent ? '' : "agentnum=$row_agentnum;").
                    ($all_class ? '' : "classnum=$row_classnum;").
-                   "use_override=$use_override;use_usage=$component;";
+                   "distribute=$distribute;".
+                   "use_override=$use_override;charges=$component;";
 
       @recur_colors = ($col_scheme->colors)[0,4,8,1,5,9]
         unless @recur_colors;
@@ -147,5 +174,7 @@ foreach my $agent ( $all_agent || $sel_agent || qsearch('agent', { 'disabled' =>
 }
 
 #use Data::Dumper;
-
+if ( $cgi->param('debug') == 1 ) {
+  $FS::Report::Table::DEBUG = 1;
+}
 </%init>

diff --git a/httemplate/graph/elements/monthly.html b/httemplate/graph/elements/monthly.html
index a451ea8..99db31e 100644 (file)
--- a/httemplate/graph/elements/monthly.html
+++ b/httemplate/graph/elements/monthly.html
@@ -64,6 +64,7 @@ Example:
 <%init>
 
 my(%opt) = @_;
+$opt{'debug'} ||= $cgi->param('debug');
 
 my $conf = new FS::Conf;
 my $money_char = $opt{'disable_money'} ? '' : $conf->config('money_char');
@@ -115,15 +116,27 @@ my %reportopts = (
       'doublemonths' => $opt{'doublemonths'},
 );
 
+warn Dumper({ 'REPORTOPTS' => \%reportopts }) if $opt{'debug'};
+
 my $report;
 $report = new FS::Report::Table::Daily(%reportopts) if $opt{'daily'};
 $report = new FS::Report::Table::Monthly(%reportopts) unless $opt{'daily'};
 my $data = $report->data;
 
+warn Dumper({'DATA' => $data}) if $opt{'debug'};
+
 my $col_labels = [ map { my $m = $_; $m =~ s/^(\d+)\//$mon[$1-1] / ; $m }
                              @{$data->{label}} ];
 $col_labels = $data->{label} if $opt{'daily'};
 
+if ( $opt{'remove_empty'} ) {
+  # need to filter out series labels for collapsed rows
+  $opt{'graph_labels'} = [ 
+    map { $opt{'graph_labels'}[$_] } 
+    @{ $data->{indices} }
+  ];
+}
+
 my @links;
 foreach my $link (@{ $data->{'links'} }) {
   my @speriod = @{$data->{'speriod'}};

diff --git a/httemplate/graph/report_cust_bill_pkg.html b/httemplate/graph/report_cust_bill_pkg.html
index 3487465..af61dda 100644 (file)
--- a/httemplate/graph/report_cust_bill_pkg.html
+++ b/httemplate/graph/report_cust_bill_pkg.html
@@ -28,19 +28,28 @@
 </TR>
 -->
 
+% foreach ( qw(Setup Usage) ) {
+<& /elements/tr-select.html,
+    'label'   => "$_ fees",
+    'field'   => 'use_'.lc($_),
+    'options' => [ 0, 1, 2 ],
+    'labels'  => { 0 => 'Combine', 1 => 'Separate', 2 => 'Do not show' },
+&>
+% }
+
 <TR>
   <TD ALIGN="right"><INPUT TYPE="checkbox" NAME="use_override" VALUE="1"></TD>
   <TD>Separate sub-packages from parents</TD>
 </TR>
 
 <TR>
-  <TD ALIGN="right"><INPUT TYPE="checkbox" NAME="use_usage" VALUE="1"></TD>
-  <TD>Separate rated usage from recurring fees</TD>
+  <TD ALIGN="right"><INPUT TYPE="checkbox" NAME="average_per_cust_pkg" VALUE="1"></TD>
+  <TD>Average per customer package</TD>
 </TR>
 
 <TR>
-  <TD ALIGN="right"><INPUT TYPE="checkbox" NAME="average_per_cust_pkg" VALUE="1"></TD>
-  <TD>Average per customer package</TD>
+  <TD ALIGN="right"><INPUT TYPE="checkbox" NAME="distribute" VALUE="1"></TD>
+  <TD>Distribute recurring fees over billing period</TD>
 </TR>
 
 </TABLE>

diff --git a/httemplate/search/cust_bill_pkg.cgi b/httemplate/search/cust_bill_pkg.cgi
index 13fb9f8..94860d3 100644 (file)
--- a/httemplate/search/cust_bill_pkg.cgi
+++ b/httemplate/search/cust_bill_pkg.cgi
@@ -145,8 +145,16 @@ my $agentnums_sql =
 my @where = ( $agentnums_sql );
 
 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
-push @where, "_date >= $beginning",
-             "_date <= $ending";
+
+if ( $cgi->param('distribute') == 1 ) {
+  push @where, "sdate <= $ending",
+               "edate >  $beginning",
+  ;
+}
+else {
+  push @where, "_date >= $beginning",
+               "_date <= $ending";
+}
 
 if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) {
   push @where, "cust_main.agentnum = $1";