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