[freeside-commits] branch master updated. 044e4ea5533f1c14697b7ad408dc0cf0e0327abb
Mark Wells
mark at 420.am
Mon Nov 19 14:37:03 PST 2012
The branch, master has been updated
via 044e4ea5533f1c14697b7ad408dc0cf0e0327abb (commit)
from c673787bf1ac56408e589ed20ea63404e9181574 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 044e4ea5533f1c14697b7ad408dc0cf0e0327abb
Author: Mark Wells <mark at freeside.biz>
Date: Mon Nov 19 14:35:10 2012 -0800
separate one-time from recurring charges in Customer Accounting Summary, #19732
diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm
index 73eed6e..6969406 100644
--- a/FS/FS/Report/Table.pm
+++ b/FS/FS/Report/Table.pm
@@ -68,9 +68,15 @@ sub signups {
sub invoiced { #invoiced
my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
+ my $sql = 'SELECT SUM(cust_bill.charged) FROM cust_bill';
+ if ( $opt{'setuprecur'} ) {
+ $sql = 'SELECT SUM('.
+ FS::cust_bill_pkg->charged_sql($speriod, $eperiod, %opt).
+ ') FROM cust_bill_pkg JOIN cust_bill USING (invnum)';
+ }
+
$self->scalar_sql("
- SELECT SUM(charged)
- FROM cust_bill
+ $sql
LEFT JOIN cust_main USING ( custnum )
WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
$self->for_opts(%opt)
@@ -162,9 +168,16 @@ sub refunds {
sub netcredits {
my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
+
+ my $sql = 'SELECT SUM(cust_credit_bill.amount) FROM cust_credit_bill';
+ if ( $opt{'setuprecur'} ) {
+ $sql = 'SELECT SUM('.
+ FS::cust_bill_pkg->credited_sql($speriod, $eperiod, %opt).
+ ') FROM cust_bill_pkg';
+ }
+
$self->scalar_sql("
- SELECT SUM(cust_credit_bill.amount)
- FROM cust_credit_bill
+ $sql
LEFT JOIN cust_bill USING ( invnum )
LEFT JOIN cust_main USING ( custnum )
WHERE ". $self->in_time_period_and_agent( $speriod,
@@ -182,9 +195,16 @@ sub netcredits {
sub receipts { #net payments
my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
+
+ my $sql = 'SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay';
+ if ( $opt{'setuprecur'} ) {
+ $sql = 'SELECT SUM('.
+ FS::cust_bill_pkg->paid_sql($speriod, $eperiod, %opt).
+ ') FROM cust_bill_pkg';
+ }
+
$self->scalar_sql("
- SELECT SUM(cust_bill_pay.amount)
- FROM cust_bill_pay
+ $sql
LEFT JOIN cust_bill USING ( invnum )
LEFT JOIN cust_main USING ( custnum )
WHERE ". $self->in_time_period_and_agent( $speriod,
@@ -419,7 +439,7 @@ sub cust_bill_pkg_setup {
$self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
);
- push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'};
+ push @where, "cust_main.refnum = ". $opt{'refnum'} if $opt{'refnum'};
my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0)
FROM cust_bill_pkg
diff --git a/FS/FS/Report/Table/Monthly.pm b/FS/FS/Report/Table/Monthly.pm
index 86ab19b..ee4dc5f 100644
--- a/FS/FS/Report/Table/Monthly.pm
+++ b/FS/FS/Report/Table/Monthly.pm
@@ -32,13 +32,91 @@ FS::Report::Table::Monthly - Tables of report data, indexed monthly
my $data = $report->data;
-=head1 METHODS
+=head1 PARAMETERS
+
+=head2 TIME PERIOD
+
+C<start_month>, C<start_year>, C<end_month>, and C<end_year> specify the date
+range to be included in the report. The start and end months are included.
+Each month's values are summed from midnight on the first of the month to
+23:59:59 on the last day of the month.
+
+=head2 REPORT ITEMS
+
+=over 4
+
+=item items: An arrayref of observables to calculate for each month. See
+L<FS::Report::Table> for a list of observables and their parameters.
+
+=item params: An arrayref, parallel to C<items>, of arrayrefs of parameters
+(in paired name/value form) to be passed to the observables.
+
+=item cross_params: Cross-product parameters. This must be an arrayref of
+arrayrefs of parameters (paired name/value form). This creates an additional
+"axis" (orthogonal to the time and C<items> axes) in which the item is
+calculated once with each set of parameters in C<cross_params>. These
+parameters are merged with those in C<params>. Instead of being nested two
+levels, C<data> will be nested three levels, with the third level
+corresponding to this arrayref.
+
+=back
+
+=head2 FILTERING
+
+=over 4
+
+=item agentnum: Limit to customers with this agent.
+
+=item refnum: Limit to customers with this advertising source.
+
+=item remove_empty: Set this to a true value to hide rows that contain
+only zeroes. The C<indices> array in the returned data will list the item
+indices that are actually present in the output so that you know what they
+are. Ignored if C<cross_params> is in effect.
+
+=back
+
+=head2 PASS-THROUGH
+
+C<item_labels>, C<colors>, and C<links> may be specified as arrayrefs
+parallel to C<items>. Those values will be returned in C<data>, with any
+hidden rows (due to C<remove_empty>) filtered out, which is the only
+reason to do this. Now that we have C<indices> it's probably better to
+use that.
+
+=head1 RETURNED DATA
+
+The C<data> method runs the report and returns a hashref of the following:
=over 4
+=item label
+
+Month labels, in MM/YYYY format.
+
+=item speriod, eperiod
+
+Absolute start and end times of each month, in unix time format.
+
+=item items
+
+The values passed in as C<items>, with any suppressed rows deleted.
+
+=item indices
+
+The indices of items in the input C<items> list that appear in the result
+set. Useful for figuring out what they are when C<remove_empty> has deleted
+some items.
+
+=item item_labels, colors, links - see PASS-THROUGH above
+
=item data
-Returns a hashref of data (!! describe)
+The actual results. An arrayref corresponding to C<label> (the time axis),
+containing arrayrefs corresponding to C<items>, containing either numbers
+or, if C<cross_params> is given, arrayrefs corresponding to C<cross_params>.
+
+=back
=cut
@@ -88,14 +166,7 @@ sub data {
while ( $syear < $max_year
|| ( $syear == $max_year && $smonth < $max_month+1 ) ) {
- if ( $self->{'doublemonths'} ) {
- my($firstLabel,$secondLabel) = @{$self->{'doublemonths'}};
- push @{$data{label}}, "$smonth/$syear $firstLabel";
- push @{$data{label}}, "$smonth/$syear $secondLabel";
- }
- else {
- push @{$data{label}}, "$smonth/$syear";
- }
+ push @{$data{label}}, "$smonth/$syear"; # sprintf?
my $speriod = timelocal(0,0,0,1,$smonth-1,$syear);
push @{$data{speriod}}, $speriod;
@@ -108,30 +179,26 @@ sub data {
my $i;
for ( $i = 0; $i < scalar(@items); $i++ ) {
- if ( $self->{'doublemonths'} ) {
- my $item = $items[$i];
- my @param = $self->{'params'} ? @{ $self->{'params'}[$i] }: ();
- push @param, 'project', $projecting;
- push @param, 'refnum' => $refnum if $refnum;
- my $value = $self->$item($speriod, $eperiod, $agentnum, @param);
- push @{$data{data}->[$col]}, $value;
- $item = $items[$i+1];
- @param = $self->{'params'} ? @{ $self->{'params'}[++$i] }: ();
- push @param, 'project', $projecting;
- push @param, 'refnum' => $refnum if $refnum;
- $value = $self->$item($speriod, $eperiod, $agentnum, @param);
- push @{$data{data}->[$col++]}, $value;
- }
- else {
- my $item = $items[$i];
- my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: ();
- push @param, 'project', $projecting;
- push @param, 'refnum' => $refnum if $refnum;
+ my $item = $items[$i];
+ my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: ();
+ push @param, 'project', $projecting;
+ push @param, 'refnum' => $refnum if $refnum;
+
+ if ( $self->{'cross_params'} ) {
+ my @xdata;
+ foreach my $xparam (@{ $self->{'cross_params'} }) {
+ # @$xparam is a list of additional params to merge into the list
+ my $value = $self->$item($speriod, $eperiod, $agentnum,
+ @param,
+ @$xparam);
+ push @xdata, $value;
+ }
+ push @{$data{data}->[$col++]}, \@xdata;
+ } else {
my $value = $self->$item($speriod, $eperiod, $agentnum, @param);
push @{$data{data}->[$col++]}, $value;
}
}
-
}
#these need to get generalized, sheesh
@@ -140,7 +207,7 @@ sub data {
$data{'colors'} = $self->{'colors'};
$data{'links'} = $self->{'links'} || [];
- if ( $self->{'remove_empty'} ) {
+ if ( !$self->{'cross_params'} and $self->{'remove_empty'} ) {
my $col = 0;
#these need to get generalized, sheesh
@@ -186,8 +253,6 @@ sub data {
=head1 BUGS
-Documentation.
-
=head1 SEE ALSO
=cut
diff --git a/httemplate/search/customer_accounting_summary.html b/httemplate/search/customer_accounting_summary.html
index 72a00ed..5ce2e3a 100644
--- a/httemplate/search/customer_accounting_summary.html
+++ b/httemplate/search/customer_accounting_summary.html
@@ -1,25 +1,124 @@
-<% include('/graph/elements/monthly.html',
- #Dumper(
- 'title' => $title,
- 'graph_type' => 'none',
- 'items' => \@items,
- 'params' => \@params,
- 'labels' => \@labels,
- 'graph_labels' => \@labels,
- 'remove_empty' => 1,
- 'bottom_total' => 1,
- 'agentnum' => $agentnum,
- 'doublemonths' => \@doublemonths,
- 'nototal' => 1,
- )
-%>
+% if ( $cgi->param('_type') =~ /(xls)$/ ) {
+<%perl>
+ # egregious false laziness w/ search/report_tax-xls.cgi
+ my $format = $FS::CurrentUser::CurrentUser->spreadsheet_format;
+ my $filename = $cgi->url(-relative => 1);
+ $filename =~ s/\.html$//;
+ $filename .= $format->{extension};
+ http_header('Content-Type' => $format->{mime_type});
+ http_header('Content-Disposition' => qq!attachment;filename="$filename"!);
+
+ my $output = '';
+ use IO::String;
+ my $XLS = IO::String->new($output);;
+ my $workbook = $format->{class}->new($XLS)
+ or die "Error opening .xls file: $!";
+
+ my $worksheet = $workbook->add_worksheet('Summary');
+
+ my %format = (
+ header => {
+ size => 11,
+ bold => 1,
+ align => 'center',
+ valign => 'vcenter',
+ text_wrap => 1,
+ },
+ money => {
+ size => 11,
+ align => 'right',
+ valign => 'bottom',
+ num_format=> 8,
+ },
+ '' => {},
+ );
+ my %default = (
+ font => 'Calibri',
+ border => 1,
+ );
+ foreach (keys %format) {
+ my %f = (%default, %{$format{$_}});
+ $format{$_} = $workbook->add_format(%f);
+ $format{"m_$_"} = $workbook->add_format(%f);
+ }
+
+ my ($r, $c) = (0, 0);
+ for my $row (@rows) {
+ $c = 0;
+ my $thisrow = shift @cells;
+ for my $cell (@$thisrow) {
+ if (!ref($cell)) {
+ # placeholder, so increment $c so that we write to the correct place
+ $c++;
+ next;
+ }
+ # format name
+ my $f = '';
+ $f = 'header' if $row->{header} or $cell->{header};
+ $f = 'money' if $cell->{format} eq 'money';
+ if ( $cell->{rowspan} > 1 or $cell->{colspan} > 1 ) {
+ my $range = xl_range_formula(
+ 'Summary',
+ $r, $r - 1 + ($cell->{rowspan} || 1),
+ $c, $c - 1 + ($cell->{colspan} || 1)
+ );
+ #warn "merging $range\n";
+ $worksheet->merge_range($range, $cell->{value}, $format{"m_$f"});
+ } else {
+ #warn "writing ".xl_rowcol_to_cell($r, $c)."\n";
+ $worksheet->write( $r, $c, $cell->{value}, $format{$f} );
+ }
+ $c++;
+ } #$cell
+ $r++;
+ } #$row
+ $workbook->close;
+</%perl>
+<% $output %>
+% } else {
+<& /elements/header.html, $title &>
+% my $myself = $cgi->self_url;
+<P ALIGN="right" CLASS="noprint">
+Download full reports<BR>
+as <A HREF="<% "$myself;_type=xls" %>">Excel spreadsheet</A><BR>
+% # as <A HREF="<% "$myself;_type=csv" %>">CSV file</A> # is this still needed?
+</P>
+<style type="text/css">
+.report * {
+ background-color: #f8f8f8;
+ border: 1px solid black;
+ padding: 2px;
+}
+.report td {
+ text-align: right;
+}
+.total * { background-color: #f5f6be; }
+.shaded * { background-color: #c8c8c8; }
+.totalshaded * { background-color: #bfc094; }
+</style>
+<table class="report" width="100%" cellspacing=0>
+% foreach my $rowinfo (@rows) {
+ <tr<% $rowinfo->{class} ? ' class="'.$rowinfo->{class}.'"' : ''%>>
+% my $thisrow = shift @cells;
+% foreach my $cell (@$thisrow) {
+% next if !ref($cell); # placeholders
+% my $td = $cell->{header} ? 'th' : 'td';
+% my $style = '';
+% $style .= " rowspan=".$cell->{rowspan} if $cell->{rowspan} > 1;
+% $style .= " colspan=".$cell->{colspan} if $cell->{colspan} > 1;
+ <<%$td%><%$style%>><% $cell->{value} %></<%$td%>>
+% }
+ </tr>
+% }
+</table>
+
+<& /elements/footer.html &>
+% }
<%init>
die "access denied"
unless $FS::CurrentUser::CurrentUser->access_right('Financial reports');
-my @doublemonths = ( 'Billed', 'Paid' );
-
my ($agentnum,$sel_agent);
if ( $cgi->param('agentnum') eq 'all' ) {
$agentnum = 0;
@@ -32,9 +131,6 @@ elsif ( $cgi->param('agentnum') =~ /^(\d+)$/ ) {
my $title = $sel_agent ? $sel_agent->agent.' ' : '';
my ($refnum,$sel_part_referral);
-#if ( $cgi->param('refnum') eq 'all' ) {
-# $refnum = 0;
-#} els
if ( $cgi->param('refnum') =~ /^(\d+)$/ ) {
$refnum = $1;
$sel_part_referral = qsearchs('part_referral', { 'refnum' => $refnum } );
@@ -46,28 +142,158 @@ $title .= $sel_part_referral->referral.' '
$title .= 'Customer Accounting Summary Report';
my @custs = ();
- at custs = qsearch('cust_main', {} );
+ at custs = qsearch('cust_main', {} );
-my @items = ();
-my @params = ();
+my @items = ('netsales', 'cashflow');
+my @params = ( [], [] );
+my $setuprecur = '';
+if ( $cgi->param('setuprecur') ) {
+ $setuprecur = 1;
+ # instead of 'cashflow' (payments - refunds), use 'receipts'
+ # (applied payments), because it's divisible into setup and recur.
+ @items = ('netsales', 'receipts', 'netsales', 'receipts');
+ @params = (
+ [ setuprecur => 'setup' ],
+ [ setuprecur => 'setup' ],
+ [ setuprecur => 'recur' ],
+ [ setuprecur => 'recur' ],
+ );
+}
my @labels = ();
+my @cross_params = ();
+my @custnames = ();
my $status = $cgi->param('status');
die "invalid status" unless $status =~ /^\w+|$/;
foreach my $cust_main ( @custs ) {
+ # XXX should do this in the qsearch
next unless ($status eq '' || $status eq $cust_main->status);
next unless ($agentnum == 0 || $cust_main->agentnum eq $agentnum);
next unless ($refnum == 0 || $cust_main->refnum eq $refnum);
- push @items, 'netsales', 'cashflow';
+ push @custnames, $cust_main->name;
- push @labels, $cust_main->name;
+ push @cross_params, [ ('custnum' => $cust_main->custnum) ];
+}
+
+my %opt = (
+ items => \@items,
+ params => \@params,
+ cross_params => \@cross_params,
+ agentnum => $agentnum,
+ refnum => $refnum,
+);
+for ( qw(start_month start_year end_month end_year) ) {
+ if ( $cgi->param($_) =~ /^(\d+)$/ ) {
+ $opt{$_} = $1;
+ }
+}
+
+warn Dumper(OPTIONS => \%opt) if $cgi->param('debug');
+my $report = FS::Report::Table::Monthly->new(%opt);
+my $data = $report->data;
+warn Dumper(DATA => $data) if $cgi->param('debug') >= 2;
+
+my @total;
+
+my @rows; # hashes of row info
+my @cells; # arrayrefs of cell info
+# We use Excel currency format, but not Excel dates, because
+# these are whole months and there's no nice way to express that.
+# This is the historical behavior for monthly reports.
+
+# header row
+$rows[0] = {};
+$cells[0] = [
+ { header => 1, rowspan => 2, colspan => ($setuprecur ? 2 : 1) },
+ ($setuprecur ? '' : ()),
+ map {
+ { header => 1, colspan => 2, value => time2str('%b %Y', $_) },
+ ''
+ } @{ $data->{speriod} }
+];
+my $ncols = scalar(@{ $data->{speriod} });
+
+$rows[1] = {};
+$cells[1] = [ '',
+ ($setuprecur ? '' : ()),
+ map {
+ ( { header => 1, value => mt('Billed') },
+ { header => 1, value => mt('Paid') }
+ ) } (1..$ncols)
+];
+
+# use PDL; # ha ha, I just might.
+my $row = 0;
+foreach my $name (@custnames) { # correspond to cross_params
+ my $skip = 1; # skip the customer iff ALL of their values are zero
+ for my $subrow (0..($setuprecur ? 1 : 0)) { # the setup/recur axis
+ push @rows, { class => $subrow ? 'shaded' : '' };
+ my @thisrow;
+ if ( $subrow == 0 ) {
+ # customer name
+ push @thisrow,
+ { value => $name,
+ header => 1,
+ rowspan => ($setuprecur ? 2 : 1) };
+ } else {
+ push @thisrow, '';
+ }
+ if ( $setuprecur ) {
+ # subheading
+ push @thisrow,
+ { value => $subrow ? mt('recurring') : mt('setup'),
+ header => 1 };
+ }
+ for my $col (0..$ncols-1) { # the month
+ for my $subcol (0..1) { # the billed/paid axis
+ my $item = $subrow * 2 + $subcol;
+ my $value = $data->{data}[$item][$col][$row];
+ $skip = 0 if abs($value) > 0.005;
+ push @thisrow, { value => sprintf('%0.2f', $value), format => 'money' };
+ $total[( ($ncols * $subrow) + $col ) * 2 + $subcol] += $value;
+ } #subcol
+ } #col
+ push @cells, \@thisrow;
+ } #subrow
+ if ( $skip ) {
+ # all values are zero--remove the rows we just added
+ pop @rows;
+ pop @cells;
+ if ( $setuprecur ) {
+ pop @rows;
+ pop @cells;
+ }
+ }
+ $row++;
+}
+for my $subrow (0..($setuprecur ? 1 : 0)) {
+ push @rows, { class => ($subrow ? 'totalshaded' : 'total') };
+ my @thisrow;
+ if ( $subrow == 0 ) {
+ push @thisrow,
+ { value => mt('Total'),
+ header => 1,
+ rowspan => ($setuprecur ? 2 : 1), };
+ } else {
+ push @thisrow, '';
+ }
+ if ( $setuprecur ) {
+ push @thisrow,
+ { value => $subrow ? mt('recurring') : mt('setup'),
+ header => 1 };
+ }
+ for my $col (0..($ncols * 2)-1) { # month and billed/paid axis
+ my $value = $total[($subrow * $ncols * 2) + $col];
+ push @thisrow, { value => sprintf('%0.2f', $value), format => 'money' };
+ }
+ push @cells, \@thisrow;
+} #subrow
- push @params, [ ('custnum' => $cust_main->custnum),
- ],
- [ ('custnum' => $cust_main->custnum),
- ];
+if ( $cgi->param('debug') >= 3 ) {
+ warn Dumper(\@rows, \@cells);
}
+my $title = 'Customer Accounting Summary';
</%init>
diff --git a/httemplate/search/report_customer_accounting_summary.html b/httemplate/search/report_customer_accounting_summary.html
index f2a13a2..537abff 100755
--- a/httemplate/search/report_customer_accounting_summary.html
+++ b/httemplate/search/report_customer_accounting_summary.html
@@ -24,6 +24,13 @@
<% include( '/elements/tr-select-cust_main-status.html',
'label' => 'Customer Status'
) %>
+
+ <& /elements/tr-checkbox.html,
+ 'label' => 'Separate setup fees',
+ 'field' => 'setuprecur',
+ 'value' => 1,
+ &>
+
</TABLE>
-----------------------------------------------------------------------
Summary of changes:
FS/FS/Report/Table.pm | 34 ++-
FS/FS/Report/Table/Monthly.pm | 131 +++++++---
httemplate/search/customer_accounting_summary.html | 284 ++++++++++++++++++--
.../search/report_customer_accounting_summary.html | 7 +
4 files changed, 387 insertions(+), 69 deletions(-)
More information about the freeside-commits
mailing list