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 #all credits applied to matching pkg line items (ie not taxes or fees)
 757
 758 sub cust_bill_pkg_credits {
 759   my $self = shift;
 760   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 761
 762   $agentnum ||= $opt{'agentnum'};
 763
 764   my @where = (
 765     '(cust_bill_pkg.pkgnum != 0 OR feepart IS NOT NULL)',
 766     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 767     $self->with_report_option(%opt),
 768     $self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
 769     $self->with_refnum(%opt),
 770     $self->with_cust_classnum(%opt)
 771   );
 772
 773   my $total_sql = "SELECT COALESCE(SUM(cust_credit_bill_pkg.amount),0)
 774     FROM cust_bill_pkg
 775     $cust_bill_pkg_join
 776     LEFT JOIN cust_credit_bill_pkg
 777       USING ( billpkgnum )
 778     WHERE " . join(' AND ', grep $_, @where);
 779
 780   $self->scalar_sql($total_sql);
 781 }
 782
 783 ##### package churn report #####
 784
 785 =item active_pkg: The number of packages that were active at the start of
 786 the period. The end date of the period is ignored. Options:
 787
 788 - refnum: Limit to customers with this advertising source.
 789 - classnum: Limit to packages with this class.
 790 - towernum: Limit to packages that have a broadband service with this tower.
 791 - zip: Limit to packages with this service location zip code.
 792
 793 Except for zip, any of these can be an arrayref to allow multiple values for
 794 the field.
 795
 796 =item setup_pkg: The number of packages with setup dates in the period. This
 797 excludes packages created by package changes. Options are as for active_pkg.
 798
 799 =item susp_pkg: The number of packages that were suspended in the period
 800 (and not canceled).  Options are as for active_pkg.
 801
 802 =item unsusp_pkg: The number of packages that were unsuspended in the period.
 803 Options are as for active_pkg.
 804
 805 =item cancel_pkg: The number of packages with cancel dates in the period.
 806 Excludes packages that were canceled to be changed to a new package. Options
 807 are as for active_pkg.
 808
 809 =cut
 810
 811 sub active_pkg {
 812   my $self = shift;
 813   $self->churn_pkg('active', @_);
 814 }
 815
 816 sub setup_pkg {
 817   my $self = shift;
 818   $self->churn_pkg('setup', @_);
 819 }
 820
 821 sub cancel_pkg {
 822   my $self = shift;
 823   $self->churn_pkg('cancel', @_);
 824 }
 825
 826 sub susp_pkg {
 827   my $self = shift;
 828   $self->churn_pkg('susp', @_);
 829 }
 830
 831 sub unsusp_pkg {
 832   my $self = shift;
 833   $self->churn_pkg('unsusp', @_);
 834 }
 835
 836 sub churn_pkg {
 837   my $self = shift;
 838   my ( $status, $speriod, $eperiod, $agentnum, %opt ) = @_;
 839   my ($from, @where) =
 840     FS::h_cust_pkg->churn_fromwhere_sql( $status, $speriod, $eperiod);
 841
 842   push @where, $self->pkg_where(%opt, 'agentnum' => $agentnum);
 843
 844   my $sql = "SELECT COUNT(*) FROM $from
 845     JOIN part_pkg ON (cust_pkg.pkgpart = part_pkg.pkgpart)
 846     JOIN cust_main ON (cust_pkg.custnum = cust_main.custnum)";
 847   $sql .= ' WHERE '.join(' AND ', @where)
 848     if scalar(@where);
 849
 850   $self->scalar_sql($sql);
 851 }
 852
 853 sub pkg_where {
 854   my $self = shift;
 855   my %opt = @_;
 856   my @where = (
 857     "part_pkg.freq != '0'",
 858     $self->with_refnum(%opt),
 859     $self->with_towernum(%opt),
 860     $self->with_zip(%opt),
 861   );
 862   if ($opt{agentnum} =~ /^(\d+)$/) {
 863     push @where, "cust_main.agentnum = $1";
 864   }
 865   if ($opt{classnum}) {
 866     my $classnum = $opt{classnum};
 867     $classnum = [ $classnum ] if !ref($classnum);
 868     @$classnum = grep /^\d+$/, @$classnum;
 869     my $in = 'IN ('. join(',', @$classnum). ')';
 870     push @where, "COALESCE(part_pkg.classnum, 0) $in" if scalar @$classnum;
 871   }
 872   @where;
 873 }
 874
 875 ##### end of package churn report stuff #####
 876
 877 ##### customer churn report #####
 878
 879 =item active_cust: The number of customers who had any active recurring
 880 packages at the start of the period. The end date is ignored, agentnum is
 881 mandatory, and no other parameters are accepted.
 882
 883 =item started_cust: The number of customers who had no active packages at
 884 the start of the period, but had active packages at the end. Like
 885 active_cust, agentnum is mandatory and no other parameters are accepted.
 886
 887 =item suspended_cust: The number of customers who had active packages at
 888 the start of the period, and at the end had no active packages but some
 889 suspended packages. Note that this does not necessarily mean that their
 890 packages were suspended during the period.
 891
 892 =item resumed_cust: The inverse of suspended_cust: the number of customers
 893 who had suspended packages and no active packages at the start of the
 894 period, and active packages at the end.
 895
 896 =item cancelled_cust: The number of customers who had active packages
 897 at the start of the period, and only cancelled packages at the end.
 898
 899 =cut
 900
 901 sub active_cust {
 902   my $self = shift;
 903   $self->churn_cust(@_)->{active};
 904 }
 905 sub started_cust {
 906   my $self = shift;
 907   $self->churn_cust(@_)->{started};
 908 }
 909 sub suspended_cust {
 910   my $self = shift;
 911   $self->churn_cust(@_)->{suspended};
 912 }
 913 sub resumed_cust {
 914   my $self = shift;
 915   $self->churn_cust(@_)->{resumed};
 916 }
 917 sub cancelled_cust {
 918   my $self = shift;
 919   $self->churn_cust(@_)->{cancelled};
 920 }
 921
 922 sub churn_cust {
 923   my $self = shift;
 924   my ( $speriod ) = @_;
 925
 926   # run one query for each interval
 927   return $self->{_interval}{$speriod} ||= $self->calculate_churn_cust(@_);
 928 }
 929
 930 sub calculate_churn_cust {
 931   my $self = shift;
 932   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 933
 934   my $churn_sql = FS::cust_main::Status->churn_sql($speriod, $eperiod);
 935   my $where = '';
 936   $where = " WHERE cust_main.agentnum = $agentnum " if $agentnum;
 937   my $cust_sql =
 938     "SELECT churn.* ".
 939     "FROM cust_main JOIN ($churn_sql) AS churn USING (custnum)".
 940     $where;
 941
 942   # query to count the ones with certain status combinations
 943   my $total_sql = "
 944     SELECT SUM((s_active > 0)::int)                   as active,
 945            SUM((s_active = 0 and e_active > 0)::int)  as started,
 946            SUM((s_active > 0 and e_active = 0 and e_suspended > 0)::int)
 947                                                       as suspended,
 948            SUM((s_active = 0 and s_suspended > 0 and e_active > 0)::int)
 949                                                       as resumed,
 950            SUM((s_active > 0 and e_active = 0 and e_suspended = 0)::int)
 951                                                       as cancelled
 952     FROM ($cust_sql) AS x
 953   ";
 954
 955   my $sth = dbh->prepare($total_sql);
 956   $sth->execute or die "failed to execute churn query: " . $sth->errstr;
 957
 958   $self->{_interval}{$speriod} = $sth->fetchrow_hashref;
 959 }
 960
 961 sub in_time_period_and_agent {
 962   my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4);
 963   my $col = @_ ? shift() : '_date';
 964
 965   my $sql = "$col >= $speriod AND $col < $eperiod";
 966
 967   #agent selection
 968   $sql .= " AND cust_main.agentnum = $agentnum"
 969     if $agentnum;
 970
 971   #agent virtualization
 972   $sql .= ' AND '.
 973           $FS::CurrentUser::CurrentUser->agentnums_sql( 'table'=>'cust_main' );
 974
 975   $sql;
 976 }
 977
 978 sub for_opts {
 979     my ( $self, %opt ) = @_;
 980     my $sql = '';
 981     if ( $opt{'custnum'} =~ /^(\d+)$/ ) {
 982       $sql .= " and custnum = $1 ";
 983     }
 984     if ( $opt{'refnum'} ) {
 985       my $refnum = $opt{'refnum'};
 986       $refnum = [ $refnum ] if !ref($refnum);
 987       my $in = join(',', grep /^\d+$/, @$refnum);
 988       $sql .= " and refnum IN ($in)" if length $in;
 989     }
 990     if ( my $where = $self->with_cust_classnum(%opt) ) {
 991       $sql .= " and $where";
 992     }
 993
 994     $sql;
 995 }
 996
 997 sub with_classnum {
 998   my ($self, $classnum, $use_override) = @_;
 999   return '' if $classnum eq '';
1000
1001   $classnum = [ $classnum ] if !ref($classnum);
1002   @$classnum = grep /^\d+$/, @$classnum;
1003   return '' if !@$classnum;
1004   my $in = 'IN ('. join(',', @$classnum). ')';
1005
1006   if ( $use_override ) {
1007     # then include packages if their base package is in the set and they are
1008     # not overridden,
1009     # or if they are overridden and their override package is in the set,
1010     # or fees if they are in the set
1011     return "(
1012          ( COALESCE(part_pkg.classnum, 0) $in AND cust_pkg.pkgpart IS NOT NULL AND pkgpart_override IS NULL )
1013       OR ( COALESCE(override.classnum, 0) $in AND pkgpart_override IS NOT NULL )
1014       OR ( COALESCE(part_fee.classnum, 0) $in AND cust_bill_pkg.feepart IS NOT NULL )
1015     )";
1016   } else {
1017     # include packages if their base package is in the set,
1018     # or fees if they are in the set
1019     return "(
1020          ( COALESCE(part_pkg.classnum, 0) $in AND cust_pkg.pkgpart IS NOT NULL )
1021       OR ( COALESCE(part_fee.classnum, 0) $in AND cust_bill_pkg.feepart IS NOT NULL )
1022     )";
1023   }
1024 }
1025
1026 sub with_usageclass {
1027   my $self = shift;
1028   my ($classnum, $use_override) = @_;
1029   return '' unless $classnum =~ /^\d+$/;
1030   my $comparison;
1031   if ( $classnum == 0 ) {
1032     $comparison = 'IS NULL';
1033   }
1034   else {
1035     $comparison = "= $classnum";
1036   }
1037   return "cust_bill_pkg_detail.classnum $comparison";
1038 }
1039
1040 sub with_report_option {
1041   my ($self, %opt) = @_;
1042   # %opt can contain:
1043   # - report_optionnum: a comma-separated list of numbers.  Zero means to
1044   #   include packages with _no_ report classes.
1045   # - not_report_optionnum: a comma-separated list.  Packages that have
1046   #   any of these report options will be excluded from the result.
1047   #   Zero does nothing.
1048   # - use_override: also matches line items that are add-ons to a package
1049   #   matching the report class.
1050   # - all_report_options: returns only packages that have ALL of the
1051   #   report classes listed in $num.  Otherwise, will return packages that
1052   #   have ANY of those classes.
1053
1054   my @num = ref($opt{'report_optionnum'})
1055                   ? @{ $opt{'report_optionnum'} }
1056                   : split(/\s*,\s*/, $opt{'report_optionnum'});
1057   my @not_num = ref($opt{'not_report_optionnum'})
1058                       ? @{ $opt{'not_report_optionnum'} }
1059                       : split(/\s*,\s*/, $opt{'not_report_optionnum'});
1060   my $null;
1061   $null = 1 if ( grep {$_ == 0} @num );
1062   @num = grep {$_ > 0} @num;
1063   @not_num = grep {$_ > 0} @not_num;
1064
1065   # brute force
1066   my $table = $opt{'use_override'} ? 'override' : 'part_pkg';
1067   my $op = ' OR ';
1068   if ( $opt{'all_report_options'} ) {
1069     if ( @num and $null ) {
1070       return 'false'; # mutually exclusive criteria, so just bail out
1071     }
1072     $op = ' AND ';
1073   }
1074   my @where_num = map {
1075     "EXISTS(SELECT 1 FROM part_pkg_option ".
1076     "WHERE optionname = 'report_option_$_' ".
1077     "AND part_pkg_option.pkgpart = $table.pkgpart)"
1078   } @num;
1079   if ( $null ) {
1080     push @where_num, "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
1081                      "WHERE optionname LIKE 'report_option_%' ".
1082                      "AND part_pkg_option.pkgpart = $table.pkgpart)";
1083   }
1084   my @where_not_num = map {
1085     "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
1086     "WHERE optionname = 'report_option_$_' ".
1087     "AND part_pkg_option.pkgpart = $table.pkgpart)"
1088   } @not_num;
1089
1090   my @where;
1091   if (@where_num) {
1092     push @where, '( '.join($op, @where_num).' )';
1093   }
1094   if (@where_not_num) {
1095     push @where, '( '.join(' AND ', @where_not_num).' )';
1096   }
1097
1098   return @where;
1099   # this messes up totals
1100   #if ( $opt{'use_override'} ) {
1101   #  # then also allow the non-override package to match
1102   #  delete $opt{'use_override'};
1103   #  $comparison = "( $comparison OR " . $self->with_report_option(%opt) . ")";
1104   #}
1105
1106 }
1107
1108 sub with_refnum {
1109   my ($self, %opt) = @_;
1110   if ( $opt{'refnum'} ) {
1111     my $refnum = $opt{'refnum'};
1112     $refnum = [ $refnum ] if !ref($refnum);
1113     my $in = join(',', grep /^\d+$/, @$refnum);
1114     return "cust_main.refnum IN ($in)" if length $in;
1115   }
1116   return;
1117 }
1118
1119 sub with_towernum {
1120   my ($self, %opt) = @_;
1121   if ( $opt{'towernum'} ) {
1122     my $towernum = $opt{'towernum'};
1123     $towernum = [ $towernum ] if !ref($towernum);
1124     my $in = join(',', grep /^\d+$/, @$towernum);
1125     return unless length($in); # if no towers are specified, don't restrict
1126
1127     # materialize/cache the set of pkgnums that, as of the last
1128     # svc_broadband history record, had a certain towernum
1129     # (because otherwise this is painfully slow)
1130     $self->_init_tower_pkg_cache;
1131
1132     return "EXISTS(
1133             SELECT 1 FROM tower_pkg_cache
1134               WHERE towernum IN($in)
1135               AND cust_pkg.pkgnum = tower_pkg_cache.pkgnum
1136             )";
1137   }
1138   return;
1139 }
1140
1141 sub with_zip {
1142   my ($self, %opt) = @_;
1143   if (length($opt{'zip'})) {
1144     return "(SELECT zip FROM cust_location
1145              WHERE cust_location.locationnum = cust_pkg.locationnum
1146             ) = " . dbh->quote($opt{'zip'});
1147   }
1148   return;
1149 }
1150
1151 sub with_cust_classnum {
1152   my ($self, %opt) = @_;
1153   if ( $opt{'cust_classnum'} ) {
1154     my $classnums = $opt{'cust_classnum'};
1155     $classnums = [ $classnums ] if !ref($classnums);
1156     @$classnums = grep /^\d+$/, @$classnums;
1157     return 'cust_main.classnum in('. join(',',@$classnums) .')'
1158       if @$classnums;
1159   }
1160   return;
1161 }
1162
1163
1164 sub scalar_sql {
1165   my( $self, $sql ) = ( shift, shift );
1166   my $sth = dbh->prepare($sql) or die dbh->errstr;
1167   warn "FS::Report::Table\n$sql\n" if $DEBUG;
1168   $sth->execute
1169     or die "Unexpected error executing statement $sql: ". $sth->errstr;
1170   $sth->fetchrow_arrayref->[0] || 0;
1171 }
1172
1173 =back
1174
1175 =head1 METHODS
1176
1177 =over 4
1178
1179 =item init_projection
1180
1181 Sets up for future projection of all observables on the report.  Currently
1182 this is limited to 'cust_bill_pkg'.
1183
1184 =cut
1185
1186 sub init_projection {
1187   # this is weird special case stuff--some redesign may be needed
1188   # to use it for anything else
1189   my $self = shift;
1190
1191   if ( driver_name ne 'Pg' ) {
1192     # also database-specific for now
1193     die "projection reports not supported on this platform";
1194   }
1195
1196   my %items = map {$_ => 1} @{ $self->{items} };
1197   if ($items{'cust_bill_pkg'}) {
1198     my $dbh = dbh;
1199     # v_ for 'virtual'
1200     my @sql = (
1201       # could use TEMPORARY TABLE but we're already transaction-protected
1202       'DROP TABLE IF EXISTS v_cust_bill_pkg',
1203       'CREATE TABLE v_cust_bill_pkg ' .
1204        '(LIKE cust_bill_pkg,
1205           usage numeric(10,2), _date integer, expire integer)',
1206       # XXX this should be smart enough to take only the ones with
1207       # sdate/edate overlapping the ROI, for performance
1208       "INSERT INTO v_cust_bill_pkg (
1209         SELECT cust_bill_pkg.*,
1210           (SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
1211           FROM cust_bill_pkg_detail
1212           WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum),
1213           cust_bill._date,
1214           cust_pkg.expire
1215         FROM cust_bill_pkg $cust_bill_pkg_join
1216       )",
1217     );
1218     foreach my $sql (@sql) {
1219       warn "[init_projection] $sql\n" if $DEBUG;
1220       $dbh->do($sql) or die $dbh->errstr;
1221     }
1222   }
1223 }
1224
1225 =item extend_projection START END
1226
1227 Generates data for the next period of projection.  This will be called
1228 for sequential periods where the END of one equals the START of the next
1229 (with no gaps).
1230
1231 =cut
1232
1233 sub extend_projection {
1234   my $self = shift;
1235   my ($speriod, $eperiod) = @_;
1236   my %items = map {$_ => 1} @{ $self->{items} };
1237   if ($items{'cust_bill_pkg'}) {
1238     # What we do here:
1239     # Find all line items that end after the start of the period (and have
1240     # recurring fees, and don't expire before they end).  Choose the latest
1241     # one for each package.  If it ends before the end of the period, copy
1242     # it forward by one billing period.
1243     # Repeat this until the latest line item for each package no longer ends
1244     # within the period.  This is certain to happen in finitely many
1245     # iterations as long as freq > 0.
1246     # - Pg only, obviously.
1247     # - Gives bad results if freq_override is used.
1248     my @fields = ( FS::cust_bill_pkg->fields, qw( usage _date expire ) );
1249     my $insert_fields = join(',', @fields);
1250     my $add_freq = sub { # emulate FS::part_pkg::add_freq
1251       my $field = shift;
1252       "EXTRACT( EPOCH FROM TO_TIMESTAMP($field) + (CASE WHEN freq ~ E'\\\\D' ".
1253       "THEN freq ELSE freq || 'mon' END)::INTERVAL) AS $field";
1254     };
1255     foreach (@fields) {
1256       if ($_ eq 'edate') {
1257         $_ = $add_freq->('edate');
1258       }
1259       elsif ($_ eq 'sdate') {
1260         $_ = 'edate AS sdate'
1261       }
1262       elsif ($_ eq 'setup') {
1263         $_ = '0 AS setup' #because recurring only
1264       }
1265       elsif ($_ eq '_date') {
1266         $_ = $add_freq->('_date');
1267       }
1268     }
1269     my $select_fields = join(',', @fields);
1270     my $dbh = dbh;
1271     my $sql =
1272     # Subquery here because we need to DISTINCT the whole set, select the
1273     # latest charge per pkgnum, and _then_ check edate < $eperiod
1274     # and edate < expire.
1275       "INSERT INTO v_cust_bill_pkg ($insert_fields)
1276         SELECT $select_fields FROM (
1277           SELECT DISTINCT ON (pkgnum) * FROM v_cust_bill_pkg
1278             WHERE edate >= $speriod
1279               AND recur > 0
1280               AND freq IS NOT NULL
1281               AND freq != '0'
1282             ORDER BY pkgnum, edate DESC
1283           ) AS v1
1284           WHERE edate < $eperiod AND (edate < expire OR expire IS NULL)";
1285     my $rows;
1286     do {
1287       warn "[extend_projection] $sql\n" if $DEBUG;
1288       $rows = $dbh->do($sql) or die $dbh->errstr;
1289       warn "[extend_projection] $rows rows\n" if $DEBUG;
1290     } until $rows == 0;
1291   }
1292 }
1293
1294 =item _init_tower_pkg_cache
1295
1296 Internal method: creates a temporary table relating pkgnums to towernums.
1297 A (pkgnum, towernum) record indicates that this package once had a
1298 svc_broadband service which, as of its last insert or replace_new history
1299 record, had a sectornum associated with that towernum.
1300
1301 This is expensive, so it won't be done more than once an hour. Historical
1302 data about package churn shouldn't be changing in realtime anyway.
1303
1304 =cut
1305
1306 sub _init_tower_pkg_cache {
1307   my $self = shift;
1308   my $dbh = dbh;
1309
1310   my $current = $CACHE->get('tower_pkg_cache_update');
1311   return if $current;
1312
1313   # XXX or should this be in the schema?
1314   my $sql = "DROP TABLE IF EXISTS tower_pkg_cache";
1315   $dbh->do($sql) or die $dbh->errstr;
1316   $sql = "CREATE TABLE tower_pkg_cache (towernum int, pkgnum int)";
1317   $dbh->do($sql) or die $dbh->errstr;
1318
1319   # assumptions:
1320   # sectornums never get reused, or move from one tower to another
1321   # all service history is intact
1322   # svcnums never get reused (this would be bad)
1323   # pkgnums NEVER get reused (this would be extremely bad)
1324   $sql = "INSERT INTO tower_pkg_cache (
1325     SELECT COALESCE(towernum,0), pkgnum
1326     FROM ( SELECT DISTINCT pkgnum, svcnum FROM h_cust_svc ) AS pkgnum_svcnum
1327     LEFT JOIN (
1328       SELECT DISTINCT ON(svcnum) svcnum, sectornum
1329         FROM h_svc_broadband
1330         WHERE (history_action = 'replace_new'
1331                OR history_action = 'replace_old')
1332         ORDER BY svcnum ASC, history_date DESC
1333     ) AS svcnum_sectornum USING (svcnum)
1334     LEFT JOIN tower_sector USING (sectornum)
1335   )";
1336   $dbh->do($sql) or die $dbh->errstr;
1337
1338   $CACHE->set('tower_pkg_cache_update', 1, 3600);
1339
1340 };
1341
1342 =head1 BUGS
1343
1344 Documentation.
1345
1346 =head1 SEE ALSO
1347
1348 L<FS::Report::Table::Monthly>, reports in the web interface.
1349
1350 =cut
1351
1352 1;