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