use vars qw( @ISA $DEBUG );
use FS::Report;
use Time::Local qw( timelocal );
-use FS::UID qw( dbh );
+use FS::UID qw( dbh driver_name );
use FS::Report::Table;
use FS::CurrentUser;
interval and return that fraction of the recurring charges. This is
somewhat experimental.
+'project': enable if this is a projected period. This is very experimental.
+
=cut
sub cust_bill_pkg {
$sum;
}
-my $cust_bill_pkg_from =
- ' cust_bill_pkg
+my $cust_bill_pkg_join = '
LEFT JOIN cust_bill USING ( invnum )
LEFT JOIN cust_main USING ( custnum )
LEFT JOIN cust_pkg USING ( pkgnum )
sub cust_bill_pkg_setup {
my $self = shift;
my ($speriod, $eperiod, $agentnum, %opt) = @_;
+ # no projecting setup fees--use real invoices only
+ # but evaluate this anyway, because the design of projection is that
+ # if there are somehow real setup fees in the future, we want to count
+ # them
$agentnum ||= $opt{'agentnum'};
);
my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0)
- FROM $cust_bill_pkg_from
+ FROM cust_bill_pkg
+ $cust_bill_pkg_join
WHERE " . join(' AND ', grep $_, @where);
$self->scalar_sql($total_sql);
my ($speriod, $eperiod, $agentnum, %opt) = @_;
$agentnum ||= $opt{'agentnum'};
+ my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg';
my @where = (
'pkgnum != 0',
);
# 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 $item_usage;
+ if ( $opt{'project'} ) {
+ $item_usage = 'usage'; #already calculated
+ }
+ else {
+ $item_usage = '( SELECT COALESCE(SUM(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",
+ "$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)";
+ CAST(LEAST($eperiod, $cust_bill_pkg.edate) -
+ GREATEST($speriod, $cust_bill_pkg.sdate) AS DECIMAL) /
+ ($cust_bill_pkg.edate - $cust_bill_pkg.sdate)";
}
else {
+ # we don't want to have to create v_cust_bill
+ my $_date = $opt{'project'} ? 'v_cust_bill_pkg._date' : 'cust_bill._date';
push @where,
- $self->in_time_period_and_agent($speriod, $eperiod, $agentnum);
+ $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, $_date);
}
- my $total_sql = "SELECT COALESCE(SUM(
- (cust_bill_pkg.recur - $item_usage) $recur_fraction),0)
- FROM $cust_bill_pkg_from
+ my $total_sql = 'SELECT '.
+ "COALESCE(SUM(($cust_bill_pkg.recur - $item_usage) $recur_fraction),0)
+ FROM $cust_bill_pkg
+ $cust_bill_pkg_join
WHERE ".join(' AND ', grep $_, @where);
$self->scalar_sql($total_sql);
=back
+=head1 METHODS
+
+=over 4
+
+=item init_projection
+
+Sets up for future projection of all observables on the report. Currently
+this is limited to 'cust_bill_pkg'.
+
+=cut
+
+sub init_projection {
+ # this is weird special case stuff--some redesign may be needed
+ # to use it for anything else
+ my $self = shift;
+
+ if ( driver_name ne 'Pg' ) {
+ # also database-specific for now
+ die "projection reports not supported on this platform";
+ }
+
+ my %items = map {$_ => 1} @{ $self->{items} };
+ if ($items{'cust_bill_pkg'}) {
+ my $dbh = dbh;
+ # v_ for 'virtual'
+ my @sql = (
+ # could use TEMPORARY TABLE but we're already transaction-protected
+ 'DROP TABLE IF EXISTS v_cust_bill_pkg',
+ 'CREATE TABLE v_cust_bill_pkg ' .
+ '(LIKE cust_bill_pkg,
+ usage numeric(10,2), _date integer, expire integer)',
+ # XXX this should be smart enough to take only the ones with
+ # sdate/edate overlapping the ROI, for performance
+ "INSERT INTO v_cust_bill_pkg (
+ SELECT cust_bill_pkg.*,
+ (SELECT COALESCE(SUM(amount),0) FROM cust_bill_pkg_detail
+ WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum),
+ cust_bill._date,
+ cust_pkg.expire
+ FROM cust_bill_pkg $cust_bill_pkg_join
+ )",
+ );
+ foreach my $sql (@sql) {
+ warn "[init_projection] $sql\n" if $DEBUG;
+ $dbh->do($sql) or die $dbh->errstr;
+ }
+ }
+}
+
+=item extend_projection START END
+
+Generates data for the next period of projection. This will be called
+for sequential periods where the END of one equals the START of the next
+(with no gaps).
+
+=cut
+
+sub extend_projection {
+ my $self = shift;
+ my ($speriod, $eperiod) = @_;
+ my %items = map {$_ => 1} @{ $self->{items} };
+ if ($items{'cust_bill_pkg'}) {
+ # append, head-to-tail, new line items identical to any that end within the
+ # period (and aren't expiring)
+ my @fields = ( FS::cust_bill_pkg->fields, qw( usage _date expire ) );
+ my $insert_fields = join(',', @fields);
+ #advance (sdate, edate) by one billing period
+ foreach (@fields) {
+ if ($_ eq 'edate') {
+ $_ = '(edate + (edate - sdate)) AS edate' #careful of integer overflow
+ }
+ elsif ($_ eq 'sdate') {
+ $_ = 'edate AS sdate'
+ }
+ elsif ($_ eq 'setup') {
+ $_ = '0 AS setup' #because recurring only
+ }
+ elsif ($_ eq '_date') {
+ $_ = '(_date + (edate - sdate)) AS _date'
+ }
+ }
+ my $select_fields = join(',', @fields);
+ my $dbh = dbh;
+ my $sql =
+ "INSERT INTO v_cust_bill_pkg ($insert_fields)
+ SELECT $select_fields FROM v_cust_bill_pkg
+ WHERE edate >= $speriod AND edate < $eperiod
+ AND recur > 0
+ AND (expire IS NULL OR expire > edate)";
+ warn "[extend_projection] $sql\n" if $DEBUG;
+ my $rows = $dbh->do($sql) or die $dbh->errstr;
+ warn "[extend_projection] $rows rows\n" if $DEBUG;
+ }
+}
+
=head1 BUGS
Documentation.
use strict;
use vars qw( @ISA );
+use FS::UID qw(dbh);
use FS::Report::Table;
use Time::Local qw( timelocal );
=cut
sub data {
+ local $FS::UID::AutoCommit = 0;
my $self = shift;
- my $smonth = $self->{'start_month'};
- my $syear = $self->{'start_year'};
- my $emonth = $self->{'end_month'};
- my $eyear = $self->{'end_year'};
+ my $smonth = $self->{'start_month'};
+ my $syear = $self->{'start_year'};
+ my $emonth = $self->{'end_month'};
+ my $eyear = $self->{'end_year'};
+ # how far to extrapolate into the future
+ my $pmonth = $self->{'project_month'};
+ my $pyear = $self->{'project_year'};
+
+ # sanity checks
+ if ( $eyear < $syear or
+ ($eyear == $syear and $emonth < $smonth) ) {
+ return { error => 'Start month must be before end month' };
+ }
+
my $agentnum = $self->{'agentnum'};
+ if ( $pyear > $eyear or
+ ($pyear == $eyear and $pmonth > $emonth) ) {
+
+ # create the entire projection set first to avoid timing problems
+
+ $self->init_projection if $pmonth;
+
+ my $thisyear = $eyear;
+ my $thismonth = $emonth;
+ while ( $thisyear < $pyear ||
+ ( $thisyear == $pyear and $thismonth <= $pmonth )
+ ) {
+ my $speriod = timelocal(0,0,0,1,$thismonth-1,$thisyear);
+ $thismonth++;
+ if ( $thismonth == 13 ) { $thisyear++; $thismonth = 1; }
+ my $eperiod = timelocal(0,0,0,1,$thismonth-1,$thisyear);
+
+ $self->extend_projection($speriod, $eperiod);
+ }
+ }
+
my %data;
- while ( $syear < $eyear || ( $syear == $eyear && $smonth < $emonth+1 ) ) {
+ my $max_year = $pyear || $eyear;
+ my $max_month = $pmonth || $emonth;
+
+ my $projecting = 0; # are we currently projecting?
+
+ 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";
+ 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";
+ }
+
+ if ( $syear > $eyear || ( $syear == $eyear && $smonth >= $emonth + 1 ) ) {
+ # start getting data from the projection
+ $projecting = 1;
}
my $speriod = timelocal(0,0,0,1,$smonth-1,$syear);
if ( ++$smonth == 13 ) { $syear++; $smonth=1; }
my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear);
push @{$data{eperiod}}, $eperiod;
-
+
my $col = 0;
my @items = @{$self->{'items'}};
my $i;
+
for ( $i = 0; $i < scalar(@items); $i++ ) {
if ( $self->{'doublemonths'} ) {
- my $item = $items[$i];
- my @param = $self->{'params'} ? @{ $self->{'params'}[$i] }: ();
- my $value = $self->$item($speriod, $eperiod, $agentnum, @param);
- push @{$data{data}->[$col]}, $value;
- $item = $items[$i+1];
- @param = $self->{'params'} ? @{ $self->{'params'}[++$i] }: ();
- $value = $self->$item($speriod, $eperiod, $agentnum, @param);
- push @{$data{data}->[$col++]}, $value;
+ my $item = $items[$i];
+ my @param = $self->{'params'} ? @{ $self->{'params'}[$i] }: ();
+ push @param, 'project', $projecting;
+ 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;
+ $value = $self->$item($speriod, $eperiod, $agentnum, @param);
+ push @{$data{data}->[$col++]}, $value;
}
else {
- my $item = $items[$i];
- my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: ();
- my $value = $self->$item($speriod, $eperiod, $agentnum, @param);
- push @{$data{data}->[$col++]}, $value;
+ my $item = $items[$i];
+ my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: ();
+ push @param, 'project', $projecting;
+ my $value = $self->$item($speriod, $eperiod, $agentnum, @param);
+ push @{$data{data}->[$col++]}, $value;
}
}
$data{'indices'} = \@indices;
}
+ # clean up after ourselves
+ dbh->rollback;
+ # may be useful for debugging
+ #dbh->commit;
\%data;
}
$opt{'end_month'} ||= $cgi->param('end_month'); # || $curmon+1;
$opt{'end_year'} ||= $cgi->param('end_year'); # || 1900+$curyear;
+#find end of projection
+$opt{'project_month'} ||= $cgi->param('project_month') || 0;
+$opt{'project_year'} ||= $cgi->param('project_year') || 0;
+# setting these to zero prevents projection on reports that don't support it
+
if ( $opt{'daily'} ) { # daily granularity
$opt{'start_day'} ||= $cgi->param('start_day');
$opt{'end_day'} ||= $cgi->param('end_day');
'end_day' => $opt{'end_day'},
'end_month' => $opt{'end_month'},
'end_year' => $opt{'end_year'},
+ 'project_day' => $opt{'project_day'},
+ 'project_month' => $opt{'project_month'},
+ 'project_year' => $opt{'project_year'},
'agentnum' => $opt{'agentnum'},
'remove_empty' => $opt{'remove_empty'},
'doublemonths' => $opt{'doublemonths'},
warn Dumper({'DATA' => $data}) if $opt{'debug'};
+if ( $data->{'error'} ) {
+ die $data->{'error'}; # could be smarter
+}
+
my $col_labels = [ map { my $m = $_; $m =~ s/^(\d+)\//$mon[$1-1] / ; $m }
@{$data->{label}} ];
$col_labels = $data->{label} if $opt{'daily'};
% );
%
% http_header('Content-Type' => 'image/png' );
+% http_header('Cache-Control' => 'no-cache' );
%
% $chart->_set_colors();
%
<% $chart->scalar_png([ $opt{'axis_labels'}, @data ]) %>
%
% } else {
+% # image and download links should use the cached data
+% # just directly reference this component
+% my $myself = $p.'graph/elements/report.html?session='.$session;
%
<% include('/elements/header.html', $opt{'title'} ) %>
% unless ( $opt{'graph_type'} eq 'none' ) {
-% $cgi->param('_type', 'png');
-<IMG SRC="<% $cgi->self_url %>" WIDTH="976" HEIGHT="384">
+<IMG SRC="<% "$myself;_type=png" %>" WIDTH="976" HEIGHT="384">
% }
<P ALIGN="right">
% unless ( $opt{'disable_download'} ) {
-% $cgi->param('_type', "xls" );
Download full results<BR>
- as <A HREF="<% $cgi->self_url %>">Excel spreadsheet</A><BR>
-% $cgi->param('_type', 'csv');
- as <A HREF="<% $cgi->self_url %>">CSV file</A></P>
-% $cgi->param('_type', "html" );
+ as <A HREF="<% "$myself;_type=xls" %>">Excel spreadsheet</A><BR>
+ as <A HREF="<% "$myself;_type=csv" %>">CSV file</A></P>
% }
%
</P>
<%init>
my(%opt) = @_;
+my $session;
+# load from cache if possible, to avoid recalculating
+if ( $cgi->param('session') =~ /^(\d+)$/ ) {
+ $session = $1;
+ %opt = %{ $m->cache->get($session) };
+}
+else {
+ $session = sprintf("%10d%6d", time, int(rand(1000000)));
+ $m->cache->set($session, \%opt, '1h');
+}
my $sprintf = $opt{'sprintf'} || '%.2f';
<% include('/elements/tr-select-from_to.html' ) %>
+<TR>
+ <TD ALIGN="right">Project to:</TD>
+ <TD><& /elements/select-month_year.html,
+ prefix => 'project',
+ show_month_abbr => 1 &></TD>
+</TR>
+
<% include('/elements/tr-select-agent.html',
'label' => 'For agent: ',
'disable_empty' => 0,
projects / freeside.git / commitdiff