diff options
Diffstat (limited to 'FS')
| -rw-r--r-- | FS/FS/Report/Table.pm | 408 | ||||
| -rw-r--r-- | FS/FS/Report/Table/Monthly.pm | 101 |
2 files changed, 411 insertions, 98 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<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 +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; } |