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).
 489 Should be a string containing one or more of 'S', 'R', 'U', or 'D'; if
 490 unspecified, defaults to all three.
 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
 521   if ($opt{'average_per_cust_pkg'}) {
 522     my $count = $self->cust_bill_pkg_count_pkgnum(@_);
 523     return '' if $count == 0;
 524     $sum = sprintf('%.2f', $sum / $count);
 525   }
 526   $sum;
 527 }
 528
 529 my $cust_bill_pkg_join = '
 530     LEFT JOIN cust_bill USING ( invnum )
 531     LEFT JOIN cust_main USING ( custnum )
 532     LEFT JOIN cust_pkg USING ( pkgnum )
 533     LEFT JOIN part_pkg USING ( pkgpart )
 534     LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 535     LEFT JOIN part_fee USING ( feepart )';
 536
 537 sub cust_bill_pkg_setup {
 538   my $self = shift;
 539   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 540   # no projecting setup fees--use real invoices only
 541   # but evaluate this anyway, because the design of projection is that
 542   # if there are somehow real setup fees in the future, we want to count
 543   # them
 544
 545   $agentnum ||= $opt{'agentnum'};
 546
 547   my @where = (
 548     '(pkgnum != 0 OR feepart IS NOT NULL)',
 549     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 550     $self->with_report_option(%opt),
 551     $self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
 552     $self->with_refnum(%opt),
 553     $self->with_cust_classnum(%opt)
 554   );
 555
 556   my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0)
 557   FROM cust_bill_pkg
 558   $cust_bill_pkg_join
 559   WHERE " . join(' AND ', grep $_, @where);
 560
 561   $self->scalar_sql($total_sql);
 562 }
 563
 564 sub _cust_bill_pkg_recurring {
 565   # returns the FROM/WHERE part of the statement to query all recurring
 566   # line items in the period
 567   my $self = shift;
 568   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 569
 570   $agentnum ||= $opt{'agentnum'};
 571   my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg';
 572
 573   my @where = (
 574     '(pkgnum != 0 OR feepart IS NOT NULL)',
 575     $self->with_report_option(%opt),
 576     $self->with_refnum(%opt),
 577     $self->with_cust_classnum(%opt)
 578   );
 579
 580   my $where_classnum = $self->with_classnum($opt{'classnum'}, $opt{'use_override'});
 581   if ($opt{'project'}) {
 582     $where_classnum =~ s/\bcust_bill_pkg/v_cust_bill_pkg/g;
 583   }
 584   push @where, $where_classnum;
 585
 586   if ( $opt{'distribute'} ) {
 587     $where[0] = 'pkgnum != 0'; # specifically exclude fees
 588     push @where, "cust_main.agentnum = $agentnum" if $agentnum;
 589     push @where,
 590       "$cust_bill_pkg.sdate <  $eperiod",
 591       "$cust_bill_pkg.edate >= $speriod",
 592     ;
 593   }
 594   else {
 595     # we don't want to have to create v_cust_bill
 596     my $_date = $opt{'project'} ? 'v_cust_bill_pkg._date' : 'cust_bill._date';
 597     push @where,
 598       $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, $_date);
 599   }
 600
 601   return "
 602   FROM $cust_bill_pkg
 603   $cust_bill_pkg_join
 604   WHERE ".join(' AND ', grep $_, @where);
 605
 606 }
 607
 608 sub cust_bill_pkg_recur {
 609   my $self = shift;
 610   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 611
 612   # subtract all usage from the line item regardless of date
 613   my $item_usage;
 614   if ( $opt{'project'} ) {
 615     $item_usage = 'usage'; #already calculated
 616   }
 617   else {
 618     $item_usage = '( SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
 619       FROM cust_bill_pkg_detail
 620       WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum )';
 621   }
 622
 623   my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg';
 624
 625   my $recur_fraction = '';
 626   if ($opt{'distribute'}) {
 627     # the fraction of edate - sdate that's within [speriod, eperiod]
 628     $recur_fraction = " *
 629       CAST(LEAST($eperiod, $cust_bill_pkg.edate) -
 630        GREATEST($speriod, $cust_bill_pkg.sdate) AS DECIMAL) /
 631       ($cust_bill_pkg.edate - $cust_bill_pkg.sdate)";
 632   }
 633
 634   my $total_sql =
 635     "SELECT COALESCE(SUM(($cust_bill_pkg.recur - $item_usage) $recur_fraction),0)" .
 636     $self->_cust_bill_pkg_recurring(@_);
 637
 638   $self->scalar_sql($total_sql);
 639 }
 640
 641 sub cust_bill_pkg_count_pkgnum {
 642   # for ARPU calculation
 643   my $self = shift;
 644   my $total_sql = 'SELECT COUNT(DISTINCT pkgnum) '.
 645     $self->_cust_bill_pkg_recurring(@_);
 646
 647   $self->scalar_sql($total_sql);
 648 }
 649
 650 =item cust_bill_pkg_detail: the total usage charges in detail lines.
 651
 652 Arguments as for C<cust_bill_pkg>, plus:
 653
 654 'usageclass': limit to this usage class number.
 655
 656 =cut
 657
 658 sub cust_bill_pkg_detail {
 659   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 660
 661   my @where =
 662     ( "(cust_bill_pkg.pkgnum != 0 OR cust_bill_pkg.feepart IS NOT NULL)" );
 663
 664   $agentnum ||= $opt{'agentnum'};
 665
 666   push @where,
 667     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 668     $self->with_usageclass($opt{'usageclass'}),
 669     $self->with_report_option(%opt),
 670     $self->with_refnum(%opt),
 671     $self->with_cust_classnum(%opt)
 672     ;
 673
 674   if ( $opt{'distribute'} ) {
 675     # exclude fees
 676     $where[0] = 'cust_bill_pkg.pkgnum != 0';
 677     # and limit according to the usage time, not the billing date
 678     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 679       'cust_bill_pkg_detail.startdate'
 680     );
 681   }
 682   else {
 683     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 684       'cust_bill._date'
 685     );
 686   }
 687
 688   my $total_sql = " SELECT SUM(cust_bill_pkg_detail.amount) ";
 689
 690   $total_sql .=
 691     " FROM cust_bill_pkg_detail
 692         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 693         LEFT JOIN cust_bill ON cust_bill_pkg.invnum = cust_bill.invnum
 694         LEFT JOIN cust_main USING ( custnum )
 695         LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum
 696         LEFT JOIN part_pkg USING ( pkgpart )
 697         LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 698         LEFT JOIN part_fee USING ( feepart )
 699       WHERE ".join( ' AND ', grep $_, @where );
 700
 701   $self->scalar_sql($total_sql);
 702
 703 }
 704
 705 sub cust_bill_pkg_discount {
 706   my $self = shift;
 707   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 708   # apply all the same constraints here as for setup/recur
 709
 710   $agentnum ||= $opt{'agentnum'};
 711
 712   my @where = (
 713     '(pkgnum != 0 OR feepart IS NOT NULL)',
 714     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 715     $self->with_report_option(%opt),
 716     $self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
 717     $self->with_refnum(%opt),
 718     $self->with_cust_classnum(%opt)
 719   );
 720
 721   my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg_discount.amount), 0)
 722   FROM cust_bill_pkg_discount
 723   JOIN cust_bill_pkg USING (billpkgnum)
 724   $cust_bill_pkg_join
 725   WHERE " . join(' AND ', grep $_, @where);
 726
 727   $self->scalar_sql($total_sql);
 728 }
 729
 730 ##### package churn report #####
 731
 732 =item active_pkg: The number of packages that were active at the start of
 733 the period. The end date of the period is ignored. Options:
 734
 735 - refnum: Limit to customers with this advertising source.
 736 - classnum: Limit to packages with this class.
 737 - towernum: Limit to packages that have a broadband service with this tower.
 738 - zip: Limit to packages with this service location zip code.
 739
 740 Except for zip, any of these can be an arrayref to allow multiple values for
 741 the field.
 742
 743 =item setup_pkg: The number of packages with setup dates in the period. This
 744 excludes packages created by package changes. Options are as for active_pkg.
 745
 746 =item susp_pkg: The number of packages that were suspended in the period
 747 (and not canceled).  Options are as for active_pkg.
 748
 749 =item unsusp_pkg: The number of packages that were unsuspended in the period.
 750 Options are as for active_pkg.
 751
 752 =item cancel_pkg: The number of packages with cancel dates in the period.
 753 Excludes packages that were canceled to be changed to a new package. Options
 754 are as for active_pkg.
 755
 756 =cut
 757
 758 sub active_pkg {
 759   my $self = shift;
 760   $self->churn_pkg('active', @_);
 761 }
 762
 763 sub setup_pkg {
 764   my $self = shift;
 765   $self->churn_pkg('setup', @_);
 766 }
 767
 768 sub cancel_pkg {
 769   my $self = shift;
 770   $self->churn_pkg('cancel', @_);
 771 }
 772
 773 sub susp_pkg {
 774   my $self = shift;
 775   $self->churn_pkg('susp', @_);
 776 }
 777
 778 sub unsusp_pkg {
 779   my $self = shift;
 780   $self->churn_pkg('unsusp', @_);
 781 }
 782
 783 sub churn_pkg {
 784   my $self = shift;
 785   my ( $status, $speriod, $eperiod, $agentnum, %opt ) = @_;
 786   my ($from, @where) =
 787     FS::h_cust_pkg->churn_fromwhere_sql( $status, $speriod, $eperiod);
 788
 789   push @where, $self->pkg_where(%opt, 'agentnum' => $agentnum);
 790
 791   my $sql = "SELECT COUNT(*) FROM $from
 792     JOIN part_pkg ON (cust_pkg.pkgpart = part_pkg.pkgpart)
 793     JOIN cust_main ON (cust_pkg.custnum = cust_main.custnum)";
 794   $sql .= ' WHERE '.join(' AND ', @where)
 795     if scalar(@where);
 796
 797   $self->scalar_sql($sql);
 798 }
 799
 800 sub pkg_where {
 801   my $self = shift;
 802   my %opt = @_;
 803   my @where = (
 804     "part_pkg.freq != '0'",
 805     $self->with_refnum(%opt),
 806     $self->with_towernum(%opt),
 807     $self->with_zip(%opt),
 808   );
 809   if ($opt{agentnum} =~ /^(\d+)$/) {
 810     push @where, "cust_main.agentnum = $1";
 811   }
 812   if ($opt{classnum}) {
 813     my $classnum = $opt{classnum};
 814     $classnum = [ $classnum ] if !ref($classnum);
 815     @$classnum = grep /^\d+$/, @$classnum;
 816     my $in = 'IN ('. join(',', @$classnum). ')';
 817     push @where, "COALESCE(part_pkg.classnum, 0) $in" if scalar @$classnum;
 818   }
 819   @where;
 820 }
 821
 822 ##### end of package churn report stuff #####
 823
 824 ##### customer churn report #####
 825
 826 =item active_cust: The number of customers who had any active recurring
 827 packages at the start of the period. The end date is ignored, agentnum is
 828 mandatory, and no other parameters are accepted.
 829
 830 =item started_cust: The number of customers who had no active packages at
 831 the start of the period, but had active packages at the end. Like
 832 active_cust, agentnum is mandatory and no other parameters are accepted.
 833
 834 =item suspended_cust: The number of customers who had active packages at
 835 the start of the period, and at the end had no active packages but some
 836 suspended packages. Note that this does not necessarily mean that their
 837 packages were suspended during the period.
 838
 839 =item resumed_cust: The inverse of suspended_cust: the number of customers
 840 who had suspended packages and no active packages at the start of the
 841 period, and active packages at the end.
 842
 843 =item cancelled_cust: The number of customers who had active packages
 844 at the start of the period, and only cancelled packages at the end.
 845
 846 =cut
 847
 848 sub active_cust {
 849   my $self = shift;
 850   $self->churn_cust(@_)->{active};
 851 }
 852 sub started_cust {
 853   my $self = shift;
 854   $self->churn_cust(@_)->{started};
 855 }
 856 sub suspended_cust {
 857   my $self = shift;
 858   $self->churn_cust(@_)->{suspended};
 859 }
 860 sub resumed_cust {
 861   my $self = shift;
 862   $self->churn_cust(@_)->{resumed};
 863 }
 864 sub cancelled_cust {
 865   my $self = shift;
 866   $self->churn_cust(@_)->{cancelled};
 867 }
 868
 869 sub churn_cust {
 870   my $self = shift;
 871   my ( $speriod ) = @_;
 872
 873   # run one query for each interval
 874   return $self->{_interval}{$speriod} ||= $self->calculate_churn_cust(@_);
 875 }
 876
 877 sub calculate_churn_cust {
 878   my $self = shift;
 879   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 880
 881   my $churn_sql = FS::cust_main::Status->churn_sql($speriod, $eperiod);
 882   my $where = '';
 883   $where = " WHERE cust_main.agentnum = $agentnum " if $agentnum;
 884   my $cust_sql =
 885     "SELECT churn.* ".
 886     "FROM cust_main JOIN ($churn_sql) AS churn USING (custnum)".
 887     $where;
 888
 889   # query to count the ones with certain status combinations
 890   my $total_sql = "
 891     SELECT SUM((s_active > 0)::int)                   as active,
 892            SUM((s_active = 0 and e_active > 0)::int)  as started,
 893            SUM((s_active > 0 and e_active = 0 and e_suspended > 0)::int)
 894                                                       as suspended,
 895            SUM((s_active = 0 and s_suspended > 0 and e_active > 0)::int)
 896                                                       as resumed,
 897            SUM((s_active > 0 and e_active = 0 and e_suspended = 0)::int)
 898                                                       as cancelled
 899     FROM ($cust_sql) AS x
 900   ";
 901
 902   my $sth = dbh->prepare($total_sql);
 903   $sth->execute or die "failed to execute churn query: " . $sth->errstr;
 904
 905   $self->{_interval}{$speriod} = $sth->fetchrow_hashref;
 906 }
 907
 908 sub in_time_period_and_agent {
 909   my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4);
 910   my $col = @_ ? shift() : '_date';
 911
 912   my $sql = "$col >= $speriod AND $col < $eperiod";
 913
 914   #agent selection
 915   $sql .= " AND cust_main.agentnum = $agentnum"
 916     if $agentnum;
 917
 918   #agent virtualization
 919   $sql .= ' AND '.
 920           $FS::CurrentUser::CurrentUser->agentnums_sql( 'table'=>'cust_main' );
 921
 922   $sql;
 923 }
 924
 925 sub for_opts {
 926     my ( $self, %opt ) = @_;
 927     my $sql = '';
 928     if ( $opt{'custnum'} =~ /^(\d+)$/ ) {
 929       $sql .= " and custnum = $1 ";
 930     }
 931     if ( $opt{'refnum'} ) {
 932       my $refnum = $opt{'refnum'};
 933       $refnum = [ $refnum ] if !ref($refnum);
 934       my $in = join(',', grep /^\d+$/, @$refnum);
 935       $sql .= " and refnum IN ($in)" if length $in;
 936     }
 937     if ( my $where = $self->with_cust_classnum(%opt) ) {
 938       $sql .= " and $where";
 939     }
 940
 941     $sql;
 942 }
 943
 944 sub with_classnum {
 945   my ($self, $classnum, $use_override) = @_;
 946   return '' if $classnum eq '';
 947
 948   $classnum = [ $classnum ] if !ref($classnum);
 949   @$classnum = grep /^\d+$/, @$classnum;
 950   return '' if !@$classnum;
 951   my $in = 'IN ('. join(',', @$classnum). ')';
 952
 953   if ( $use_override ) {
 954     # then include packages if their base package is in the set and they are
 955     # not overridden,
 956     # or if they are overridden and their override package is in the set,
 957     # or fees if they are in the set
 958     return "(
 959          ( COALESCE(part_pkg.classnum, 0) $in AND cust_pkg.pkgpart IS NOT NULL AND pkgpart_override IS NULL )
 960       OR ( COALESCE(override.classnum, 0) $in AND pkgpart_override IS NOT NULL )
 961       OR ( COALESCE(part_fee.classnum, 0) $in AND cust_bill_pkg.feepart IS NOT NULL )
 962     )";
 963   } else {
 964     # include packages if their base package is in the set,
 965     # or fees if they are in the set
 966     return "(
 967          ( COALESCE(part_pkg.classnum, 0) $in AND cust_pkg.pkgpart IS NOT NULL )
 968       OR ( COALESCE(part_fee.classnum, 0) $in AND cust_bill_pkg.feepart IS NOT NULL )
 969     )";
 970   }
 971 }
 972
 973 sub with_usageclass {
 974   my $self = shift;
 975   my ($classnum, $use_override) = @_;
 976   return '' unless $classnum =~ /^\d+$/;
 977   my $comparison;
 978   if ( $classnum == 0 ) {
 979     $comparison = 'IS NULL';
 980   }
 981   else {
 982     $comparison = "= $classnum";
 983   }
 984   return "cust_bill_pkg_detail.classnum $comparison";
 985 }
 986
 987 sub with_report_option {
 988   my ($self, %opt) = @_;
 989   # %opt can contain:
 990   # - report_optionnum: a comma-separated list of numbers.  Zero means to
 991   #   include packages with _no_ report classes.
 992   # - not_report_optionnum: a comma-separated list.  Packages that have
 993   #   any of these report options will be excluded from the result.
 994   #   Zero does nothing.
 995   # - use_override: also matches line items that are add-ons to a package
 996   #   matching the report class.
 997   # - all_report_options: returns only packages that have ALL of the
 998   #   report classes listed in $num.  Otherwise, will return packages that
 999   #   have ANY of those classes.
1000
1001   my @num = ref($opt{'report_optionnum'})
1002                   ? @{ $opt{'report_optionnum'} }
1003                   : split(/\s*,\s*/, $opt{'report_optionnum'});
1004   my @not_num = ref($opt{'not_report_optionnum'})
1005                       ? @{ $opt{'not_report_optionnum'} }
1006                       : split(/\s*,\s*/, $opt{'not_report_optionnum'});
1007   my $null;
1008   $null = 1 if ( grep {$_ == 0} @num );
1009   @num = grep {$_ > 0} @num;
1010   @not_num = grep {$_ > 0} @not_num;
1011
1012   # brute force
1013   my $table = $opt{'use_override'} ? 'override' : 'part_pkg';
1014   my $op = ' OR ';
1015   if ( $opt{'all_report_options'} ) {
1016     if ( @num and $null ) {
1017       return 'false'; # mutually exclusive criteria, so just bail out
1018     }
1019     $op = ' AND ';
1020   }
1021   my @where_num = map {
1022     "EXISTS(SELECT 1 FROM part_pkg_option ".
1023     "WHERE optionname = 'report_option_$_' ".
1024     "AND part_pkg_option.pkgpart = $table.pkgpart)"
1025   } @num;
1026   if ( $null ) {
1027     push @where_num, "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
1028                      "WHERE optionname LIKE 'report_option_%' ".
1029                      "AND part_pkg_option.pkgpart = $table.pkgpart)";
1030   }
1031   my @where_not_num = map {
1032     "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
1033     "WHERE optionname = 'report_option_$_' ".
1034     "AND part_pkg_option.pkgpart = $table.pkgpart)"
1035   } @not_num;
1036
1037   my @where;
1038   if (@where_num) {
1039     push @where, '( '.join($op, @where_num).' )';
1040   }
1041   if (@where_not_num) {
1042     push @where, '( '.join(' AND ', @where_not_num).' )';
1043   }
1044
1045   return @where;
1046   # this messes up totals
1047   #if ( $opt{'use_override'} ) {
1048   #  # then also allow the non-override package to match
1049   #  delete $opt{'use_override'};
1050   #  $comparison = "( $comparison OR " . $self->with_report_option(%opt) . ")";
1051   #}
1052
1053 }
1054
1055 sub with_refnum {
1056   my ($self, %opt) = @_;
1057   if ( $opt{'refnum'} ) {
1058     my $refnum = $opt{'refnum'};
1059     $refnum = [ $refnum ] if !ref($refnum);
1060     my $in = join(',', grep /^\d+$/, @$refnum);
1061     return "cust_main.refnum IN ($in)" if length $in;
1062   }
1063   return;
1064 }
1065
1066 sub with_towernum {
1067   my ($self, %opt) = @_;
1068   if ( $opt{'towernum'} ) {
1069     my $towernum = $opt{'towernum'};
1070     $towernum = [ $towernum ] if !ref($towernum);
1071     my $in = join(',', grep /^\d+$/, @$towernum);
1072     return unless length($in); # if no towers are specified, don't restrict
1073
1074     # materialize/cache the set of pkgnums that, as of the last
1075     # svc_broadband history record, had a certain towernum
1076     # (because otherwise this is painfully slow)
1077     $self->_init_tower_pkg_cache;
1078
1079     return "EXISTS(
1080             SELECT 1 FROM tower_pkg_cache
1081               WHERE towernum IN($in)
1082               AND cust_pkg.pkgnum = tower_pkg_cache.pkgnum
1083             )";
1084   }
1085   return;
1086 }
1087
1088 sub with_zip {
1089   my ($self, %opt) = @_;
1090   if (length($opt{'zip'})) {
1091     return "(SELECT zip FROM cust_location
1092              WHERE cust_location.locationnum = cust_pkg.locationnum
1093             ) = " . dbh->quote($opt{'zip'});
1094   }
1095   return;
1096 }
1097
1098 sub with_cust_classnum {
1099   my ($self, %opt) = @_;
1100   if ( $opt{'cust_classnum'} ) {
1101     my $classnums = $opt{'cust_classnum'};
1102     $classnums = [ $classnums ] if !ref($classnums);
1103     @$classnums = grep /^\d+$/, @$classnums;
1104     return 'cust_main.classnum in('. join(',',@$classnums) .')'
1105       if @$classnums;
1106   }
1107   return;
1108 }
1109
1110
1111 sub scalar_sql {
1112   my( $self, $sql ) = ( shift, shift );
1113   my $sth = dbh->prepare($sql) or die dbh->errstr;
1114   warn "FS::Report::Table\n$sql\n" if $DEBUG;
1115   $sth->execute
1116     or die "Unexpected error executing statement $sql: ". $sth->errstr;
1117   $sth->fetchrow_arrayref->[0] || 0;
1118 }
1119
1120 =back
1121
1122 =head1 METHODS
1123
1124 =over 4
1125
1126 =item init_projection
1127
1128 Sets up for future projection of all observables on the report.  Currently
1129 this is limited to 'cust_bill_pkg'.
1130
1131 =cut
1132
1133 sub init_projection {
1134   # this is weird special case stuff--some redesign may be needed
1135   # to use it for anything else
1136   my $self = shift;
1137
1138   if ( driver_name ne 'Pg' ) {
1139     # also database-specific for now
1140     die "projection reports not supported on this platform";
1141   }
1142
1143   my %items = map {$_ => 1} @{ $self->{items} };
1144   if ($items{'cust_bill_pkg'}) {
1145     my $dbh = dbh;
1146     # v_ for 'virtual'
1147     my @sql = (
1148       # could use TEMPORARY TABLE but we're already transaction-protected
1149       'DROP TABLE IF EXISTS v_cust_bill_pkg',
1150       'CREATE TABLE v_cust_bill_pkg ' .
1151        '(LIKE cust_bill_pkg,
1152           usage numeric(10,2), _date integer, expire integer)',
1153       # XXX this should be smart enough to take only the ones with
1154       # sdate/edate overlapping the ROI, for performance
1155       "INSERT INTO v_cust_bill_pkg (
1156         SELECT cust_bill_pkg.*,
1157           (SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
1158           FROM cust_bill_pkg_detail
1159           WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum),
1160           cust_bill._date,
1161           cust_pkg.expire
1162         FROM cust_bill_pkg $cust_bill_pkg_join
1163       )",
1164     );
1165     foreach my $sql (@sql) {
1166       warn "[init_projection] $sql\n" if $DEBUG;
1167       $dbh->do($sql) or die $dbh->errstr;
1168     }
1169   }
1170 }
1171
1172 =item extend_projection START END
1173
1174 Generates data for the next period of projection.  This will be called
1175 for sequential periods where the END of one equals the START of the next
1176 (with no gaps).
1177
1178 =cut
1179
1180 sub extend_projection {
1181   my $self = shift;
1182   my ($speriod, $eperiod) = @_;
1183   my %items = map {$_ => 1} @{ $self->{items} };
1184   if ($items{'cust_bill_pkg'}) {
1185     # What we do here:
1186     # Find all line items that end after the start of the period (and have
1187     # recurring fees, and don't expire before they end).  Choose the latest
1188     # one for each package.  If it ends before the end of the period, copy
1189     # it forward by one billing period.
1190     # Repeat this until the latest line item for each package no longer ends
1191     # within the period.  This is certain to happen in finitely many
1192     # iterations as long as freq > 0.
1193     # - Pg only, obviously.
1194     # - Gives bad results if freq_override is used.
1195     my @fields = ( FS::cust_bill_pkg->fields, qw( usage _date expire ) );
1196     my $insert_fields = join(',', @fields);
1197     my $add_freq = sub { # emulate FS::part_pkg::add_freq
1198       my $field = shift;
1199       "EXTRACT( EPOCH FROM TO_TIMESTAMP($field) + (CASE WHEN freq ~ E'\\\\D' ".
1200       "THEN freq ELSE freq || 'mon' END)::INTERVAL) AS $field";
1201     };
1202     foreach (@fields) {
1203       if ($_ eq 'edate') {
1204         $_ = $add_freq->('edate');
1205       }
1206       elsif ($_ eq 'sdate') {
1207         $_ = 'edate AS sdate'
1208       }
1209       elsif ($_ eq 'setup') {
1210         $_ = '0 AS setup' #because recurring only
1211       }
1212       elsif ($_ eq '_date') {
1213         $_ = $add_freq->('_date');
1214       }
1215     }
1216     my $select_fields = join(',', @fields);
1217     my $dbh = dbh;
1218     my $sql =
1219     # Subquery here because we need to DISTINCT the whole set, select the
1220     # latest charge per pkgnum, and _then_ check edate < $eperiod
1221     # and edate < expire.
1222       "INSERT INTO v_cust_bill_pkg ($insert_fields)
1223         SELECT $select_fields FROM (
1224           SELECT DISTINCT ON (pkgnum) * FROM v_cust_bill_pkg
1225             WHERE edate >= $speriod
1226               AND recur > 0
1227               AND freq IS NOT NULL
1228               AND freq != '0'
1229             ORDER BY pkgnum, edate DESC
1230           ) AS v1
1231           WHERE edate < $eperiod AND (edate < expire OR expire IS NULL)";
1232     my $rows;
1233     do {
1234       warn "[extend_projection] $sql\n" if $DEBUG;
1235       $rows = $dbh->do($sql) or die $dbh->errstr;
1236       warn "[extend_projection] $rows rows\n" if $DEBUG;
1237     } until $rows == 0;
1238   }
1239 }
1240
1241 =item _init_tower_pkg_cache
1242
1243 Internal method: creates a temporary table relating pkgnums to towernums.
1244 A (pkgnum, towernum) record indicates that this package once had a
1245 svc_broadband service which, as of its last insert or replace_new history
1246 record, had a sectornum associated with that towernum.
1247
1248 This is expensive, so it won't be done more than once an hour. Historical
1249 data about package churn shouldn't be changing in realtime anyway.
1250
1251 =cut
1252
1253 sub _init_tower_pkg_cache {
1254   my $self = shift;
1255   my $dbh = dbh;
1256
1257   my $current = $CACHE->get('tower_pkg_cache_update');
1258   return if $current;
1259
1260   # XXX or should this be in the schema?
1261   my $sql = "DROP TABLE IF EXISTS tower_pkg_cache";
1262   $dbh->do($sql) or die $dbh->errstr;
1263   $sql = "CREATE TABLE tower_pkg_cache (towernum int, pkgnum int)";
1264   $dbh->do($sql) or die $dbh->errstr;
1265
1266   # assumptions:
1267   # sectornums never get reused, or move from one tower to another
1268   # all service history is intact
1269   # svcnums never get reused (this would be bad)
1270   # pkgnums NEVER get reused (this would be extremely bad)
1271   $sql = "INSERT INTO tower_pkg_cache (
1272     SELECT COALESCE(towernum,0), pkgnum
1273     FROM ( SELECT DISTINCT pkgnum, svcnum FROM h_cust_svc ) AS pkgnum_svcnum
1274     LEFT JOIN (
1275       SELECT DISTINCT ON(svcnum) svcnum, sectornum
1276         FROM h_svc_broadband
1277         WHERE (history_action = 'replace_new'
1278                OR history_action = 'replace_old')
1279         ORDER BY svcnum ASC, history_date DESC
1280     ) AS svcnum_sectornum USING (svcnum)
1281     LEFT JOIN tower_sector USING (sectornum)
1282   )";
1283   $dbh->do($sql) or die $dbh->errstr;
1284
1285   $CACHE->set('tower_pkg_cache_update', 1, 3600);
1286
1287 };
1288
1289 =head1 BUGS
1290
1291 Documentation.
1292
1293 =head1 SEE ALSO
1294
1295 L<FS::Report::Table::Monthly>, reports in the web interface.
1296
1297 =cut
1298
1299 1;