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