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