FS/FS/Report/Table.pm

   1 package FS::Report::Table;
   2
   3 use strict;
   4 use base 'FS::Report';
   5 use Time::Local qw( timelocal );
   6 use FS::UID qw( dbh driver_name );
   7 use FS::Report::Table;
   8 use FS::CurrentUser;
   9 use Cache::FileCache;
  10
  11 our $DEBUG = 0; # turning this on will trace all SQL statements, VERY noisy
  12
  13 our $CACHE; # feel free to use this for whatever
  14
  15 FS::UID->install_callback(sub {
  16     $CACHE = Cache::FileCache->new( {
  17       'namespace'   => __PACKAGE__,
  18       'cache_root'  => "$FS::UID::cache_dir/cache.$FS::UID::datasrc",
  19     } );
  20     # reset this on startup (causes problems with database backups, etc.)
  21     $CACHE->remove('tower_pkg_cache_update');
  22 });
  23
  24 =head1 NAME
  25
  26 FS::Report::Table - Tables of report data
  27
  28 =head1 SYNOPSIS
  29
  30 See the more specific report objects, currently only
  31 FS::Report::Table::Monthly and FS::Report::Table::Daily.
  32
  33 =head1 OBSERVABLES
  34
  35 The common interface for an observable named 'foo' is:
  36
  37 $report->foo($startdate, $enddate, $agentnum, %options)
  38
  39 This returns a scalar value for foo, over the period from
  40 $startdate to $enddate, limited to agent $agentnum, subject to
  41 options in %opt.
  42
  43 =over 4
  44
  45 =item signups: The number of customers signed up.  Options are:
  46
  47 - cust_classnum: limit to this customer class
  48 - pkg_classnum: limit to customers with a package of this class.  If this is
  49   an arrayref, it's an ANY match.
  50 - refnum: limit to this advertising source
  51 - indirect: boolean; limit to customers that have a referral_custnum that
  52   matches the advertising source
  53
  54 =cut
  55
  56 sub signups {
  57   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
  58   my @where = ( $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
  59       'cust_main.signupdate')
  60   );
  61   my $join = '';
  62   if ( $opt{'indirect'} ) {
  63     $join = " JOIN cust_main AS referring_cust_main".
  64             " ON (cust_main.referral_custnum = referring_cust_main.custnum)";
  65
  66     if ( $opt{'refnum'} ) {
  67       push @where, "referring_cust_main.refnum = ".$opt{'refnum'};
  68     }
  69   }
  70   elsif ( $opt{'refnum'} ) {
  71     push @where, "refnum = ".$opt{'refnum'};
  72   }
  73
  74   push @where, $self->with_cust_classnum(%opt);
  75   if ( $opt{'pkg_classnum'} ) {
  76     my $classnum = $opt{'pkg_classnum'};
  77     $classnum = [ $classnum ] unless ref $classnum;
  78     @$classnum = grep /^\d+$/, @$classnum;
  79     if (@$classnum) {
  80       my $in = 'IN ('. join(',', @$classnum). ')';
  81       push @where,
  82         "EXISTS(SELECT 1 FROM cust_pkg JOIN part_pkg USING (pkgpart) ".
  83                "WHERE cust_pkg.custnum = cust_main.custnum ".
  84                "AND part_pkg.classnum $in".
  85                ")";
  86     }
  87   }
  88
  89   $self->scalar_sql(
  90     "SELECT COUNT(*) FROM cust_main $join WHERE ".join(' AND ', @where)
  91   );
  92 }
  93
  94 =item invoiced: The total amount charged on all invoices.
  95
  96 =cut
  97
  98 sub invoiced { #invoiced
  99   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 100
 101   my $sql = 'SELECT SUM(cust_bill.charged) FROM cust_bill';
 102   if ( $opt{'setuprecur'} ) {
 103     $sql = 'SELECT SUM('.
 104             FS::cust_bill_pkg->charged_sql($speriod, $eperiod, %opt).
 105            ') FROM cust_bill_pkg JOIN cust_bill USING (invnum)';
 106   }
 107
 108   $self->scalar_sql("
 109       $sql
 110         LEFT JOIN cust_main USING ( custnum )
 111       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 112                $self->for_opts(%opt)
 113   );
 114
 115 }
 116
 117 =item netsales: invoiced - netcredits
 118
 119 =cut
 120
 121 sub netsales { #net sales
 122   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 123
 124     $self->invoiced(  $speriod, $eperiod, $agentnum, %opt)
 125   - $self->netcredits($speriod, $eperiod, $agentnum, %opt);
 126 }
 127
 128 =item cashflow: payments - refunds
 129
 130 =cut
 131
 132 sub cashflow {
 133   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 134
 135     $self->payments($speriod, $eperiod, $agentnum, %opt)
 136   - $self->refunds( $speriod, $eperiod, $agentnum, %opt);
 137 }
 138
 139 =item netcashflow: payments - netrefunds
 140
 141 =cut
 142
 143 sub netcashflow {
 144   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 145
 146     $self->receipts(   $speriod, $eperiod, $agentnum, %opt)
 147   - $self->netrefunds( $speriod, $eperiod, $agentnum, %opt);
 148 }
 149
 150 =item payments: The sum of payments received in the period.
 151
 152 =cut
 153
 154 sub payments {
 155   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 156   $self->scalar_sql("
 157     SELECT SUM(paid)
 158       FROM cust_pay
 159         LEFT JOIN cust_main USING ( custnum )
 160       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 161                $self->for_opts(%opt)
 162   );
 163 }
 164
 165 =item credits: The sum of credits issued in the period.
 166
 167 =cut
 168
 169 sub credits {
 170   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 171   $self->scalar_sql("
 172     SELECT SUM(cust_credit.amount)
 173       FROM cust_credit
 174         LEFT JOIN cust_main USING ( custnum )
 175       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 176                $self->for_opts(%opt)
 177   );
 178 }
 179
 180 =item refunds: The sum of refunds paid in the period.
 181
 182 =cut
 183
 184 sub refunds {
 185   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 186   $self->scalar_sql("
 187     SELECT SUM(refund)
 188       FROM cust_refund
 189         LEFT JOIN cust_main USING ( custnum )
 190       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 191                $self->for_opts(%opt)
 192   );
 193 }
 194
 195 =item netcredits: The sum of credit applications to invoices in the period.
 196
 197 =cut
 198
 199 sub netcredits {
 200   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 201
 202   my $sql = 'SELECT SUM(cust_credit_bill.amount) FROM cust_credit_bill';
 203   if ( $opt{'setuprecur'} ) {
 204     $sql = 'SELECT SUM('.
 205             FS::cust_bill_pkg->credited_sql($speriod, $eperiod, %opt).
 206            ') FROM cust_bill_pkg';
 207   }
 208
 209   $self->scalar_sql("
 210     $sql
 211         LEFT JOIN cust_bill USING ( invnum  )
 212         LEFT JOIN cust_main USING ( custnum )
 213       WHERE ". $self->in_time_period_and_agent( $speriod,
 214                                                 $eperiod,
 215                                                 $agentnum,
 216                                                 'cust_bill._date'
 217                                               ).
 218                $self->for_opts(%opt)
 219   );
 220 }
 221
 222 =item receipts: The sum of payment applications to invoices in the period.
 223
 224 =cut
 225
 226 sub receipts { #net payments
 227   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 228
 229   my $sql = 'SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay';
 230   if ( $opt{'setuprecur'} ) {
 231     $sql = 'SELECT SUM('.
 232             #in practice, but not appearance, paid_sql accepts end before start
 233             FS::cust_bill_pkg->paid_sql($eperiod, $speriod, %opt).
 234            ') FROM cust_bill_pkg';
 235   }
 236
 237   $self->scalar_sql("
 238     $sql
 239         LEFT JOIN cust_bill USING ( invnum  )
 240         LEFT JOIN cust_main USING ( custnum )
 241       WHERE ". $self->in_time_period_and_agent( $speriod,
 242                                                 $eperiod,
 243                                                 $agentnum,
 244                                                 'cust_bill._date'
 245                                               ).
 246                $self->for_opts(%opt)
 247   );
 248 }
 249
 250 =item netrefunds: The sum of refund applications to credits in the period.
 251
 252 =cut
 253
 254 sub netrefunds {
 255   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 256   $self->scalar_sql("
 257     SELECT SUM(cust_credit_refund.amount)
 258       FROM cust_credit_refund
 259         LEFT JOIN cust_credit USING ( crednum  )
 260         LEFT JOIN cust_main   USING ( custnum )
 261       WHERE ". $self->in_time_period_and_agent( $speriod,
 262                                                 $eperiod,
 263                                                 $agentnum,
 264                                                 'cust_credit._date'
 265                                               ).
 266                $self->for_opts(%opt)
 267   );
 268 }
 269
 270 =item discounted: The sum of discounts on invoices in the period.
 271
 272 =cut
 273
 274 sub discounted {
 275   my( $self, $speriod, $eperiod, $agentnum, %opt) = @_;
 276
 277   my $sql = 'SELECT SUM(';
 278   if ($opt{'setuprecur'}) {
 279     # (This isn't exact but it works in most cases.)
 280     # When splitting into setup/recur values,
 281     # if the discount is allowed to apply to setup fees (discount.setup = 'Y')
 282     # then split it between the "setup" and "recurring" rows in proportion to
 283     # the "unitsetup" and "unitrecur" fields of the line item.
 284     $sql .= <<EOF;
 285 CASE
 286   WHEN discount.setup = 'Y'
 287     AND ((COALESCE(cust_bill_pkg.unitsetup,0) > 0)
 288           OR (COALESCE(cust_bill_pkg.unitrecur,0) > 0))
 289   THEN
 290 EOF
 291     if ($opt{'setuprecur'} eq 'setup') {
 292       $sql .= '    (COALESCE(cust_bill_pkg.unitsetup,0)';
 293     } elsif ($opt{'setuprecur'} eq 'recur') {
 294       $sql .= '    (COALESCE(cust_bill_pkg.unitrecur,0)';
 295     } else {
 296       die 'Unrecognized value for setuprecur';
 297     }
 298     $sql .= ' / (COALESCE(cust_bill_pkg.unitsetup,0) + COALESCE(cust_bill_pkg.unitrecur,0)))';
 299     $sql .= " * cust_bill_pkg_discount.amount\n";
 300     # Otherwise, show it all as "recurring"
 301     if ($opt{'setuprecur'} eq 'setup') {
 302       $sql .= "  ELSE 0\n";
 303     } elsif ($opt{'setuprecur'} eq 'recur') {
 304       $sql .= "  ELSE cust_bill_pkg_discount.amount\n";
 305     }
 306     $sql .= "END\n";
 307   } else {
 308     # simple case, no setuprecur
 309     $sql .= "cust_bill_pkg_discount.amount\n";
 310   }
 311   $sql .= <<EOF;
 312 ) FROM cust_bill_pkg_discount
 313   JOIN cust_bill_pkg     USING  ( billpkgnum )
 314   JOIN cust_bill         USING  ( invnum )
 315   JOIN cust_main         USING  ( custnum )
 316 EOF
 317   if ($opt{'setuprecur'}) {
 318     $sql .= <<EOF;
 319   JOIN cust_pkg_discount USING ( pkgdiscountnum )
 320   LEFT JOIN discount          USING ( discountnum )
 321 EOF
 322   }
 323   $self->scalar_sql(
 324     $sql
 325     . 'WHERE '
 326     . $self->in_time_period_and_agent( $speriod,
 327                                        $eperiod,
 328                                        $agentnum,
 329                                        'cust_bill._date'
 330                                       )
 331     . $self->for_opts(%opt)
 332   );
 333 }
 334
 335 =item gross: invoiced + discounted
 336
 337 =cut
 338
 339 sub gross {
 340   my( $self, $speriod, $eperiod, $agentnum, %opt) = @_;
 341     $self->invoiced(   $speriod, $eperiod, $agentnum, %opt)
 342   + $self->discounted( $speriod, $eperiod, $agentnum, %opt);
 343 }
 344
 345 #XXX docs
 346
 347 #these should be auto-generated or $AUTOLOADed or something
 348 sub invoiced_12mo {
 349   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 350   $speriod = $self->_subtract_11mo($speriod);
 351   $self->invoiced($speriod, $eperiod, $agentnum);
 352 }
 353
 354 sub netsales_12mo {
 355   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 356   $speriod = $self->_subtract_11mo($speriod);
 357   $self->netsales($speriod, $eperiod, $agentnum);
 358 }
 359
 360 sub receipts_12mo {
 361   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 362   $speriod = $self->_subtract_11mo($speriod);
 363   $self->receipts($speriod, $eperiod, $agentnum);
 364 }
 365
 366 sub payments_12mo {
 367   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 368   $speriod = $self->_subtract_11mo($speriod);
 369   $self->payments($speriod, $eperiod, $agentnum);
 370 }
 371
 372 sub credits_12mo {
 373   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 374   $speriod = $self->_subtract_11mo($speriod);
 375   $self->credits($speriod, $eperiod, $agentnum);
 376 }
 377
 378 sub netcredits_12mo {
 379   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 380   $speriod = $self->_subtract_11mo($speriod);
 381   $self->netcredits($speriod, $eperiod, $agentnum);
 382 }
 383
 384 sub cashflow_12mo {
 385   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 386   $speriod = $self->_subtract_11mo($speriod);
 387   $self->cashflow($speriod, $eperiod, $agentnum);
 388 }
 389
 390 sub netcashflow_12mo {
 391   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 392   $speriod = $self->_subtract_11mo($speriod);
 393   $self->cashflow($speriod, $eperiod, $agentnum);
 394 }
 395
 396 sub refunds_12mo {
 397   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 398   $speriod = $self->_subtract_11mo($speriod);
 399   $self->refunds($speriod, $eperiod, $agentnum);
 400 }
 401
 402 sub netrefunds_12mo {
 403   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 404   $speriod = $self->_subtract_11mo($speriod);
 405   $self->netrefunds($speriod, $eperiod, $agentnum);
 406 }
 407
 408
 409 #not being too bad with the false laziness
 410 sub _subtract_11mo {
 411   my($self, $time) = @_;
 412   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
 413   $mon -= 11;
 414   if ( $mon < 0 ) { $mon+=12; $year--; }
 415   timelocal($sec,$min,$hour,$mday,$mon,$year);
 416 }
 417
 418 =item cust_pkg_setup_cost: The total setup costs of packages setup in the period
 419
 420 'classnum': limit to this package class.
 421
 422 =cut
 423
 424 sub cust_pkg_setup_cost {
 425   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 426   my $where = '';
 427
 428   if ( $opt{'classnum'} ne '' ) {
 429     my $classnums = $opt{'classnum'};
 430     $classnums = [ $classnums ] if !ref($classnums);
 431     @$classnums = grep /^\d+$/, @$classnums;
 432     $where .= ' AND COALESCE(part_pkg.classnum,0) IN ('. join(',', @$classnums).
 433                                                     ')';
 434   }
 435
 436   $agentnum ||= $opt{'agentnum'};
 437
 438   my $total_sql = " SELECT SUM(part_pkg.setup_cost) ";
 439   $total_sql .= " FROM cust_pkg
 440              LEFT JOIN cust_main USING ( custnum )
 441              LEFT JOIN part_pkg  USING ( pkgpart )
 442                   WHERE pkgnum != 0
 443                   $where
 444                   AND ".$self->in_time_period_and_agent(
 445                     $speriod, $eperiod, $agentnum, 'cust_pkg.setup');
 446   return $self->scalar_sql($total_sql);
 447 }
 448
 449 =item cust_pkg_recur_cust: the total recur costs of packages in the period
 450
 451 'classnum': limit to this package class.
 452
 453 =cut
 454
 455 sub cust_pkg_recur_cost {
 456   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 457   my $where = '';
 458
 459   if ( $opt{'classnum'} ne '' ) {
 460     my $classnums = $opt{'classnum'};
 461     $classnums = [ $classnums ] if !ref($classnums);
 462     @$classnums = grep /^\d+$/, @$classnums;
 463     $where .= ' AND COALESCE(part_pkg.classnum,0) IN ('. join(',', @$classnums).
 464                                                     ')';
 465   }
 466
 467   $agentnum ||= $opt{'agentnum'};
 468   # duplication of in_time_period_and_agent
 469   # because we do it a little differently here
 470   $where .= " AND cust_main.agentnum = $agentnum" if $agentnum;
 471   $where .= " AND ".
 472           $FS::CurrentUser::CurrentUser->agentnums_sql('table' => 'cust_main');
 473
 474   my $total_sql = " SELECT SUM(part_pkg.recur_cost) ";
 475   $total_sql .= " FROM cust_pkg
 476              LEFT JOIN cust_main USING ( custnum )
 477              LEFT JOIN part_pkg  USING ( pkgpart )
 478                   WHERE pkgnum != 0
 479                   $where
 480                   AND cust_pkg.setup < $eperiod
 481                   AND (cust_pkg.cancel > $speriod OR cust_pkg.cancel IS NULL)
 482                   ";
 483   return $self->scalar_sql($total_sql);
 484 }
 485
 486 =item cust_bill_pkg: the total package charges on invoice line items.
 487
 488 'charges': limit the type of charges included (setup, recur, usage, discount, taxes).
 489 Should be a string containing one or more of 'S', 'R', or 'U'; or 'D' or 'T' (discount
 490 and taxes should not be combined with the others.)  If unspecified, defaults to 'SRU'.
 491
 492 'classnum': limit to this package class.
 493
 494 'use_override': for line items generated by an add-on package, use the class
 495 of the add-on rather than the base package.
 496
 497 'average_per_cust_pkg': divide the result by the number of distinct packages.
 498
 499 'distribute': for non-monthly recurring charges, ignore the invoice
 500 date.  Instead, consider the line item's starting/ending dates.  Determine
 501 the fraction of the line item duration that falls within the specified
 502 interval and return that fraction of the recurring charges.  This is
 503 somewhat experimental.
 504
 505 'project': enable if this is a projected period.  This is very experimental.
 506
 507 =cut
 508
 509 sub cust_bill_pkg {
 510   my $self = shift;
 511   my( $speriod, $eperiod, $agentnum, %opt ) = @_;
 512
 513   my %charges = map {$_=>1} split('', $opt{'charges'} || 'SRU');
 514
 515   my $sum = 0;
 516   $sum += $self->cust_bill_pkg_setup(@_) if $charges{S};
 517   $sum += $self->cust_bill_pkg_recur(@_) if $charges{R};
 518   $sum += $self->cust_bill_pkg_detail(@_) if $charges{U};
 519   $sum += $self->cust_bill_pkg_discount(@_) if $charges{D};
 520   $sum += $self->cust_bill_pkg_taxes(@_) if $charges{T};
 521
 522   if ($opt{'average_per_cust_pkg'}) {
 523     my $count = $self->cust_bill_pkg_count_pkgnum(@_);
 524     return '' if $count == 0;
 525     $sum = sprintf('%.2f', $sum / $count);
 526   }
 527   $sum;
 528 }
 529
 530 my $cust_bill_pkg_join = '
 531     LEFT JOIN cust_bill USING ( invnum )
 532     LEFT JOIN cust_main USING ( custnum )
 533     LEFT JOIN cust_pkg USING ( pkgnum )
 534     LEFT JOIN part_pkg USING ( pkgpart )
 535     LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 536     LEFT JOIN part_fee USING ( feepart )';
 537
 538 sub cust_bill_pkg_setup {
 539   my $self = shift;
 540   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 541   # no projecting setup fees--use real invoices only
 542   # but evaluate this anyway, because the design of projection is that
 543   # if there are somehow real setup fees in the future, we want to count
 544   # them
 545
 546   $agentnum ||= $opt{'agentnum'};
 547
 548   my @where = (
 549     '(pkgnum != 0 OR feepart IS NOT NULL)',
 550     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 551     $self->with_report_option(%opt),
 552     $self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
 553     $self->with_refnum(%opt),
 554     $self->with_cust_classnum(%opt)
 555   );
 556
 557   my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0)
 558   FROM cust_bill_pkg
 559   $cust_bill_pkg_join
 560   WHERE " . join(' AND ', grep $_, @where);
 561
 562   $self->scalar_sql($total_sql);
 563 }
 564
 565 sub _cust_bill_pkg_recurring {
 566   # returns the FROM/WHERE part of the statement to query all recurring
 567   # line items in the period
 568   my $self = shift;
 569   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 570
 571   $agentnum ||= $opt{'agentnum'};
 572   my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg';
 573
 574   my @where = (
 575     '(pkgnum != 0 OR feepart IS NOT NULL)',
 576     $self->with_report_option(%opt),
 577     $self->with_refnum(%opt),
 578     $self->with_cust_classnum(%opt)
 579   );
 580
 581   my $where_classnum = $self->with_classnum($opt{'classnum'}, $opt{'use_override'});
 582   if ($opt{'project'}) {
 583     $where_classnum =~ s/\bcust_bill_pkg/v_cust_bill_pkg/g;
 584   }
 585   push @where, $where_classnum;
 586
 587   if ( $opt{'distribute'} ) {
 588     $where[0] = 'pkgnum != 0'; # specifically exclude fees
 589     push @where, "cust_main.agentnum = $agentnum" if $agentnum;
 590     push @where,
 591       "$cust_bill_pkg.sdate <  $eperiod",
 592       "$cust_bill_pkg.edate >= $speriod",
 593     ;
 594   }
 595   else {
 596     # we don't want to have to create v_cust_bill
 597     my $_date = $opt{'project'} ? 'v_cust_bill_pkg._date' : 'cust_bill._date';
 598     push @where,
 599       $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, $_date);
 600   }
 601
 602   return "
 603   FROM $cust_bill_pkg
 604   $cust_bill_pkg_join
 605   WHERE ".join(' AND ', grep $_, @where);
 606
 607 }
 608
 609 sub cust_bill_pkg_recur {
 610   my $self = shift;
 611   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 612
 613   # subtract all usage from the line item regardless of date
 614   my $item_usage;
 615   if ( $opt{'project'} ) {
 616     $item_usage = 'usage'; #already calculated
 617   }
 618   else {
 619     $item_usage = '( SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
 620       FROM cust_bill_pkg_detail
 621       WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum )';
 622   }
 623
 624   my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg';
 625
 626   my $recur_fraction = '';
 627   if ($opt{'distribute'}) {
 628     # the fraction of edate - sdate that's within [speriod, eperiod]
 629     $recur_fraction = " *
 630       CAST(LEAST($eperiod, $cust_bill_pkg.edate) -
 631        GREATEST($speriod, $cust_bill_pkg.sdate) AS DECIMAL) /
 632       ($cust_bill_pkg.edate - $cust_bill_pkg.sdate)";
 633   }
 634
 635   my $total_sql =
 636     "SELECT COALESCE(SUM(($cust_bill_pkg.recur - $item_usage) $recur_fraction),0)" .
 637     $self->_cust_bill_pkg_recurring(@_);
 638
 639   $self->scalar_sql($total_sql);
 640 }
 641
 642 sub cust_bill_pkg_count_pkgnum {
 643   # for ARPU calculation
 644   my $self = shift;
 645   my $total_sql = 'SELECT COUNT(DISTINCT pkgnum) '.
 646     $self->_cust_bill_pkg_recurring(@_);
 647
 648   $self->scalar_sql($total_sql);
 649 }
 650
 651 =item cust_bill_pkg_detail: the total usage charges in detail lines.
 652
 653 Arguments as for C<cust_bill_pkg>, plus:
 654
 655 'usageclass': limit to this usage class number.
 656
 657 =cut
 658
 659 sub cust_bill_pkg_detail {
 660   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 661
 662   my @where =
 663     ( "(cust_bill_pkg.pkgnum != 0 OR cust_bill_pkg.feepart IS NOT NULL)" );
 664
 665   $agentnum ||= $opt{'agentnum'};
 666
 667   push @where,
 668     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 669     $self->with_usageclass($opt{'usageclass'}),
 670     $self->with_report_option(%opt),
 671     $self->with_refnum(%opt),
 672     $self->with_cust_classnum(%opt)
 673     ;
 674
 675   if ( $opt{'distribute'} ) {
 676     # exclude fees
 677     $where[0] = 'cust_bill_pkg.pkgnum != 0';
 678     # and limit according to the usage time, not the billing date
 679     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 680       'cust_bill_pkg_detail.startdate'
 681     );
 682   }
 683   else {
 684     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 685       'cust_bill._date'
 686     );
 687   }
 688
 689   my $total_sql = " SELECT SUM(cust_bill_pkg_detail.amount) ";
 690
 691   $total_sql .=
 692     " FROM cust_bill_pkg_detail
 693         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 694         LEFT JOIN cust_bill ON cust_bill_pkg.invnum = cust_bill.invnum
 695         LEFT JOIN cust_main USING ( custnum )
 696         LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum
 697         LEFT JOIN part_pkg USING ( pkgpart )
 698         LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 699         LEFT JOIN part_fee USING ( feepart )
 700       WHERE ".join( ' AND ', grep $_, @where );
 701
 702   $self->scalar_sql($total_sql);
 703
 704 }
 705
 706 sub cust_bill_pkg_discount {
 707   my $self = shift;
 708   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 709   # apply all the same constraints here as for setup/recur
 710
 711   $agentnum ||= $opt{'agentnum'};
 712
 713   my @where = (
 714     '(pkgnum != 0 OR feepart IS NOT NULL)',
 715     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 716     $self->with_report_option(%opt),
 717     $self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
 718     $self->with_refnum(%opt),
 719     $self->with_cust_classnum(%opt)
 720   );
 721
 722   my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg_discount.amount), 0)
 723   FROM cust_bill_pkg_discount
 724   JOIN cust_bill_pkg USING (billpkgnum)
 725   $cust_bill_pkg_join
 726   WHERE " . join(' AND ', grep $_, @where);
 727
 728   $self->scalar_sql($total_sql);
 729 }
 730
 731 sub cust_bill_pkg_taxes {
 732   my $self = shift;
 733   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 734
 735   $agentnum ||= $opt{'agentnum'};
 736
 737   my @where = (
 738     '(cust_bill_pkg.pkgnum != 0 OR feepart IS NOT NULL)',
 739     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 740     $self->with_report_option(%opt),
 741     $self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
 742     $self->with_refnum(%opt),
 743     $self->with_cust_classnum(%opt)
 744   );
 745
 746   my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg_tax_location.amount),0)
 747     FROM cust_bill_pkg
 748     $cust_bill_pkg_join
 749     LEFT JOIN cust_bill_pkg_tax_location
 750       ON (cust_bill_pkg.billpkgnum = cust_bill_pkg_tax_location.taxable_billpkgnum)
 751     WHERE " . join(' AND ', grep $_, @where);
 752
 753   $self->scalar_sql($total_sql);
 754 }
 755
 756 ##### package churn report #####
 757
 758 =item active_pkg: The number of packages that were active at the start of
 759 the period. The end date of the period is ignored. Options:
 760
 761 - refnum: Limit to customers with this advertising source.
 762 - classnum: Limit to packages with this class.
 763 - towernum: Limit to packages that have a broadband service with this tower.
 764 - zip: Limit to packages with this service location zip code.
 765
 766 Except for zip, any of these can be an arrayref to allow multiple values for
 767 the field.
 768
 769 =item setup_pkg: The number of packages with setup dates in the period. This
 770 excludes packages created by package changes. Options are as for active_pkg.
 771
 772 =item susp_pkg: The number of packages that were suspended in the period
 773 (and not canceled).  Options are as for active_pkg.
 774
 775 =item unsusp_pkg: The number of packages that were unsuspended in the period.
 776 Options are as for active_pkg.
 777
 778 =item cancel_pkg: The number of packages with cancel dates in the period.
 779 Excludes packages that were canceled to be changed to a new package. Options
 780 are as for active_pkg.
 781
 782 =cut
 783
 784 sub active_pkg {
 785   my $self = shift;
 786   $self->churn_pkg('active', @_);
 787 }
 788
 789 sub setup_pkg {
 790   my $self = shift;
 791   $self->churn_pkg('setup', @_);
 792 }
 793
 794 sub cancel_pkg {
 795   my $self = shift;
 796   $self->churn_pkg('cancel', @_);
 797 }
 798
 799 sub susp_pkg {
 800   my $self = shift;
 801   $self->churn_pkg('susp', @_);
 802 }
 803
 804 sub unsusp_pkg {
 805   my $self = shift;
 806   $self->churn_pkg('unsusp', @_);
 807 }
 808
 809 sub churn_pkg {
 810   my $self = shift;
 811   my ( $status, $speriod, $eperiod, $agentnum, %opt ) = @_;
 812   my ($from, @where) =
 813     FS::h_cust_pkg->churn_fromwhere_sql( $status, $speriod, $eperiod);
 814
 815   push @where, $self->pkg_where(%opt, 'agentnum' => $agentnum);
 816
 817   my $sql = "SELECT COUNT(*) FROM $from
 818     JOIN part_pkg ON (cust_pkg.pkgpart = part_pkg.pkgpart)
 819     JOIN cust_main ON (cust_pkg.custnum = cust_main.custnum)";
 820   $sql .= ' WHERE '.join(' AND ', @where)
 821     if scalar(@where);
 822
 823   $self->scalar_sql($sql);
 824 }
 825
 826 sub pkg_where {
 827   my $self = shift;
 828   my %opt = @_;
 829   my @where = (
 830     "part_pkg.freq != '0'",
 831     $self->with_refnum(%opt),
 832     $self->with_towernum(%opt),
 833     $self->with_zip(%opt),
 834   );
 835   if ($opt{agentnum} =~ /^(\d+)$/) {
 836     push @where, "cust_main.agentnum = $1";
 837   }
 838   if ($opt{classnum}) {
 839     my $classnum = $opt{classnum};
 840     $classnum = [ $classnum ] if !ref($classnum);
 841     @$classnum = grep /^\d+$/, @$classnum;
 842     my $in = 'IN ('. join(',', @$classnum). ')';
 843     push @where, "COALESCE(part_pkg.classnum, 0) $in" if scalar @$classnum;
 844   }
 845   @where;
 846 }
 847
 848 ##### end of package churn report stuff #####
 849
 850 ##### customer churn report #####
 851
 852 =item active_cust: The number of customers who had any active recurring
 853 packages at the start of the period. The end date is ignored, agentnum is
 854 mandatory, and no other parameters are accepted.
 855
 856 =item started_cust: The number of customers who had no active packages at
 857 the start of the period, but had active packages at the end. Like
 858 active_cust, agentnum is mandatory and no other parameters are accepted.
 859
 860 =item suspended_cust: The number of customers who had active packages at
 861 the start of the period, and at the end had no active packages but some
 862 suspended packages. Note that this does not necessarily mean that their
 863 packages were suspended during the period.
 864
 865 =item resumed_cust: The inverse of suspended_cust: the number of customers
 866 who had suspended packages and no active packages at the start of the
 867 period, and active packages at the end.
 868
 869 =item cancelled_cust: The number of customers who had active packages
 870 at the start of the period, and only cancelled packages at the end.
 871
 872 =cut
 873
 874 sub active_cust {
 875   my $self = shift;
 876   $self->churn_cust(@_)->{active};
 877 }
 878 sub started_cust {
 879   my $self = shift;
 880   $self->churn_cust(@_)->{started};
 881 }
 882 sub suspended_cust {
 883   my $self = shift;
 884   $self->churn_cust(@_)->{suspended};
 885 }
 886 sub resumed_cust {
 887   my $self = shift;
 888   $self->churn_cust(@_)->{resumed};
 889 }
 890 sub cancelled_cust {
 891   my $self = shift;
 892   $self->churn_cust(@_)->{cancelled};
 893 }
 894
 895 sub churn_cust {
 896   my $self = shift;
 897   my ( $speriod ) = @_;
 898
 899   # run one query for each interval
 900   return $self->{_interval}{$speriod} ||= $self->calculate_churn_cust(@_);
 901 }
 902
 903 sub calculate_churn_cust {
 904   my $self = shift;
 905   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 906
 907   my $churn_sql = FS::cust_main::Status->churn_sql($speriod, $eperiod);
 908   my $where = '';
 909   $where = " WHERE cust_main.agentnum = $agentnum " if $agentnum;
 910   my $cust_sql =
 911     "SELECT churn.* ".
 912     "FROM cust_main JOIN ($churn_sql) AS churn USING (custnum)".
 913     $where;
 914
 915   # query to count the ones with certain status combinations
 916   my $total_sql = "
 917     SELECT SUM((s_active > 0)::int)                   as active,
 918            SUM((s_active = 0 and e_active > 0)::int)  as started,
 919            SUM((s_active > 0 and e_active = 0 and e_suspended > 0)::int)
 920                                                       as suspended,
 921            SUM((s_active = 0 and s_suspended > 0 and e_active > 0)::int)
 922                                                       as resumed,
 923            SUM((s_active > 0 and e_active = 0 and e_suspended = 0)::int)
 924                                                       as cancelled
 925     FROM ($cust_sql) AS x
 926   ";
 927
 928   my $sth = dbh->prepare($total_sql);
 929   $sth->execute or die "failed to execute churn query: " . $sth->errstr;
 930
 931   $self->{_interval}{$speriod} = $sth->fetchrow_hashref;
 932 }
 933
 934 sub in_time_period_and_agent {
 935   my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4);
 936   my $col = @_ ? shift() : '_date';
 937
 938   my $sql = "$col >= $speriod AND $col < $eperiod";
 939
 940   #agent selection
 941   $sql .= " AND cust_main.agentnum = $agentnum"
 942     if $agentnum;
 943
 944   #agent virtualization
 945   $sql .= ' AND '.
 946           $FS::CurrentUser::CurrentUser->agentnums_sql( 'table'=>'cust_main' );
 947
 948   $sql;
 949 }
 950
 951 sub for_opts {
 952     my ( $self, %opt ) = @_;
 953     my $sql = '';
 954     if ( $opt{'custnum'} =~ /^(\d+)$/ ) {
 955       $sql .= " and custnum = $1 ";
 956     }
 957     if ( $opt{'refnum'} ) {
 958       my $refnum = $opt{'refnum'};
 959       $refnum = [ $refnum ] if !ref($refnum);
 960       my $in = join(',', grep /^\d+$/, @$refnum);
 961       $sql .= " and refnum IN ($in)" if length $in;
 962     }
 963     if ( my $where = $self->with_cust_classnum(%opt) ) {
 964       $sql .= " and $where";
 965     }
 966
 967     $sql;
 968 }
 969
 970 sub with_classnum {
 971   my ($self, $classnum, $use_override) = @_;
 972   return '' if $classnum eq '';
 973
 974   $classnum = [ $classnum ] if !ref($classnum);
 975   @$classnum = grep /^\d+$/, @$classnum;
 976   return '' if !@$classnum;
 977   my $in = 'IN ('. join(',', @$classnum). ')';
 978
 979   if ( $use_override ) {
 980     # then include packages if their base package is in the set and they are
 981     # not overridden,
 982     # or if they are overridden and their override package is in the set,
 983     # or fees if they are in the set
 984     return "(
 985          ( COALESCE(part_pkg.classnum, 0) $in AND cust_pkg.pkgpart IS NOT NULL AND pkgpart_override IS NULL )
 986       OR ( COALESCE(override.classnum, 0) $in AND pkgpart_override IS NOT NULL )
 987       OR ( COALESCE(part_fee.classnum, 0) $in AND cust_bill_pkg.feepart IS NOT NULL )
 988     )";
 989   } else {
 990     # include packages if their base package is in the set,
 991     # or fees if they are in the set
 992     return "(
 993          ( COALESCE(part_pkg.classnum, 0) $in AND cust_pkg.pkgpart IS NOT NULL )
 994       OR ( COALESCE(part_fee.classnum, 0) $in AND cust_bill_pkg.feepart IS NOT NULL )
 995     )";
 996   }
 997 }
 998
 999 sub with_usageclass {
1000   my $self = shift;
1001   my ($classnum, $use_override) = @_;
1002   return '' unless $classnum =~ /^\d+$/;
1003   my $comparison;
1004   if ( $classnum == 0 ) {
1005     $comparison = 'IS NULL';
1006   }
1007   else {
1008     $comparison = "= $classnum";
1009   }
1010   return "cust_bill_pkg_detail.classnum $comparison";
1011 }
1012
1013 sub with_report_option {
1014   my ($self, %opt) = @_;
1015   # %opt can contain:
1016   # - report_optionnum: a comma-separated list of numbers.  Zero means to
1017   #   include packages with _no_ report classes.
1018   # - not_report_optionnum: a comma-separated list.  Packages that have
1019   #   any of these report options will be excluded from the result.
1020   #   Zero does nothing.
1021   # - use_override: also matches line items that are add-ons to a package
1022   #   matching the report class.
1023   # - all_report_options: returns only packages that have ALL of the
1024   #   report classes listed in $num.  Otherwise, will return packages that
1025   #   have ANY of those classes.
1026
1027   my @num = ref($opt{'report_optionnum'})
1028                   ? @{ $opt{'report_optionnum'} }
1029                   : split(/\s*,\s*/, $opt{'report_optionnum'});
1030   my @not_num = ref($opt{'not_report_optionnum'})
1031                       ? @{ $opt{'not_report_optionnum'} }
1032                       : split(/\s*,\s*/, $opt{'not_report_optionnum'});
1033   my $null;
1034   $null = 1 if ( grep {$_ == 0} @num );
1035   @num = grep {$_ > 0} @num;
1036   @not_num = grep {$_ > 0} @not_num;
1037
1038   # brute force
1039   my $table = $opt{'use_override'} ? 'override' : 'part_pkg';
1040   my $op = ' OR ';
1041   if ( $opt{'all_report_options'} ) {
1042     if ( @num and $null ) {
1043       return 'false'; # mutually exclusive criteria, so just bail out
1044     }
1045     $op = ' AND ';
1046   }
1047   my @where_num = map {
1048     "EXISTS(SELECT 1 FROM part_pkg_option ".
1049     "WHERE optionname = 'report_option_$_' ".
1050     "AND part_pkg_option.pkgpart = $table.pkgpart)"
1051   } @num;
1052   if ( $null ) {
1053     push @where_num, "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
1054                      "WHERE optionname LIKE 'report_option_%' ".
1055                      "AND part_pkg_option.pkgpart = $table.pkgpart)";
1056   }
1057   my @where_not_num = map {
1058     "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
1059     "WHERE optionname = 'report_option_$_' ".
1060     "AND part_pkg_option.pkgpart = $table.pkgpart)"
1061   } @not_num;
1062
1063   my @where;
1064   if (@where_num) {
1065     push @where, '( '.join($op, @where_num).' )';
1066   }
1067   if (@where_not_num) {
1068     push @where, '( '.join(' AND ', @where_not_num).' )';
1069   }
1070
1071   return @where;
1072   # this messes up totals
1073   #if ( $opt{'use_override'} ) {
1074   #  # then also allow the non-override package to match
1075   #  delete $opt{'use_override'};
1076   #  $comparison = "( $comparison OR " . $self->with_report_option(%opt) . ")";
1077   #}
1078
1079 }
1080
1081 sub with_refnum {
1082   my ($self, %opt) = @_;
1083   if ( $opt{'refnum'} ) {
1084     my $refnum = $opt{'refnum'};
1085     $refnum = [ $refnum ] if !ref($refnum);
1086     my $in = join(',', grep /^\d+$/, @$refnum);
1087     return "cust_main.refnum IN ($in)" if length $in;
1088   }
1089   return;
1090 }
1091
1092 sub with_towernum {
1093   my ($self, %opt) = @_;
1094   if ( $opt{'towernum'} ) {
1095     my $towernum = $opt{'towernum'};
1096     $towernum = [ $towernum ] if !ref($towernum);
1097     my $in = join(',', grep /^\d+$/, @$towernum);
1098     return unless length($in); # if no towers are specified, don't restrict
1099
1100     # materialize/cache the set of pkgnums that, as of the last
1101     # svc_broadband history record, had a certain towernum
1102     # (because otherwise this is painfully slow)
1103     $self->_init_tower_pkg_cache;
1104
1105     return "EXISTS(
1106             SELECT 1 FROM tower_pkg_cache
1107               WHERE towernum IN($in)
1108               AND cust_pkg.pkgnum = tower_pkg_cache.pkgnum
1109             )";
1110   }
1111   return;
1112 }
1113
1114 sub with_zip {
1115   my ($self, %opt) = @_;
1116   if (length($opt{'zip'})) {
1117     return "(SELECT zip FROM cust_location
1118              WHERE cust_location.locationnum = cust_pkg.locationnum
1119             ) = " . dbh->quote($opt{'zip'});
1120   }
1121   return;
1122 }
1123
1124 sub with_cust_classnum {
1125   my ($self, %opt) = @_;
1126   if ( $opt{'cust_classnum'} ) {
1127     my $classnums = $opt{'cust_classnum'};
1128     $classnums = [ $classnums ] if !ref($classnums);
1129     @$classnums = grep /^\d+$/, @$classnums;
1130     return 'cust_main.classnum in('. join(',',@$classnums) .')'
1131       if @$classnums;
1132   }
1133   return;
1134 }
1135
1136
1137 sub scalar_sql {
1138   my( $self, $sql ) = ( shift, shift );
1139   my $sth = dbh->prepare($sql) or die dbh->errstr;
1140   warn "FS::Report::Table\n$sql\n" if $DEBUG;
1141   $sth->execute
1142     or die "Unexpected error executing statement $sql: ". $sth->errstr;
1143   $sth->fetchrow_arrayref->[0] || 0;
1144 }
1145
1146 =back
1147
1148 =head1 METHODS
1149
1150 =over 4
1151
1152 =item init_projection
1153
1154 Sets up for future projection of all observables on the report.  Currently
1155 this is limited to 'cust_bill_pkg'.
1156
1157 =cut
1158
1159 sub init_projection {
1160   # this is weird special case stuff--some redesign may be needed
1161   # to use it for anything else
1162   my $self = shift;
1163
1164   if ( driver_name ne 'Pg' ) {
1165     # also database-specific for now
1166     die "projection reports not supported on this platform";
1167   }
1168
1169   my %items = map {$_ => 1} @{ $self->{items} };
1170   if ($items{'cust_bill_pkg'}) {
1171     my $dbh = dbh;
1172     # v_ for 'virtual'
1173     my @sql = (
1174       # could use TEMPORARY TABLE but we're already transaction-protected
1175       'DROP TABLE IF EXISTS v_cust_bill_pkg',
1176       'CREATE TABLE v_cust_bill_pkg ' .
1177        '(LIKE cust_bill_pkg,
1178           usage numeric(10,2), _date integer, expire integer)',
1179       # XXX this should be smart enough to take only the ones with
1180       # sdate/edate overlapping the ROI, for performance
1181       "INSERT INTO v_cust_bill_pkg (
1182         SELECT cust_bill_pkg.*,
1183           (SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
1184           FROM cust_bill_pkg_detail
1185           WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum),
1186           cust_bill._date,
1187           cust_pkg.expire
1188         FROM cust_bill_pkg $cust_bill_pkg_join
1189       )",
1190     );
1191     foreach my $sql (@sql) {
1192       warn "[init_projection] $sql\n" if $DEBUG;
1193       $dbh->do($sql) or die $dbh->errstr;
1194     }
1195   }
1196 }
1197
1198 =item extend_projection START END
1199
1200 Generates data for the next period of projection.  This will be called
1201 for sequential periods where the END of one equals the START of the next
1202 (with no gaps).
1203
1204 =cut
1205
1206 sub extend_projection {
1207   my $self = shift;
1208   my ($speriod, $eperiod) = @_;
1209   my %items = map {$_ => 1} @{ $self->{items} };
1210   if ($items{'cust_bill_pkg'}) {
1211     # What we do here:
1212     # Find all line items that end after the start of the period (and have
1213     # recurring fees, and don't expire before they end).  Choose the latest
1214     # one for each package.  If it ends before the end of the period, copy
1215     # it forward by one billing period.
1216     # Repeat this until the latest line item for each package no longer ends
1217     # within the period.  This is certain to happen in finitely many
1218     # iterations as long as freq > 0.
1219     # - Pg only, obviously.
1220     # - Gives bad results if freq_override is used.
1221     my @fields = ( FS::cust_bill_pkg->fields, qw( usage _date expire ) );
1222     my $insert_fields = join(',', @fields);
1223     my $add_freq = sub { # emulate FS::part_pkg::add_freq
1224       my $field = shift;
1225       "EXTRACT( EPOCH FROM TO_TIMESTAMP($field) + (CASE WHEN freq ~ E'\\\\D' ".
1226       "THEN freq ELSE freq || 'mon' END)::INTERVAL) AS $field";
1227     };
1228     foreach (@fields) {
1229       if ($_ eq 'edate') {
1230         $_ = $add_freq->('edate');
1231       }
1232       elsif ($_ eq 'sdate') {
1233         $_ = 'edate AS sdate'
1234       }
1235       elsif ($_ eq 'setup') {
1236         $_ = '0 AS setup' #because recurring only
1237       }
1238       elsif ($_ eq '_date') {
1239         $_ = $add_freq->('_date');
1240       }
1241     }
1242     my $select_fields = join(',', @fields);
1243     my $dbh = dbh;
1244     my $sql =
1245     # Subquery here because we need to DISTINCT the whole set, select the
1246     # latest charge per pkgnum, and _then_ check edate < $eperiod
1247     # and edate < expire.
1248       "INSERT INTO v_cust_bill_pkg ($insert_fields)
1249         SELECT $select_fields FROM (
1250           SELECT DISTINCT ON (pkgnum) * FROM v_cust_bill_pkg
1251             WHERE edate >= $speriod
1252               AND recur > 0
1253               AND freq IS NOT NULL
1254               AND freq != '0'
1255             ORDER BY pkgnum, edate DESC
1256           ) AS v1
1257           WHERE edate < $eperiod AND (edate < expire OR expire IS NULL)";
1258     my $rows;
1259     do {
1260       warn "[extend_projection] $sql\n" if $DEBUG;
1261       $rows = $dbh->do($sql) or die $dbh->errstr;
1262       warn "[extend_projection] $rows rows\n" if $DEBUG;
1263     } until $rows == 0;
1264   }
1265 }
1266
1267 =item _init_tower_pkg_cache
1268
1269 Internal method: creates a temporary table relating pkgnums to towernums.
1270 A (pkgnum, towernum) record indicates that this package once had a
1271 svc_broadband service which, as of its last insert or replace_new history
1272 record, had a sectornum associated with that towernum.
1273
1274 This is expensive, so it won't be done more than once an hour. Historical
1275 data about package churn shouldn't be changing in realtime anyway.
1276
1277 =cut
1278
1279 sub _init_tower_pkg_cache {
1280   my $self = shift;
1281   my $dbh = dbh;
1282
1283   my $current = $CACHE->get('tower_pkg_cache_update');
1284   return if $current;
1285
1286   # XXX or should this be in the schema?
1287   my $sql = "DROP TABLE IF EXISTS tower_pkg_cache";
1288   $dbh->do($sql) or die $dbh->errstr;
1289   $sql = "CREATE TABLE tower_pkg_cache (towernum int, pkgnum int)";
1290   $dbh->do($sql) or die $dbh->errstr;
1291
1292   # assumptions:
1293   # sectornums never get reused, or move from one tower to another
1294   # all service history is intact
1295   # svcnums never get reused (this would be bad)
1296   # pkgnums NEVER get reused (this would be extremely bad)
1297   $sql = "INSERT INTO tower_pkg_cache (
1298     SELECT COALESCE(towernum,0), pkgnum
1299     FROM ( SELECT DISTINCT pkgnum, svcnum FROM h_cust_svc ) AS pkgnum_svcnum
1300     LEFT JOIN (
1301       SELECT DISTINCT ON(svcnum) svcnum, sectornum
1302         FROM h_svc_broadband
1303         WHERE (history_action = 'replace_new'
1304                OR history_action = 'replace_old')
1305         ORDER BY svcnum ASC, history_date DESC
1306     ) AS svcnum_sectornum USING (svcnum)
1307     LEFT JOIN tower_sector USING (sectornum)
1308   )";
1309   $dbh->do($sql) or die $dbh->errstr;
1310
1311   $CACHE->set('tower_pkg_cache_update', 1, 3600);
1312
1313 };
1314
1315 =head1 BUGS
1316
1317 Documentation.
1318
1319 =head1 SEE ALSO
1320
1321 L<FS::Report::Table::Monthly>, reports in the web interface.
1322
1323 =cut
1324
1325 1;