From c1fa2b017e4f7d79e47e4e2257f17cf8a3d0c84b Mon Sep 17 00:00:00 2001 From: mark Date: Tue, 10 Jan 2012 18:38:44 +0000 Subject: [PATCH] projected sales report, #15393 --- FS/FS/Report/Table.pm | 408 +++++++++++++++++++++++------ FS/FS/Report/Table/Monthly.pm | 101 +++++-- httemplate/graph/cust_bill_pkg.cgi | 41 ++- httemplate/graph/elements/monthly.html | 25 ++ httemplate/graph/elements/report.html | 24 +- httemplate/graph/report_cust_bill_pkg.html | 24 +- httemplate/search/cust_bill_pkg.cgi | 12 +- 7 files changed, 518 insertions(+), 117 deletions(-) diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm index 113bf8d9e..b5805e37f 100644 --- a/FS/FS/Report/Table.pm +++ b/FS/FS/Report/Table.pm @@ -4,7 +4,7 @@ use strict; 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; @@ -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,158 @@ 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. + +'project': enable if this is a projected period. This is very 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_join = ' + 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) = @_; + # 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 + 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 + $cust_bill_pkg_join + 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 $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg'; + + 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; + 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", + ; + # 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 { + # 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, $_date); + } + + 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); } +=item cust_bill_pkg_detail: the total usage charges in detail lines. + +Arguments as for C, 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 +493,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 +596,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; @@ -482,6 +643,101 @@ sub scalar_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. diff --git a/FS/FS/Report/Table/Monthly.pm b/FS/FS/Report/Table/Monthly.pm index f57fb064b..802d88312 100644 --- a/FS/FS/Report/Table/Monthly.pm +++ b/FS/FS/Report/Table/Monthly.pm @@ -2,6 +2,7 @@ package FS::Report::Table::Monthly; use strict; use vars qw( @ISA ); +use FS::UID qw(dbh); use FS::Report::Table; use Time::Local qw( timelocal ); @@ -41,25 +42,68 @@ Returns a hashref of data (!! describe) =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); @@ -67,26 +111,30 @@ sub data { 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; } } @@ -102,11 +150,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 +166,7 @@ sub data { push @newdata, $data{'data'}->[$col]; push @newcolors, $data{'colors'}->[$col]; push @newlinks, $data{'links'}->[$col]; + push @indices, $col; } $col++; @@ -125,8 +177,13 @@ sub data { $data{'data'} = \@newdata; $data{'colors'} = \@newcolors; $data{'links'} = \@newlinks; + $data{'indices'} = \@indices; } + # clean up after ourselves + dbh->rollback; + # may be useful for debugging + #dbh->commit; \%data; } diff --git a/httemplate/graph/cust_bill_pkg.cgi b/httemplate/graph/cust_bill_pkg.cgi index 03e29b901..af4d045fe 100644 --- 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; +} diff --git a/httemplate/graph/elements/monthly.html b/httemplate/graph/elements/monthly.html index a451ea8ff..275e5e6ff 100644 --- 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'); @@ -89,6 +90,11 @@ $opt{'start_year'} ||= $cgi->param('start_year'); # || 1899+$curyear; $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'); @@ -110,20 +116,39 @@ my %reportopts = ( '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({ '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'}; + +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'}; +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/elements/report.html b/httemplate/graph/elements/report.html index 2be511aec..3773fbf1d 100644 --- a/httemplate/graph/elements/report.html +++ b/httemplate/graph/elements/report.html @@ -155,28 +155,28 @@ any delimiter and linked from the elements in @data. % ); % % 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'); - +" WIDTH="976" HEIGHT="384"> % }

% unless ( $opt{'disable_download'} ) { -% $cgi->param('_type', "xls" ); Download full results
- as Excel spreadsheet
-% $cgi->param('_type', 'csv'); - as CSV file

-% $cgi->param('_type', "html" ); + as ">Excel spreadsheet
+ as ">CSV file

% } %

@@ -271,6 +271,16 @@ any delimiter and linked from the elements in @data. <%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'; diff --git a/httemplate/graph/report_cust_bill_pkg.html b/httemplate/graph/report_cust_bill_pkg.html index 348746514..f2c486cf4 100644 --- a/httemplate/graph/report_cust_bill_pkg.html +++ b/httemplate/graph/report_cust_bill_pkg.html @@ -6,6 +6,13 @@ <% include('/elements/tr-select-from_to.html' ) %> + + Project to: + <& /elements/select-month_year.html, + prefix => 'project', + show_month_abbr => 1 &> + + <% include('/elements/tr-select-agent.html', 'label' => 'For agent: ', 'disable_empty' => 0, @@ -28,19 +35,28 @@ --> +% 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' }, +&> +% } + Separate sub-packages from parents - - Separate rated usage from recurring fees + + Average per customer package - - Average per customer package + + Distribute recurring fees over billing period diff --git a/httemplate/search/cust_bill_pkg.cgi b/httemplate/search/cust_bill_pkg.cgi index 13fb9f836..94860d3f2 100644 --- 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"; -- 2.11.0