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