package FS::Report::Table; use strict; use base 'FS::Report'; use Time::Local qw( timelocal ); use FS::UID qw( dbh driver_name ); use FS::Report::Table; use FS::CurrentUser; use Cache::FileCache; our $DEBUG = 0; # turning this on will trace all SQL statements, VERY noisy our $CACHE; # feel free to use this for whatever FS::UID->install_callback(sub { $CACHE = Cache::FileCache->new( { 'namespace' => __PACKAGE__, 'cache_root' => "$FS::UID::cache_dir/cache.$FS::UID::datasrc", } ); # reset this on startup (causes problems with database backups, etc.) $CACHE->remove('tower_pkg_cache_update'); }); =head1 NAME FS::Report::Table - Tables of report data =head1 SYNOPSIS 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 signups: The number of customers signed up. Options are: - cust_classnum: limit to this customer class - pkg_classnum: limit to customers with a package of this class. If this is an arrayref, it's an ANY match. - refnum: limit to this advertising source - indirect: boolean; limit to customers that have a referral_custnum that matches the advertising source =cut sub signups { my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; my @where = ( $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, 'cust_main.signupdate') ); my $join = ''; if ( $opt{'indirect'} ) { $join = " JOIN cust_main AS referring_cust_main". " ON (cust_main.referral_custnum = referring_cust_main.custnum)"; if ( $opt{'refnum'} ) { push @where, "referring_cust_main.refnum = ".$opt{'refnum'}; } } elsif ( $opt{'refnum'} ) { push @where, "refnum = ".$opt{'refnum'}; } push @where, $self->with_cust_classnum(%opt); if ( $opt{'pkg_classnum'} ) { my $classnum = $opt{'pkg_classnum'}; $classnum = [ $classnum ] unless ref $classnum; @$classnum = grep /^\d+$/, @$classnum; if (@$classnum) { my $in = 'IN ('. join(',', @$classnum). ')'; push @where, "EXISTS(SELECT 1 FROM cust_pkg JOIN part_pkg USING (pkgpart) ". "WHERE cust_pkg.custnum = cust_main.custnum ". "AND part_pkg.classnum $in". ")"; } } $self->scalar_sql( "SELECT COUNT(*) FROM cust_main $join WHERE ".join(' AND ', @where) ); } =item invoiced: The total amount charged on all invoices. =cut 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(" $sql LEFT JOIN cust_main USING ( custnum ) WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum). $self->for_opts(%opt) ); } =item netsales: invoiced - netcredits =cut sub netsales { #net sales my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; $self->invoiced( $speriod, $eperiod, $agentnum, %opt) - $self->netcredits($speriod, $eperiod, $agentnum, %opt); } =item cashflow: payments - refunds =cut sub cashflow { my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; $self->payments($speriod, $eperiod, $agentnum, %opt) - $self->refunds( $speriod, $eperiod, $agentnum, %opt); } =item netcashflow: payments - netrefunds =cut sub netcashflow { my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; $self->receipts( $speriod, $eperiod, $agentnum, %opt) - $self->netrefunds( $speriod, $eperiod, $agentnum, %opt); } =item payments: The sum of payments received in the period. =cut sub payments { my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; $self->scalar_sql(" SELECT SUM(paid) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum). $self->for_opts(%opt) ); } =item credits: The sum of credits issued in the period. =cut sub credits { my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; $self->scalar_sql(" SELECT SUM(cust_credit.amount) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum). $self->for_opts(%opt) ); } =item refunds: The sum of refunds paid in the period. =cut sub refunds { my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; $self->scalar_sql(" SELECT SUM(refund) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum). $self->for_opts(%opt) ); } =item netcredits: The sum of credit applications to invoices in the period. =cut 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(" $sql LEFT JOIN cust_bill USING ( invnum ) LEFT JOIN cust_main USING ( custnum ) WHERE ". $self->in_time_period_and_agent( $speriod, $eperiod, $agentnum, 'cust_bill._date' ). $self->for_opts(%opt) ); } =item receipts: The sum of payment applications to invoices in the period. =cut 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('. #in practice, but not appearance, paid_sql accepts end before start FS::cust_bill_pkg->paid_sql($eperiod, $speriod, %opt). ') FROM cust_bill_pkg'; } $self->scalar_sql(" $sql LEFT JOIN cust_bill USING ( invnum ) LEFT JOIN cust_main USING ( custnum ) WHERE ". $self->in_time_period_and_agent( $speriod, $eperiod, $agentnum, 'cust_bill._date' ). $self->for_opts(%opt) ); } =item netrefunds: The sum of refund applications to credits in the period. =cut sub netrefunds { my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; $self->scalar_sql(" SELECT SUM(cust_credit_refund.amount) FROM cust_credit_refund LEFT JOIN cust_credit USING ( crednum ) LEFT JOIN cust_main USING ( custnum ) WHERE ". $self->in_time_period_and_agent( $speriod, $eperiod, $agentnum, 'cust_credit._date' ). $self->for_opts(%opt) ); } =item discounted: The sum of discounts on invoices in the period. =cut sub discounted { my( $self, $speriod, $eperiod, $agentnum, %opt) = @_; my $sql = 'SELECT SUM('; if ($opt{'setuprecur'}) { # (This isn't exact but it works in most cases.) # When splitting into setup/recur values, # if the discount is allowed to apply to setup fees (discount.setup = 'Y') # then split it between the "setup" and "recurring" rows in proportion to # the "unitsetup" and "unitrecur" fields of the line item. $sql .= < 0) OR (COALESCE(cust_bill_pkg.unitrecur,0) > 0)) THEN EOF if ($opt{'setuprecur'} eq 'setup') { $sql .= ' (COALESCE(cust_bill_pkg.unitsetup,0)'; } elsif ($opt{'setuprecur'} eq 'recur') { $sql .= ' (COALESCE(cust_bill_pkg.unitrecur,0)'; } else { die 'Unrecognized value for setuprecur'; } $sql .= ' / (COALESCE(cust_bill_pkg.unitsetup,0) + COALESCE(cust_bill_pkg.unitrecur,0)))'; $sql .= " * cust_bill_pkg_discount.amount\n"; # Otherwise, show it all as "recurring" if ($opt{'setuprecur'} eq 'setup') { $sql .= " ELSE 0\n"; } elsif ($opt{'setuprecur'} eq 'recur') { $sql .= " ELSE cust_bill_pkg_discount.amount\n"; } $sql .= "END\n"; } else { # simple case, no setuprecur $sql .= "cust_bill_pkg_discount.amount\n"; } $sql .= <scalar_sql( $sql . 'WHERE ' . $self->in_time_period_and_agent( $speriod, $eperiod, $agentnum, 'cust_bill._date' ) . $self->for_opts(%opt) ); } =item gross: invoiced + discounted =cut sub gross { my( $self, $speriod, $eperiod, $agentnum, %opt) = @_; $self->invoiced( $speriod, $eperiod, $agentnum, %opt) + $self->discounted( $speriod, $eperiod, $agentnum, %opt); } #XXX docs #these should be auto-generated or $AUTOLOADed or something sub invoiced_12mo { my( $self, $speriod, $eperiod, $agentnum ) = @_; $speriod = $self->_subtract_11mo($speriod); $self->invoiced($speriod, $eperiod, $agentnum); } sub netsales_12mo { my( $self, $speriod, $eperiod, $agentnum ) = @_; $speriod = $self->_subtract_11mo($speriod); $self->netsales($speriod, $eperiod, $agentnum); } sub receipts_12mo { my( $self, $speriod, $eperiod, $agentnum ) = @_; $speriod = $self->_subtract_11mo($speriod); $self->receipts($speriod, $eperiod, $agentnum); } sub payments_12mo { my( $self, $speriod, $eperiod, $agentnum ) = @_; $speriod = $self->_subtract_11mo($speriod); $self->payments($speriod, $eperiod, $agentnum); } sub credits_12mo { my( $self, $speriod, $eperiod, $agentnum ) = @_; $speriod = $self->_subtract_11mo($speriod); $self->credits($speriod, $eperiod, $agentnum); } sub netcredits_12mo { my( $self, $speriod, $eperiod, $agentnum ) = @_; $speriod = $self->_subtract_11mo($speriod); $self->netcredits($speriod, $eperiod, $agentnum); } sub cashflow_12mo { my( $self, $speriod, $eperiod, $agentnum ) = @_; $speriod = $self->_subtract_11mo($speriod); $self->cashflow($speriod, $eperiod, $agentnum); } sub netcashflow_12mo { my( $self, $speriod, $eperiod, $agentnum ) = @_; $speriod = $self->_subtract_11mo($speriod); $self->cashflow($speriod, $eperiod, $agentnum); } sub refunds_12mo { my( $self, $speriod, $eperiod, $agentnum ) = @_; $speriod = $self->_subtract_11mo($speriod); $self->refunds($speriod, $eperiod, $agentnum); } sub netrefunds_12mo { my( $self, $speriod, $eperiod, $agentnum ) = @_; $speriod = $self->_subtract_11mo($speriod); $self->netrefunds($speriod, $eperiod, $agentnum); } #not being too bad with the false laziness sub _subtract_11mo { my($self, $time) = @_; my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5]; $mon -= 11; if ( $mon < 0 ) { $mon+=12; $year--; } timelocal($sec,$min,$hour,$mday,$mon,$year); } =item _subtract_months: subtracts the number of months from a given unix date stamp =cut sub _subtract_months { my($self, $number_of_months, $time) = @_; my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5]; $mon -= $number_of_months; if ( $mon < 0 ) { $mon+=12; $year--; } 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 = ''; if ( $opt{'classnum'} ne '' ) { my $classnums = $opt{'classnum'}; $classnums = [ $classnums ] if !ref($classnums); @$classnums = grep /^\d+$/, @$classnums; $where .= ' AND COALESCE(part_pkg.classnum,0) IN ('. join(',', @$classnums). ')'; } $agentnum ||= $opt{'agentnum'}; my $total_sql = " SELECT SUM(part_pkg.setup_cost) "; $total_sql .= " FROM cust_pkg LEFT JOIN cust_main USING ( custnum ) LEFT JOIN part_pkg USING ( pkgpart ) WHERE pkgnum != 0 $where AND ".$self->in_time_period_and_agent( $speriod, $eperiod, $agentnum, 'cust_pkg.setup'); 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 = ''; if ( $opt{'classnum'} ne '' ) { my $classnums = $opt{'classnum'}; $classnums = [ $classnums ] if !ref($classnums); @$classnums = grep /^\d+$/, @$classnums; $where .= ' AND COALESCE(part_pkg.classnum,0) IN ('. join(',', @$classnums). ')'; } $agentnum ||= $opt{'agentnum'}; # duplication of in_time_period_and_agent # because we do it a little differently here $where .= " AND cust_main.agentnum = $agentnum" if $agentnum; $where .= " AND ". $FS::CurrentUser::CurrentUser->agentnums_sql('table' => 'cust_main'); my $total_sql = " SELECT SUM(part_pkg.recur_cost) "; $total_sql .= " FROM cust_pkg LEFT JOIN cust_main USING ( custnum ) LEFT JOIN part_pkg USING ( pkgpart ) WHERE pkgnum != 0 $where AND cust_pkg.setup < $eperiod AND (cust_pkg.cancel > $speriod OR cust_pkg.cancel IS NULL) "; 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, discount, taxes). Should be a string containing one or more of 'S', 'R', or 'U'; or 'D' or 'T' (discount and taxes should not be combined with the others.) If unspecified, defaults to 'SRU'. '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. 'average_per_cust_pkg': divide the result by the number of distinct packages. '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 = shift; my( $speriod, $eperiod, $agentnum, %opt ) = @_; my %charges = map {$_=>1} split('', $opt{'charges'} || 'SRU'); 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 += $self->cust_bill_pkg_discount(@_) if $charges{D}; $sum += $self->cust_bill_pkg_taxes(@_) if $charges{T}; if ($opt{'average_per_cust_pkg'}) { my $count = $self->cust_bill_pkg_count_pkgnum(@_); return '' if $count == 0; $sum = sprintf('%.2f', $sum / $count); } $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 LEFT JOIN part_fee USING ( feepart )'; 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 @where = ( '(pkgnum != 0 OR feepart IS NOT NULL)', $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), $self->with_report_option(%opt), $self->in_time_period_and_agent($speriod, $eperiod, $agentnum), $self->with_refnum(%opt), $self->with_cust_classnum(%opt) ); my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0) FROM cust_bill_pkg $cust_bill_pkg_join WHERE " . join(' AND ', grep $_, @where); $self->scalar_sql($total_sql); } sub _cust_bill_pkg_recurring { # returns the FROM/WHERE part of the statement to query all recurring # line items in the period 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 OR feepart IS NOT NULL)', $self->with_report_option(%opt), $self->with_refnum(%opt), $self->with_cust_classnum(%opt) ); my $where_classnum = $self->with_classnum($opt{'classnum'}, $opt{'use_override'}); if ($opt{'project'}) { $where_classnum =~ s/\bcust_bill_pkg/v_cust_bill_pkg/g; } push @where, $where_classnum; if ( $opt{'distribute'} ) { $where[0] = 'pkgnum != 0'; # specifically exclude fees push @where, "cust_main.agentnum = $agentnum" if $agentnum; push @where, "$cust_bill_pkg.sdate < $eperiod", "$cust_bill_pkg.edate >= $speriod", ; } 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); } if ( $opt{'custnum'} =~ /^(\d+)$/ ) { push @where, "(cust_main.custnum = $1)"; } return " FROM $cust_bill_pkg $cust_bill_pkg_join WHERE ".join(' AND ', grep $_, @where); } =item cust_bill_pkg_recur: the total recur charges Most arguments as for C, plus: 'custnum': limit to this customer 'cost': if true, return total recur costs instead =cut sub cust_bill_pkg_recur { my $self = shift; my ($speriod, $eperiod, $agentnum, %opt) = @_; # 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(cust_bill_pkg_detail.amount),0) FROM cust_bill_pkg_detail WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum )'; } my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg'; my $recur_fraction = ''; if ($opt{'distribute'}) { # 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)"; } my $total_sql = $opt{'cost'} ? "SELECT SUM(part_pkg.recur_cost)" : "SELECT COALESCE(SUM(($cust_bill_pkg.recur - $item_usage) $recur_fraction),0)"; $total_sql .= $self->_cust_bill_pkg_recurring(@_); $self->scalar_sql($total_sql); } sub cust_bill_pkg_count_pkgnum { # for ARPU calculation my $self = shift; my $total_sql = 'SELECT COUNT(DISTINCT pkgnum) '. $self->_cust_bill_pkg_recurring(@_); $self->scalar_sql($total_sql); } =item cust_bill_pkg_detail: the total usage charges in detail lines. Most arguments as for C, plus: 'usageclass': limit to this usage class number. 'custnum': limit to this customer 'cost': if true, return total usage costs instead =cut sub cust_bill_pkg_detail { my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; my @where = ( "(cust_bill_pkg.pkgnum != 0 OR cust_bill_pkg.feepart IS NOT NULL)" ); $agentnum ||= $opt{'agentnum'}; push @where, $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), $self->with_usageclass($opt{'usageclass'}), $self->with_report_option(%opt), $self->with_refnum(%opt), $self->with_cust_classnum(%opt) ; if ( $opt{'distribute'} ) { # exclude fees $where[0] = 'cust_bill_pkg.pkgnum != 0'; # and 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' ); } if ( $opt{'custnum'} =~ /^(\d+)$/ ) { push @where, "(cust_main.custnum = $1)"; } my $total_sql = " SELECT SUM(cust_bill_pkg_detail.amount) "; my $extra_join = ''; if ($opt{'cost'}) { $extra_join = " JOIN cdr USING ( detailnum ) "; $total_sql = " SELECT SUM(cdr.rated_cost) "; } $total_sql .= " FROM cust_bill_pkg_detail LEFT JOIN cust_bill_pkg USING ( billpkgnum ) LEFT JOIN cust_bill ON cust_bill_pkg.invnum = cust_bill.invnum LEFT JOIN cust_main USING ( custnum ) 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 LEFT JOIN part_fee USING ( feepart ) ".$extra_join. " WHERE ".join( ' AND ', grep $_, @where ); $self->scalar_sql($total_sql); } =item cust_bill_pkg_discount: Discounts issued Arguments: agentnum, refnum, cust_classnum =cut sub cust_bill_pkg_discount { my $self = shift; my ($speriod, $eperiod, $agentnum, %opt) = @_; # apply all the same constraints here as for setup/recur $agentnum ||= $opt{'agentnum'}; my @where = ( '(pkgnum != 0 OR feepart IS NOT NULL)', $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), $self->with_report_option(%opt), $self->in_time_period_and_agent($speriod, $eperiod, $agentnum), $self->with_refnum(%opt), $self->with_cust_classnum(%opt) ); my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg_discount.amount), 0) FROM cust_bill_pkg_discount JOIN cust_bill_pkg USING (billpkgnum) $cust_bill_pkg_join WHERE " . join(' AND ', grep $_, @where); $self->scalar_sql($total_sql); } =item cust_bill_pkg_discount_or_waived: Discounts and waived fees issued Arguments: agentnum, refnum, cust_classnum =cut sub cust_bill_pkg_discount_or_waived { my $self = shift; my ($speriod, $eperiod, $agentnum, %opt) = @_; $agentnum ||= $opt{'agentnum'}; my $total_sql = " SELECT COALESCE( SUM( COALESCE( cust_bill_pkg_discount.amount, CAST(( SELECT optionvalue FROM part_pkg_option WHERE part_pkg_option.pkgpart = cust_pkg.pkgpart AND optionname = 'setup_fee' ) AS NUMERIC ) ) ), 0 ) FROM cust_bill_pkg LEFT JOIN cust_bill_pkg_discount USING (billpkgnum) LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum LEFT JOIN part_pkg USING (pkgpart) LEFT JOIN cust_bill USING ( invnum ) LEFT JOIN cust_main ON cust_pkg.custnum = cust_main.custnum WHERE ( cust_bill_pkg_discount.billpkgdiscountnum IS NOT NULL OR ( cust_pkg.setup = cust_bill_pkg.sdate AND cust_pkg.waive_setup = 'Y' ) ) AND cust_bill_pkg.pkgpart_override IS NULL " . join "\n", map { " AND ( $_ ) " } grep { $_ } $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), $self->with_report_option(%opt), $self->in_time_period_and_agent($speriod, $eperiod, $agentnum); $self->scalar_sql($total_sql); } sub cust_bill_pkg_taxes { my $self = shift; my ($speriod, $eperiod, $agentnum, %opt) = @_; $agentnum ||= $opt{'agentnum'}; my @where = ( '(cust_bill_pkg.pkgnum != 0 OR feepart IS NOT NULL)', $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), $self->with_report_option(%opt), $self->in_time_period_and_agent($speriod, $eperiod, $agentnum), $self->with_refnum(%opt), $self->with_cust_classnum(%opt) ); my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg_tax_location.amount),0) FROM cust_bill_pkg $cust_bill_pkg_join LEFT JOIN cust_bill_pkg_tax_location ON (cust_bill_pkg.billpkgnum = cust_bill_pkg_tax_location.taxable_billpkgnum) WHERE " . join(' AND ', grep $_, @where); $self->scalar_sql($total_sql); } #all credits applied to matching pkg line items (ie not taxes) sub cust_bill_pkg_credits { my $self = shift; my ($speriod, $eperiod, $agentnum, %opt) = @_; $agentnum ||= $opt{'agentnum'}; my @where = ( '(cust_bill_pkg.pkgnum != 0 OR feepart IS NOT NULL)', $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), $self->with_report_option(%opt), $self->in_time_period_and_agent($speriod, $eperiod, $agentnum), $self->with_refnum(%opt), $self->with_cust_classnum(%opt) ); my $total_sql = "SELECT COALESCE(SUM(cust_credit_bill_pkg.amount),0) FROM cust_bill_pkg $cust_bill_pkg_join LEFT JOIN cust_credit_bill_pkg USING ( billpkgnum ) WHERE " . join(' AND ', grep $_, @where); $self->scalar_sql($total_sql); } ##### package churn report ##### =item active_pkg: The number of packages that were active at the start of the period. The end date of the period is ignored. Options: - refnum: Limit to customers with this advertising source. - classnum: Limit to packages with this class. - towernum: Limit to packages that have a broadband service with this tower. - zip: Limit to packages with this service location zip code. Except for zip, any of these can be an arrayref to allow multiple values for the field. =item setup_pkg: The number of packages with setup dates in the period. This excludes packages created by package changes. Options are as for active_pkg. =item susp_pkg: The number of packages that were suspended in the period (and not canceled). Options are as for active_pkg. =item unsusp_pkg: The number of packages that were unsuspended in the period. Options are as for active_pkg. =item cancel_pkg: The number of packages with cancel dates in the period. Excludes packages that were canceled to be changed to a new package. Options are as for active_pkg. =cut sub active_pkg { my $self = shift; $self->churn_pkg('active', @_); } sub setup_pkg { my $self = shift; $self->churn_pkg('setup', @_); } sub cancel_pkg { my $self = shift; $self->churn_pkg('cancel', @_); } sub susp_pkg { my $self = shift; $self->churn_pkg('susp', @_); } sub unsusp_pkg { my $self = shift; $self->churn_pkg('unsusp', @_); } sub total_revenue_pkg { my $self = shift; my $active_revenue = $self->revenue_pkg('active', @_); my $setup_revenue = $self->revenue_pkg('setup', @_); my $return = $active_revenue + $setup_revenue; return $return; } sub total_revenue_diff { my $self = shift; my @current_month = @_; my @previous_month = @current_month; $previous_month[0] = $self->_subtract_months(1,$current_month[0]); $previous_month[1] = $self->_subtract_months(1,$current_month[1]); my $previous_revenue = $self->revenue_pkg('active', @previous_month) + $self->revenue_pkg('setup', @previous_month); my $current_revenue = $self->revenue_pkg('active', @current_month) + $self->revenue_pkg('setup', @current_month); my $return = $current_revenue - $previous_revenue; return $return; } sub revenue_pkg { my $self = shift; my ( $status, $speriod, $eperiod, $agentnum, %opt ) = @_; my $totalrevenue; my ($from, @where) = FS::h_cust_pkg->churn_fromwhere_sql( $status, $speriod, $eperiod); push @where, $self->pkg_where(%opt, 'agentnum' => $agentnum); my $sql; ## if package has changed and has not reached next due date it will not be in h_cust_bill. ## this causes problems with future months, needed to use change_pkgnum instead. if ($status eq "active") { $sql = "SELECT DISTINCT ON (revenue.pkgnum) revenue.pkgnum AS pkgnum, revenue.recur AS revenue FROM $from JOIN part_pkg ON (cust_pkg.pkgpart = part_pkg.pkgpart) JOIN cust_main ON (cust_pkg.custnum = cust_main.custnum) JOIN h_cust_bill_pkg AS revenue ON ((cust_pkg.pkgnum = revenue.pkgnum OR cust_pkg.change_pkgnum = revenue.pkgnum) AND cust_pkg.history_date < $speriod ) "; } elsif ($status eq "setup") { $sql = "SELECT DISTINCT ON (revenue.pkgnum) revenue.pkgnum AS pkgnum, revenue.setup AS revenue FROM $from JOIN part_pkg ON (cust_pkg.pkgpart = part_pkg.pkgpart) JOIN cust_main ON (cust_pkg.custnum = cust_main.custnum) JOIN h_cust_bill_pkg AS revenue ON (cust_pkg.pkgnum = revenue.pkgnum AND ( cust_pkg.setup > $speriod AND cust_pkg.setup < $eperiod) ) "; } $sql .= ' WHERE '.join(' AND ', @where) if scalar(@where); $sql .= "ORDER BY revenue.pkgnum ASC, revenue.history_date DESC"; my $revenue_sql = "SELECT sum(rev.revenue) AS total_revenue FROM ( $sql ) AS rev"; $self->scalar_sql($revenue_sql); } sub churn_pkg { my $self = shift; my ( $status, $speriod, $eperiod, $agentnum, %opt ) = @_; my ($from, @where) = FS::h_cust_pkg->churn_fromwhere_sql( $status, $speriod, $eperiod); push @where, $self->pkg_where(%opt, 'agentnum' => $agentnum); my $sql = "SELECT COUNT(*) FROM $from JOIN part_pkg ON (cust_pkg.pkgpart = part_pkg.pkgpart) JOIN cust_main ON (cust_pkg.custnum = cust_main.custnum)"; $sql .= ' WHERE '.join(' AND ', @where) if scalar(@where); $self->scalar_sql($sql); } sub pkg_where { my $self = shift; my %opt = @_; my @where = ( "part_pkg.freq != '0'", $self->with_refnum(%opt), $self->with_towernum(%opt), $self->with_zip(%opt), ); if ($opt{agentnum} =~ /^(\d+)$/) { push @where, "cust_main.agentnum = $1"; } if ($opt{classnum}) { my $classnum = $opt{classnum}; $classnum = [ $classnum ] if !ref($classnum); @$classnum = grep /^\d+$/, @$classnum; my $in = 'IN ('. join(',', @$classnum). ')'; push @where, "COALESCE(part_pkg.classnum, 0) $in" if scalar @$classnum; } @where; } ##### end of package churn report stuff ##### ##### customer churn report ##### =item active_cust: The number of customers who had any active recurring packages at the start of the period. The end date is ignored, agentnum is mandatory, and no other parameters are accepted. =item started_cust: The number of customers who had no active packages at the start of the period, but had active packages at the end. Like active_cust, agentnum is mandatory and no other parameters are accepted. =item suspended_cust: The number of customers who had active packages at the start of the period, and at the end had no active packages but some suspended packages. Note that this does not necessarily mean that their packages were suspended during the period. =item resumed_cust: The inverse of suspended_cust: the number of customers who had suspended packages and no active packages at the start of the period, and active packages at the end. =item cancelled_cust: The number of customers who had active packages at the start of the period, and only cancelled packages at the end. =cut sub active_cust { my $self = shift; $self->churn_cust(@_)->{active}; } sub started_cust { my $self = shift; $self->churn_cust(@_)->{started}; } sub suspended_cust { my $self = shift; $self->churn_cust(@_)->{suspended}; } sub resumed_cust { my $self = shift; $self->churn_cust(@_)->{resumed}; } sub cancelled_cust { my $self = shift; $self->churn_cust(@_)->{cancelled}; } sub churn_cust { my $self = shift; my ( $speriod ) = @_; # run one query for each interval return $self->{_interval}{$speriod} ||= $self->calculate_churn_cust(@_); } sub calculate_churn_cust { my $self = shift; my ($speriod, $eperiod, $agentnum, %opt) = @_; my $churn_sql = FS::cust_main::Status->churn_sql($speriod, $eperiod); my $where = ''; $where = " WHERE cust_main.agentnum = $agentnum " if $agentnum; my $cust_sql = "SELECT churn.* ". "FROM cust_main JOIN ($churn_sql) AS churn USING (custnum)". $where; # query to count the ones with certain status combinations my $total_sql = " SELECT SUM((s_active > 0)::int) as active, SUM((s_active = 0 and e_active > 0)::int) as started, SUM((s_active > 0 and e_active = 0 and e_suspended > 0)::int) as suspended, SUM((s_active = 0 and s_suspended > 0 and e_active > 0)::int) as resumed, SUM((e_active = 0 and e_cancelled > s_cancelled)::int) as cancelled FROM ($cust_sql) AS x "; my $sth = dbh->prepare($total_sql); $sth->execute or die "failed to execute churn query: " . $sth->errstr; $self->{_interval}{$speriod} = $sth->fetchrow_hashref; } sub in_time_period_and_agent { my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4); my $col = @_ ? shift() : '_date'; my $sql = "$col >= $speriod AND $col < $eperiod"; #agent selection $sql .= " AND cust_main.agentnum = $agentnum" if $agentnum; #agent virtualization $sql .= ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql( 'table'=>'cust_main' ); $sql; } sub for_opts { my ( $self, %opt ) = @_; my $sql = ''; if ( $opt{'custnum'} =~ /^(\d+)$/ ) { $sql .= " and custnum = $1 "; } if ( $opt{'refnum'} ) { my $refnum = $opt{'refnum'}; $refnum = [ $refnum ] if !ref($refnum); my $in = join(',', grep /^\d+$/, @$refnum); $sql .= " and refnum IN ($in)" if length $in; } if ( my $where = $self->with_cust_classnum(%opt) ) { $sql .= " and $where"; } $sql; } sub with_classnum { my ($self, $classnum, $use_override) = @_; return '' if $classnum eq ''; $classnum = [ $classnum ] if !ref($classnum); @$classnum = grep /^\d+$/, @$classnum; return '' if !@$classnum; my $in = 'IN ('. join(',', @$classnum). ')'; if ( $use_override ) { # then include packages if their base package is in the set and they are # not overridden, # or if they are overridden and their override package is in the set, # or fees if they are in the set return "( ( COALESCE(part_pkg.classnum, 0) $in AND cust_pkg.pkgpart IS NOT NULL AND pkgpart_override IS NULL ) OR ( COALESCE(override.classnum, 0) $in AND pkgpart_override IS NOT NULL ) OR ( COALESCE(part_fee.classnum, 0) $in AND cust_bill_pkg.feepart IS NOT NULL ) )"; } else { # include packages if their base package is in the set, # or fees if they are in the set return "( ( COALESCE(part_pkg.classnum, 0) $in AND cust_pkg.pkgpart IS NOT NULL ) OR ( COALESCE(part_fee.classnum, 0) $in AND cust_bill_pkg.feepart IS NOT NULL ) )"; } } 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 with_report_option { my ($self, %opt) = @_; # %opt can contain: # - report_optionnum: a comma-separated list of numbers. Zero means to # include packages with _no_ report classes. # - not_report_optionnum: a comma-separated list. Packages that have # any of these report options will be excluded from the result. # Zero does nothing. # - use_override: also matches line items that are add-ons to a package # matching the report class. # - all_report_options: returns only packages that have ALL of the # report classes listed in $num. Otherwise, will return packages that # have ANY of those classes. my @num = ref($opt{'report_optionnum'}) ? @{ $opt{'report_optionnum'} } : split(/\s*,\s*/, $opt{'report_optionnum'}); my @not_num = ref($opt{'not_report_optionnum'}) ? @{ $opt{'not_report_optionnum'} } : split(/\s*,\s*/, $opt{'not_report_optionnum'}); my $null; $null = 1 if ( grep {$_ == 0} @num ); @num = grep {$_ > 0} @num; @not_num = grep {$_ > 0} @not_num; # brute force my $table = $opt{'use_override'} ? 'override' : 'part_pkg'; my $op = ' OR '; if ( $opt{'all_report_options'} ) { if ( @num and $null ) { return 'false'; # mutually exclusive criteria, so just bail out } $op = ' AND '; } my @where_num = map { "EXISTS(SELECT 1 FROM part_pkg_option ". "WHERE optionname = 'report_option_$_' ". "AND part_pkg_option.pkgpart = $table.pkgpart)" } @num; if ( $null ) { push @where_num, "NOT EXISTS(SELECT 1 FROM part_pkg_option ". "WHERE optionname LIKE 'report_option_%' ". "AND part_pkg_option.pkgpart = $table.pkgpart)"; } my @where_not_num = map { "NOT EXISTS(SELECT 1 FROM part_pkg_option ". "WHERE optionname = 'report_option_$_' ". "AND part_pkg_option.pkgpart = $table.pkgpart)" } @not_num; my @where; if (@where_num) { push @where, '( '.join($op, @where_num).' )'; } if (@where_not_num) { push @where, '( '.join(' AND ', @where_not_num).' )'; } return @where; # this messes up totals #if ( $opt{'use_override'} ) { # # then also allow the non-override package to match # delete $opt{'use_override'}; # $comparison = "( $comparison OR " . $self->with_report_option(%opt) . ")"; #} } sub with_refnum { my ($self, %opt) = @_; if ( $opt{'refnum'} ) { my $refnum = $opt{'refnum'}; $refnum = [ $refnum ] if !ref($refnum); my $in = join(',', grep /^\d+$/, @$refnum); return "cust_main.refnum IN ($in)" if length $in; } return; } sub with_towernum { my ($self, %opt) = @_; if ( $opt{'towernum'} ) { my $towernum = $opt{'towernum'}; $towernum = [ $towernum ] if !ref($towernum); my $in = join(',', grep /^\d+$/, @$towernum); return unless length($in); # if no towers are specified, don't restrict # materialize/cache the set of pkgnums that, as of the last # svc_broadband history record, had a certain towernum # (because otherwise this is painfully slow) $self->_init_tower_pkg_cache; return "EXISTS( SELECT 1 FROM tower_pkg_cache WHERE towernum IN($in) AND cust_pkg.pkgnum = tower_pkg_cache.pkgnum )"; } return; } sub with_zip { my ($self, %opt) = @_; if (length($opt{'zip'})) { return "(SELECT zip FROM cust_location WHERE cust_location.locationnum = cust_pkg.locationnum ) = " . dbh->quote($opt{'zip'}); } return; } sub with_cust_classnum { my ($self, %opt) = @_; if ( $opt{'cust_classnum'} ) { my $classnums = $opt{'cust_classnum'}; $classnums = [ $classnums ] if !ref($classnums); @$classnums = grep /^\d+$/, @$classnums; return 'cust_main.classnum in('. join(',',@$classnums) .')' if @$classnums; } return; } sub scalar_sql { my( $self, $sql ) = ( shift, shift ); my $sth = dbh->prepare($sql) or die dbh->errstr; 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; } =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(cust_bill_pkg_detail.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'}) { # What we do here: # Find all line items that end after the start of the period (and have # recurring fees, and don't expire before they end). Choose the latest # one for each package. If it ends before the end of the period, copy # it forward by one billing period. # Repeat this until the latest line item for each package no longer ends # within the period. This is certain to happen in finitely many # iterations as long as freq > 0. # - Pg only, obviously. # - Gives bad results if freq_override is used. my @fields = ( FS::cust_bill_pkg->fields, qw( usage _date expire ) ); my $insert_fields = join(',', @fields); my $add_freq = sub { # emulate FS::part_pkg::add_freq my $field = shift; "EXTRACT( EPOCH FROM TO_TIMESTAMP($field) + (CASE WHEN freq ~ E'\\\\D' ". "THEN freq ELSE freq || 'mon' END)::INTERVAL) AS $field"; }; foreach (@fields) { if ($_ eq 'edate') { $_ = $add_freq->('edate'); } elsif ($_ eq 'sdate') { $_ = 'edate AS sdate' } elsif ($_ eq 'setup') { $_ = '0 AS setup' #because recurring only } elsif ($_ eq '_date') { $_ = $add_freq->('_date'); } } my $select_fields = join(',', @fields); my $dbh = dbh; my $sql = # Subquery here because we need to DISTINCT the whole set, select the # latest charge per pkgnum, and _then_ check edate < $eperiod # and edate < expire. "INSERT INTO v_cust_bill_pkg ($insert_fields) SELECT $select_fields FROM ( SELECT DISTINCT ON (pkgnum) * FROM v_cust_bill_pkg WHERE edate >= $speriod AND recur > 0 AND freq IS NOT NULL AND freq != '0' ORDER BY pkgnum, edate DESC ) AS v1 WHERE edate < $eperiod AND (edate < expire OR expire IS NULL)"; my $rows; do { warn "[extend_projection] $sql\n" if $DEBUG; $rows = $dbh->do($sql) or die $dbh->errstr; warn "[extend_projection] $rows rows\n" if $DEBUG; } until $rows == 0; } } =item _init_tower_pkg_cache Internal method: creates a temporary table relating pkgnums to towernums. A (pkgnum, towernum) record indicates that this package once had a svc_broadband service which, as of its last insert or replace_new history record, had a sectornum associated with that towernum. This is expensive, so it won't be done more than once an hour. Historical data about package churn shouldn't be changing in realtime anyway. =cut sub _init_tower_pkg_cache { my $self = shift; my $dbh = dbh; my $current = $CACHE->get('tower_pkg_cache_update'); return if $current; # XXX or should this be in the schema? my $sql = "DROP TABLE IF EXISTS tower_pkg_cache"; $dbh->do($sql) or die $dbh->errstr; $sql = "CREATE TABLE tower_pkg_cache (towernum int, pkgnum int)"; $dbh->do($sql) or die $dbh->errstr; # assumptions: # sectornums never get reused, or move from one tower to another # all service history is intact # svcnums never get reused (this would be bad) # pkgnums NEVER get reused (this would be extremely bad) $sql = "INSERT INTO tower_pkg_cache ( SELECT COALESCE(towernum,0), pkgnum FROM ( SELECT DISTINCT pkgnum, svcnum FROM h_cust_svc ) AS pkgnum_svcnum LEFT JOIN ( SELECT DISTINCT ON(svcnum) svcnum, sectornum FROM h_svc_broadband WHERE (history_action = 'replace_new' OR history_action = 'replace_old') ORDER BY svcnum ASC, history_date DESC ) AS svcnum_sectornum USING (svcnum) LEFT JOIN tower_sector USING (sectornum) )"; $dbh->do($sql) or die $dbh->errstr; $CACHE->set('tower_pkg_cache_update', 1, 3600); }; =head1 BUGS Documentation. =head1 SEE ALSO L, reports in the web interface. =cut 1;