FS/FS/Report/Table.pm

   1 package FS::Report::Table;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   5 use FS::Report;
   6 use Time::Local qw( timelocal );
   7 use FS::UID qw( dbh driver_name );
   8 use FS::Report::Table;
   9 use FS::CurrentUser;
  10
  11 $DEBUG = 0; # turning this on will trace all SQL statements, VERY noisy
  12 @ISA = qw( FS::Report );
  13
  14 =head1 NAME
  15
  16 FS::Report::Table - Tables of report data
  17
  18 =head1 SYNOPSIS
  19
  20 See the more specific report objects, currently only
  21 FS::Report::Table::Monthly and FS::Report::Table::Daily.
  22
  23 =head1 OBSERVABLES
  24
  25 The common interface for an observable named 'foo' is:
  26
  27 $report->foo($startdate, $enddate, $agentnum, %options)
  28
  29 This returns a scalar value for foo, over the period from
  30 $startdate to $enddate, limited to agent $agentnum, subject to
  31 options in %opt.
  32
  33 =over 4
  34
  35 =item signups: The number of customers signed up.  Options are:
  36
  37 - cust_classnum: limit to this customer class
  38 - pkg_classnum: limit to customers with a package of this class.  If this is
  39   an arrayref, it's an ANY match.
  40 - refnum: limit to this advertising source
  41 - indirect: boolean; limit to customers that have a referral_custnum that
  42   matches the advertising source
  43
  44 =cut
  45
  46 sub signups {
  47   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
  48   my @where = ( $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
  49       'cust_main.signupdate')
  50   );
  51   my $join = '';
  52   if ( $opt{'indirect'} ) {
  53     $join = " JOIN cust_main AS referring_cust_main".
  54             " ON (cust_main.referral_custnum = referring_cust_main.custnum)";
  55
  56     if ( $opt{'refnum'} ) {
  57       push @where, "referring_cust_main.refnum = ".$opt{'refnum'};
  58     }
  59   }
  60   elsif ( $opt{'refnum'} ) {
  61     push @where, "refnum = ".$opt{'refnum'};
  62   }
  63
  64   push @where, $self->with_cust_classnum(%opt);
  65   if ( $opt{'pkg_classnum'} ) {
  66     my $classnum = $opt{'pkg_classnum'};
  67     $classnum = [ $classnum ] unless ref $classnum;
  68     @$classnum = grep /^\d+$/, @$classnum;
  69     if (@$classnum) {
  70       my $in = 'IN ('. join(',', @$classnum). ')';
  71       push @where,
  72         "EXISTS(SELECT 1 FROM cust_pkg JOIN part_pkg USING (pkgpart) ".
  73                "WHERE cust_pkg.custnum = cust_main.custnum ".
  74                "AND part_pkg.classnum $in".
  75                ")";
  76     }
  77   }
  78
  79   $self->scalar_sql(
  80     "SELECT COUNT(*) FROM cust_main $join WHERE ".join(' AND ', @where)
  81   );
  82 }
  83
  84 =item invoiced: The total amount charged on all invoices.
  85
  86 =cut
  87
  88 sub invoiced { #invoiced
  89   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
  90
  91   my $sql = 'SELECT SUM(cust_bill.charged) FROM cust_bill';
  92   if ( $opt{'setuprecur'} ) {
  93     $sql = 'SELECT SUM('.
  94             FS::cust_bill_pkg->charged_sql($speriod, $eperiod, %opt).
  95            ') FROM cust_bill_pkg JOIN cust_bill USING (invnum)';
  96   }
  97
  98   $self->scalar_sql("
  99       $sql
 100         LEFT JOIN cust_main USING ( custnum )
 101       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 102                $self->for_opts(%opt)
 103   );
 104
 105 }
 106
 107 =item netsales: invoiced - netcredits
 108
 109 =cut
 110
 111 sub netsales { #net sales
 112   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 113
 114     $self->invoiced(  $speriod, $eperiod, $agentnum, %opt)
 115   - $self->netcredits($speriod, $eperiod, $agentnum, %opt);
 116 }
 117
 118 =item cashflow: payments - refunds
 119
 120 =cut
 121
 122 sub cashflow {
 123   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 124
 125     $self->payments($speriod, $eperiod, $agentnum, %opt)
 126   - $self->refunds( $speriod, $eperiod, $agentnum, %opt);
 127 }
 128
 129 =item netcashflow: payments - netrefunds
 130
 131 =cut
 132
 133 sub netcashflow {
 134   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 135
 136     $self->receipts(   $speriod, $eperiod, $agentnum, %opt)
 137   - $self->netrefunds( $speriod, $eperiod, $agentnum, %opt);
 138 }
 139
 140 =item payments: The sum of payments received in the period.
 141
 142 =cut
 143
 144 sub payments {
 145   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 146   $self->scalar_sql("
 147     SELECT SUM(paid)
 148       FROM cust_pay
 149         LEFT JOIN cust_main USING ( custnum )
 150       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 151                $self->for_opts(%opt)
 152   );
 153 }
 154
 155 =item credits: The sum of credits issued in the period.
 156
 157 =cut
 158
 159 sub credits {
 160   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 161   $self->scalar_sql("
 162     SELECT SUM(cust_credit.amount)
 163       FROM cust_credit
 164         LEFT JOIN cust_main USING ( custnum )
 165       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 166                $self->for_opts(%opt)
 167   );
 168 }
 169
 170 =item refunds: The sum of refunds paid in the period.
 171
 172 =cut
 173
 174 sub refunds {
 175   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 176   $self->scalar_sql("
 177     SELECT SUM(refund)
 178       FROM cust_refund
 179         LEFT JOIN cust_main USING ( custnum )
 180       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 181                $self->for_opts(%opt)
 182   );
 183 }
 184
 185 =item netcredits: The sum of credit applications to invoices in the period.
 186
 187 =cut
 188
 189 sub netcredits {
 190   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 191
 192   my $sql = 'SELECT SUM(cust_credit_bill.amount) FROM cust_credit_bill';
 193   if ( $opt{'setuprecur'} ) {
 194     $sql = 'SELECT SUM('.
 195             FS::cust_bill_pkg->credited_sql($speriod, $eperiod, %opt).
 196            ') FROM cust_bill_pkg';
 197   }
 198
 199   $self->scalar_sql("
 200     $sql
 201         LEFT JOIN cust_bill USING ( invnum  )
 202         LEFT JOIN cust_main USING ( custnum )
 203       WHERE ". $self->in_time_period_and_agent( $speriod,
 204                                                 $eperiod,
 205                                                 $agentnum,
 206                                                 'cust_bill._date'
 207                                               ).
 208                $self->for_opts(%opt)
 209   );
 210 }
 211
 212 =item receipts: The sum of payment applications to invoices in the period.
 213
 214 =cut
 215
 216 sub receipts { #net payments
 217   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 218
 219   my $sql = 'SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay';
 220   if ( $opt{'setuprecur'} ) {
 221     $sql = 'SELECT SUM('.
 222             FS::cust_bill_pkg->paid_sql($speriod, $eperiod, %opt).
 223            ') FROM cust_bill_pkg';
 224   }
 225
 226   $self->scalar_sql("
 227     $sql
 228         LEFT JOIN cust_bill USING ( invnum  )
 229         LEFT JOIN cust_main USING ( custnum )
 230       WHERE ". $self->in_time_period_and_agent( $speriod,
 231                                                 $eperiod,
 232                                                 $agentnum,
 233                                                 'cust_bill._date'
 234                                               ).
 235                $self->for_opts(%opt)
 236   );
 237 }
 238
 239 =item netrefunds: The sum of refund applications to credits in the period.
 240
 241 =cut
 242
 243 sub netrefunds {
 244   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 245   $self->scalar_sql("
 246     SELECT SUM(cust_credit_refund.amount)
 247       FROM cust_credit_refund
 248         LEFT JOIN cust_credit USING ( crednum  )
 249         LEFT JOIN cust_main   USING ( custnum )
 250       WHERE ". $self->in_time_period_and_agent( $speriod,
 251                                                 $eperiod,
 252                                                 $agentnum,
 253                                                 'cust_credit._date'
 254                                               ).
 255                $self->for_opts(%opt)
 256   );
 257 }
 258
 259 #XXX docs
 260
 261 #these should be auto-generated or $AUTOLOADed or something
 262 sub invoiced_12mo {
 263   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 264   $speriod = $self->_subtract_11mo($speriod);
 265   $self->invoiced($speriod, $eperiod, $agentnum);
 266 }
 267
 268 sub netsales_12mo {
 269   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 270   $speriod = $self->_subtract_11mo($speriod);
 271   $self->netsales($speriod, $eperiod, $agentnum);
 272 }
 273
 274 sub receipts_12mo {
 275   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 276   $speriod = $self->_subtract_11mo($speriod);
 277   $self->receipts($speriod, $eperiod, $agentnum);
 278 }
 279
 280 sub payments_12mo {
 281   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 282   $speriod = $self->_subtract_11mo($speriod);
 283   $self->payments($speriod, $eperiod, $agentnum);
 284 }
 285
 286 sub credits_12mo {
 287   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 288   $speriod = $self->_subtract_11mo($speriod);
 289   $self->credits($speriod, $eperiod, $agentnum);
 290 }
 291
 292 sub netcredits_12mo {
 293   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 294   $speriod = $self->_subtract_11mo($speriod);
 295   $self->netcredits($speriod, $eperiod, $agentnum);
 296 }
 297
 298 sub cashflow_12mo {
 299   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 300   $speriod = $self->_subtract_11mo($speriod);
 301   $self->cashflow($speriod, $eperiod, $agentnum);
 302 }
 303
 304 sub netcashflow_12mo {
 305   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 306   $speriod = $self->_subtract_11mo($speriod);
 307   $self->cashflow($speriod, $eperiod, $agentnum);
 308 }
 309
 310 sub refunds_12mo {
 311   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 312   $speriod = $self->_subtract_11mo($speriod);
 313   $self->refunds($speriod, $eperiod, $agentnum);
 314 }
 315
 316 sub netrefunds_12mo {
 317   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 318   $speriod = $self->_subtract_11mo($speriod);
 319   $self->netrefunds($speriod, $eperiod, $agentnum);
 320 }
 321
 322
 323 #not being too bad with the false laziness
 324 sub _subtract_11mo {
 325   my($self, $time) = @_;
 326   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
 327   $mon -= 11;
 328   if ( $mon < 0 ) { $mon+=12; $year--; }
 329   timelocal($sec,$min,$hour,$mday,$mon,$year);
 330 }
 331
 332 =item cust_pkg_setup_cost: The total setup costs of packages setup in the period
 333
 334 'classnum': limit to this package class.
 335
 336 =cut
 337
 338 sub cust_pkg_setup_cost {
 339   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 340   my $where = '';
 341
 342   if ( $opt{'classnum'} ne '' ) {
 343     my $classnums = $opt{'classnum'};
 344     $classnums = [ $classnums ] if !ref($classnums);
 345     @$classnums = grep /^\d+$/, @$classnums;
 346     $where .= ' AND COALESCE(part_pkg.classnum,0) IN ('. join(',', @$classnums).
 347                                                     ')';
 348   }
 349
 350   $agentnum ||= $opt{'agentnum'};
 351
 352   my $total_sql = " SELECT SUM(part_pkg.setup_cost) ";
 353   $total_sql .= " FROM cust_pkg
 354              LEFT JOIN cust_main USING ( custnum )
 355              LEFT JOIN part_pkg  USING ( pkgpart )
 356                   WHERE pkgnum != 0
 357                   $where
 358                   AND ".$self->in_time_period_and_agent(
 359                     $speriod, $eperiod, $agentnum, 'cust_pkg.setup');
 360   return $self->scalar_sql($total_sql);
 361 }
 362
 363 =item cust_pkg_recur_cust: the total recur costs of packages in the period
 364
 365 'classnum': limit to this package class.
 366
 367 =cut
 368
 369 sub cust_pkg_recur_cost {
 370   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 371   my $where = '';
 372
 373   if ( $opt{'classnum'} ne '' ) {
 374     my $classnums = $opt{'classnum'};
 375     $classnums = [ $classnums ] if !ref($classnums);
 376     @$classnums = grep /^\d+$/, @$classnums;
 377     $where .= ' AND COALESCE(part_pkg.classnum,0) IN ('. join(',', @$classnums).
 378                                                     ')';
 379   }
 380
 381   $agentnum ||= $opt{'agentnum'};
 382   # duplication of in_time_period_and_agent
 383   # because we do it a little differently here
 384   $where .= " AND cust_main.agentnum = $agentnum" if $agentnum;
 385   $where .= " AND ".
 386           $FS::CurrentUser::CurrentUser->agentnums_sql('table' => 'cust_main');
 387
 388   my $total_sql = " SELECT SUM(part_pkg.recur_cost) ";
 389   $total_sql .= " FROM cust_pkg
 390              LEFT JOIN cust_main USING ( custnum )
 391              LEFT JOIN part_pkg  USING ( pkgpart )
 392                   WHERE pkgnum != 0
 393                   $where
 394                   AND cust_pkg.setup < $eperiod
 395                   AND (cust_pkg.cancel > $speriod OR cust_pkg.cancel IS NULL)
 396                   ";
 397   return $self->scalar_sql($total_sql);
 398 }
 399
 400 =item cust_bill_pkg: the total package charges on invoice line items.
 401
 402 'charges': limit the type of charges included (setup, recur, usage).
 403 Should be a string containing one or more of 'S', 'R', or 'U'; if
 404 unspecified, defaults to all three.
 405
 406 'classnum': limit to this package class.
 407
 408 'use_override': for line items generated by an add-on package, use the class
 409 of the add-on rather than the base package.
 410
 411 'distribute': for non-monthly recurring charges, ignore the invoice
 412 date.  Instead, consider the line item's starting/ending dates.  Determine
 413 the fraction of the line item duration that falls within the specified
 414 interval and return that fraction of the recurring charges.  This is
 415 somewhat experimental.
 416
 417 'project': enable if this is a projected period.  This is very experimental.
 418
 419 =cut
 420
 421 sub cust_bill_pkg {
 422   my $self = shift;
 423   my( $speriod, $eperiod, $agentnum, %opt ) = @_;
 424
 425   my %charges = map {$_=>1} split('', $opt{'charges'} || 'SRU');
 426
 427   my $sum = 0;
 428   $sum += $self->cust_bill_pkg_setup(@_) if $charges{S};
 429   $sum += $self->cust_bill_pkg_recur(@_) if $charges{R};
 430   $sum += $self->cust_bill_pkg_detail(@_) if $charges{U};
 431   $sum;
 432 }
 433
 434 my $cust_bill_pkg_join = '
 435     LEFT JOIN cust_bill USING ( invnum )
 436     LEFT JOIN cust_main USING ( custnum )
 437     LEFT JOIN cust_pkg USING ( pkgnum )
 438     LEFT JOIN part_pkg USING ( pkgpart )
 439     LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 440     LEFT JOIN part_fee USING ( feepart )';
 441
 442 sub cust_bill_pkg_setup {
 443   my $self = shift;
 444   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 445   # no projecting setup fees--use real invoices only
 446   # but evaluate this anyway, because the design of projection is that
 447   # if there are somehow real setup fees in the future, we want to count
 448   # them
 449
 450   $agentnum ||= $opt{'agentnum'};
 451
 452   my @where = (
 453     '(pkgnum != 0 OR feepart IS NOT NULL)',
 454     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 455     $self->with_report_option(%opt),
 456     $self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
 457   );
 458
 459   # yuck, false laziness
 460   push @where, "cust_main.refnum = ". $opt{'refnum'} if $opt{'refnum'};
 461
 462   push @where, $self->with_cust_classnum(%opt);
 463
 464   my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0)
 465   FROM cust_bill_pkg
 466   $cust_bill_pkg_join
 467   WHERE " . join(' AND ', grep $_, @where);
 468
 469   $self->scalar_sql($total_sql);
 470 }
 471
 472 sub cust_bill_pkg_recur {
 473   my $self = shift;
 474   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 475
 476   $agentnum ||= $opt{'agentnum'};
 477   my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg';
 478
 479   my @where = (
 480     '(pkgnum != 0 OR feepart IS NOT NULL)',
 481     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 482     $self->with_report_option(%opt),
 483   );
 484
 485   push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'};
 486
 487   push @where, $self->with_cust_classnum(%opt);
 488
 489   # subtract all usage from the line item regardless of date
 490   my $item_usage;
 491   if ( $opt{'project'} ) {
 492     $item_usage = 'usage'; #already calculated
 493   }
 494   else {
 495     $item_usage = '( SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
 496       FROM cust_bill_pkg_detail
 497       WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum )';
 498   }
 499   my $recur_fraction = '';
 500
 501   if ( $opt{'distribute'} ) {
 502     $where[0] = 'pkgnum != 0'; # specifically exclude fees
 503     push @where, "cust_main.agentnum = $agentnum" if $agentnum;
 504     push @where,
 505       "$cust_bill_pkg.sdate <  $eperiod",
 506       "$cust_bill_pkg.edate >= $speriod",
 507     ;
 508     # the fraction of edate - sdate that's within [speriod, eperiod]
 509     $recur_fraction = " *
 510       CAST(LEAST($eperiod, $cust_bill_pkg.edate) -
 511        GREATEST($speriod, $cust_bill_pkg.sdate) AS DECIMAL) /
 512       ($cust_bill_pkg.edate - $cust_bill_pkg.sdate)";
 513   }
 514   else {
 515     # we don't want to have to create v_cust_bill
 516     my $_date = $opt{'project'} ? 'v_cust_bill_pkg._date' : 'cust_bill._date';
 517     push @where,
 518       $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, $_date);
 519   }
 520
 521   my $total_sql = 'SELECT '.
 522   "COALESCE(SUM(($cust_bill_pkg.recur - $item_usage) $recur_fraction),0)
 523   FROM $cust_bill_pkg
 524   $cust_bill_pkg_join
 525   WHERE ".join(' AND ', grep $_, @where);
 526
 527   $self->scalar_sql($total_sql);
 528 }
 529
 530 =item cust_bill_pkg_detail: the total usage charges in detail lines.
 531
 532 Arguments as for C<cust_bill_pkg>, plus:
 533
 534 'usageclass': limit to this usage class number.
 535
 536 =cut
 537
 538 sub cust_bill_pkg_detail {
 539   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 540
 541   my @where =
 542     ( "(cust_bill_pkg.pkgnum != 0 OR cust_bill_pkg.feepart IS NOT NULL)" );
 543
 544   push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'};
 545
 546   push @where, $self->with_cust_classnum(%opt);
 547
 548   $agentnum ||= $opt{'agentnum'};
 549
 550   push @where,
 551     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 552     $self->with_usageclass($opt{'usageclass'}),
 553     $self->with_report_option(%opt),
 554     ;
 555
 556   if ( $opt{'distribute'} ) {
 557     # exclude fees
 558     $where[0] = 'cust_bill_pkg.pkgnum != 0';
 559     # and limit according to the usage time, not the billing date
 560     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 561       'cust_bill_pkg_detail.startdate'
 562     );
 563   }
 564   else {
 565     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 566       'cust_bill._date'
 567     );
 568   }
 569
 570   my $total_sql = " SELECT SUM(cust_bill_pkg_detail.amount) ";
 571
 572   $total_sql .=
 573     " / CASE COUNT(cust_pkg.*) WHEN 0 THEN 1 ELSE COUNT(cust_pkg.*) END "
 574       if $opt{average_per_cust_pkg};
 575
 576   $total_sql .=
 577     " FROM cust_bill_pkg_detail
 578         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 579         LEFT JOIN cust_bill ON cust_bill_pkg.invnum = cust_bill.invnum
 580         LEFT JOIN cust_main USING ( custnum )
 581         LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum
 582         LEFT JOIN part_pkg USING ( pkgpart )
 583         LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 584         LEFT JOIN part_fee USING ( feepart )
 585       WHERE ".join( ' AND ', grep $_, @where );
 586
 587   $self->scalar_sql($total_sql);
 588
 589 }
 590
 591 sub cust_bill_pkg_discount {
 592   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 593
 594   #need to do this the new multi-classnum way if it gets re-enabled
 595   #my $where = '';
 596   #my $comparison = '';
 597   #if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
 598   #  if ( $1 == 0 ) {
 599   #    $comparison = "IS NULL";
 600   #  } else {
 601   #    $comparison = "= $1";
 602   #  }
 603   #
 604   #  if ( $opt{'use_override'} ) {
 605   #    $where = "(
 606   #      part_pkg.classnum $comparison AND pkgpart_override IS NULL OR
 607   #      override.classnum $comparison AND pkgpart_override IS NOT NULL
 608   #    )";
 609   #  } else {
 610   #    $where = "part_pkg.classnum $comparison";
 611   #  }
 612   #}
 613
 614   $agentnum ||= $opt{'agentnum'};
 615
 616   my $total_sql =
 617     " SELECT COALESCE( SUM( cust_bill_pkg_discount.amount ), 0 ) ";
 618
 619   #$total_sql .=
 620   #  " / CASE COUNT(cust_pkg.*) WHEN 0 THEN 1 ELSE COUNT(cust_pkg.*) END "
 621   #    if $opt{average_per_cust_pkg};
 622
 623   $total_sql .=
 624     " FROM cust_bill_pkg_discount
 625         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 626         LEFT JOIN cust_bill USING ( invnum )
 627         LEFT JOIN cust_main USING ( custnum )
 628       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum);
 629   #      LEFT JOIN cust_pkg_discount USING ( pkgdiscountnum )
 630   #      LEFT JOIN discount USING ( discountnum )
 631   #      LEFT JOIN cust_pkg USING ( pkgnum )
 632   #      LEFT JOIN part_pkg USING ( pkgpart )
 633   #      LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 634
 635   return $self->scalar_sql($total_sql);
 636
 637 }
 638
 639 sub setup_pkg  { shift->pkg_field( 'setup',  @_ ); }
 640 sub susp_pkg   { shift->pkg_field( 'susp',   @_ ); }
 641 sub cancel_pkg { shift->pkg_field( 'cancel', @_ ); }
 642
 643 sub pkg_field {
 644   my( $self, $field, $speriod, $eperiod, $agentnum ) = @_;
 645   $self->scalar_sql("
 646     SELECT COUNT(*) FROM cust_pkg
 647         LEFT JOIN cust_main USING ( custnum )
 648       WHERE ". $self->in_time_period_and_agent( $speriod,
 649                                                 $eperiod,
 650                                                 $agentnum,
 651                                                 "cust_pkg.$field",
 652                                               )
 653   );
 654
 655 }
 656
 657 #this is going to be harder..
 658 #sub unsusp_pkg {
 659 #  my( $self, $speriod, $eperiod, $agentnum ) = @_;
 660 #  $self->scalar_sql("
 661 #    SELECT COUNT(*) FROM h_cust_pkg
 662 #      WHERE
 663 #
 664 #}
 665
 666 sub in_time_period_and_agent {
 667   my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4);
 668   my $col = @_ ? shift() : '_date';
 669
 670   my $sql = "$col >= $speriod AND $col < $eperiod";
 671
 672   #agent selection
 673   $sql .= " AND cust_main.agentnum = $agentnum"
 674     if $agentnum;
 675
 676   #agent virtualization
 677   $sql .= ' AND '.
 678           $FS::CurrentUser::CurrentUser->agentnums_sql( 'table'=>'cust_main' );
 679
 680   $sql;
 681 }
 682
 683 sub for_opts {
 684     my ( $self, %opt ) = @_;
 685     my $sql = '';
 686     if ( $opt{'custnum'} =~ /^(\d+)$/ ) {
 687       $sql .= " and custnum = $1 ";
 688     }
 689     if ( $opt{'refnum'} =~ /^(\d+)$/ ) {
 690       $sql .= " and refnum = $1 ";
 691     }
 692     if ( my $where = $self->with_cust_classnum(%opt) ) {
 693       $sql .= " and $where";
 694     }
 695
 696     $sql;
 697 }
 698
 699 sub with_classnum {
 700   my ($self, $classnum, $use_override) = @_;
 701   return '' if $classnum eq '';
 702
 703   $classnum = [ $classnum ] if !ref($classnum);
 704   @$classnum = grep /^\d+$/, @$classnum;
 705   my $in = 'IN ('. join(',', @$classnum). ')';
 706
 707   my $expr = "
 708          ( COALESCE(part_pkg.classnum, 0) $in AND pkgpart_override IS NULL)
 709       OR ( COALESCE(part_fee.classnum, 0) $in AND feepart IS NOT NULL )";
 710   if ( $use_override ) {
 711     $expr .= "
 712       OR ( COALESCE(override.classnum, 0) $in AND pkgpart_override IS NOT NULL )";
 713   }
 714   "( $expr )";
 715 }
 716
 717 sub with_usageclass {
 718   my $self = shift;
 719   my ($classnum, $use_override) = @_;
 720   return '' unless $classnum =~ /^\d+$/;
 721   my $comparison;
 722   if ( $classnum == 0 ) {
 723     $comparison = 'IS NULL';
 724   }
 725   else {
 726     $comparison = "= $classnum";
 727   }
 728   return "cust_bill_pkg_detail.classnum $comparison";
 729 }
 730
 731 sub with_report_option {
 732   my ($self, %opt) = @_;
 733   # %opt can contain:
 734   # - report_optionnum: a comma-separated list of numbers.  Zero means to
 735   #   include packages with _no_ report classes.
 736   # - not_report_optionnum: a comma-separated list.  Packages that have
 737   #   any of these report options will be excluded from the result.
 738   #   Zero does nothing.
 739   # - use_override: also matches line items that are add-ons to a package
 740   #   matching the report class.
 741   # - all_report_options: returns only packages that have ALL of the
 742   #   report classes listed in $num.  Otherwise, will return packages that
 743   #   have ANY of those classes.
 744
 745   my @num = ref($opt{'report_optionnum'})
 746                   ? @{ $opt{'report_optionnum'} }
 747                   : split(/\s*,\s*/, $opt{'report_optionnum'});
 748   my @not_num = ref($opt{'not_report_optionnum'})
 749                       ? @{ $opt{'not_report_optionnum'} }
 750                       : split(/\s*,\s*/, $opt{'not_report_optionnum'});
 751   my $null;
 752   $null = 1 if ( grep {$_ == 0} @num );
 753   @num = grep {$_ > 0} @num;
 754   @not_num = grep {$_ > 0} @not_num;
 755
 756   # brute force
 757   my $table = $opt{'use_override'} ? 'override' : 'part_pkg';
 758   my $op = ' OR ';
 759   if ( $opt{'all_report_options'} ) {
 760     if ( @num and $null ) {
 761       return 'false'; # mutually exclusive criteria, so just bail out
 762     }
 763     $op = ' AND ';
 764   }
 765   my @where_num = map {
 766     "EXISTS(SELECT 1 FROM part_pkg_option ".
 767     "WHERE optionname = 'report_option_$_' ".
 768     "AND part_pkg_option.pkgpart = $table.pkgpart)"
 769   } @num;
 770   if ( $null ) {
 771     push @where_num, "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
 772                      "WHERE optionname LIKE 'report_option_%' ".
 773                      "AND part_pkg_option.pkgpart = $table.pkgpart)";
 774   }
 775   my @where_not_num = map {
 776     "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
 777     "WHERE optionname = 'report_option_$_' ".
 778     "AND part_pkg_option.pkgpart = $table.pkgpart)"
 779   } @not_num;
 780
 781   my @where;
 782   if (@where_num) {
 783     push @where, '( '.join($op, @where_num).' )';
 784   }
 785   if (@where_not_num) {
 786     push @where, '( '.join(' AND ', @where_not_num).' )';
 787   }
 788
 789   return @where;
 790   # this messes up totals
 791   #if ( $opt{'use_override'} ) {
 792   #  # then also allow the non-override package to match
 793   #  delete $opt{'use_override'};
 794   #  $comparison = "( $comparison OR " . $self->with_report_option(%opt) . ")";
 795   #}
 796
 797 }
 798
 799 sub with_cust_classnum {
 800   my ($self, %opt) = @_;
 801   if ( $opt{'cust_classnum'} ) {
 802     my $classnums = $opt{'cust_classnum'};
 803     $classnums = [ $classnums ] if !ref($classnums);
 804     @$classnums = grep /^\d+$/, @$classnums;
 805     return 'cust_main.classnum in('. join(',',@$classnums) .')'
 806       if @$classnums;
 807   }
 808   ();
 809 }
 810
 811
 812 sub scalar_sql {
 813   my( $self, $sql ) = ( shift, shift );
 814   my $sth = dbh->prepare($sql) or die dbh->errstr;
 815   warn "FS::Report::Table\n$sql\n" if $DEBUG;
 816   $sth->execute
 817     or die "Unexpected error executing statement $sql: ". $sth->errstr;
 818   $sth->fetchrow_arrayref->[0] || 0;
 819 }
 820
 821 =back
 822
 823 =head1 METHODS
 824
 825 =over 4
 826
 827 =item init_projection
 828
 829 Sets up for future projection of all observables on the report.  Currently
 830 this is limited to 'cust_bill_pkg'.
 831
 832 =cut
 833
 834 sub init_projection {
 835   # this is weird special case stuff--some redesign may be needed
 836   # to use it for anything else
 837   my $self = shift;
 838
 839   if ( driver_name ne 'Pg' ) {
 840     # also database-specific for now
 841     die "projection reports not supported on this platform";
 842   }
 843
 844   my %items = map {$_ => 1} @{ $self->{items} };
 845   if ($items{'cust_bill_pkg'}) {
 846     my $dbh = dbh;
 847     # v_ for 'virtual'
 848     my @sql = (
 849       # could use TEMPORARY TABLE but we're already transaction-protected
 850       'DROP TABLE IF EXISTS v_cust_bill_pkg',
 851       'CREATE TABLE v_cust_bill_pkg ' .
 852        '(LIKE cust_bill_pkg,
 853           usage numeric(10,2), _date integer, expire integer)',
 854       # XXX this should be smart enough to take only the ones with
 855       # sdate/edate overlapping the ROI, for performance
 856       "INSERT INTO v_cust_bill_pkg (
 857         SELECT cust_bill_pkg.*,
 858           (SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
 859           FROM cust_bill_pkg_detail
 860           WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum),
 861           cust_bill._date,
 862           cust_pkg.expire
 863         FROM cust_bill_pkg $cust_bill_pkg_join
 864       )",
 865     );
 866     foreach my $sql (@sql) {
 867       warn "[init_projection] $sql\n" if $DEBUG;
 868       $dbh->do($sql) or die $dbh->errstr;
 869     }
 870   }
 871 }
 872
 873 =item extend_projection START END
 874
 875 Generates data for the next period of projection.  This will be called
 876 for sequential periods where the END of one equals the START of the next
 877 (with no gaps).
 878
 879 =cut
 880
 881 sub extend_projection {
 882   my $self = shift;
 883   my ($speriod, $eperiod) = @_;
 884   my %items = map {$_ => 1} @{ $self->{items} };
 885   if ($items{'cust_bill_pkg'}) {
 886     # What we do here:
 887     # Find all line items that end after the start of the period (and have
 888     # recurring fees, and don't expire before they end).  Choose the latest
 889     # one for each package.  If it ends before the end of the period, copy
 890     # it forward by one billing period.
 891     # Repeat this until the latest line item for each package no longer ends
 892     # within the period.  This is certain to happen in finitely many
 893     # iterations as long as freq > 0.
 894     # - Pg only, obviously.
 895     # - Gives bad results if freq_override is used.
 896     my @fields = ( FS::cust_bill_pkg->fields, qw( usage _date expire ) );
 897     my $insert_fields = join(',', @fields);
 898     my $add_freq = sub { # emulate FS::part_pkg::add_freq
 899       my $field = shift;
 900       "EXTRACT( EPOCH FROM TO_TIMESTAMP($field) + (CASE WHEN freq ~ E'\\\\D' ".
 901       "THEN freq ELSE freq || 'mon' END)::INTERVAL) AS $field";
 902     };
 903     foreach (@fields) {
 904       if ($_ eq 'edate') {
 905         $_ = $add_freq->('edate');
 906       }
 907       elsif ($_ eq 'sdate') {
 908         $_ = 'edate AS sdate'
 909       }
 910       elsif ($_ eq 'setup') {
 911         $_ = '0 AS setup' #because recurring only
 912       }
 913       elsif ($_ eq '_date') {
 914         $_ = $add_freq->('_date');
 915       }
 916     }
 917     my $select_fields = join(',', @fields);
 918     my $dbh = dbh;
 919     my $sql =
 920     # Subquery here because we need to DISTINCT the whole set, select the
 921     # latest charge per pkgnum, and _then_ check edate < $eperiod
 922     # and edate < expire.
 923       "INSERT INTO v_cust_bill_pkg ($insert_fields)
 924         SELECT $select_fields FROM (
 925           SELECT DISTINCT ON (pkgnum) * FROM v_cust_bill_pkg
 926             WHERE edate >= $speriod
 927               AND recur > 0
 928               AND freq IS NOT NULL
 929               AND freq != '0'
 930             ORDER BY pkgnum, edate DESC
 931           ) AS v1
 932           WHERE edate < $eperiod AND (edate < expire OR expire IS NULL)";
 933     my $rows;
 934     do {
 935       warn "[extend_projection] $sql\n" if $DEBUG;
 936       $rows = $dbh->do($sql) or die $dbh->errstr;
 937       warn "[extend_projection] $rows rows\n" if $DEBUG;
 938     } until $rows == 0;
 939   }
 940 }
 941
 942 =head1 BUGS
 943
 944 Documentation.
 945
 946 =head1 SEE ALSO
 947
 948 L<FS::Report::Table::Monthly>, reports in the web interface.
 949
 950 =cut
 951
 952 1;