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->in_time_period_and_agent($speriod, $eperiod, $agentnum),
 447   );
 448
 449   # yuck, false laziness
 450   push @where, "cust_main.refnum = ". $opt{'refnum'} if $opt{'refnum'};
 451
 452   if ( $opt{'cust_classnum'} ) {
 453     my $classnums = $opt{'cust_classnum'};
 454     $classnums = [ $classnums ] if !ref($classnums);
 455     @$classnums = grep /^\d+$/, @$classnums;
 456     push @where, 'cust_main.classnum in('. join(',',@$classnums) .')';
 457   }
 458
 459   my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0)
 460   FROM cust_bill_pkg
 461   $cust_bill_pkg_join
 462   WHERE " . join(' AND ', grep $_, @where);
 463
 464   $self->scalar_sql($total_sql);
 465 }
 466
 467 sub cust_bill_pkg_recur {
 468   my $self = shift;
 469   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 470
 471   $agentnum ||= $opt{'agentnum'};
 472   my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg';
 473
 474   my @where = (
 475     'pkgnum != 0',
 476     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 477   );
 478
 479   push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'};
 480
 481   if ( $opt{'cust_classnum'} ) {
 482     my $classnums = $opt{'cust_classnum'};
 483     $classnums = [ $classnums ] if !ref($classnums);
 484     @$classnums = grep /^\d+$/, @$classnums;
 485     push @where, 'cust_main.classnum in('. join(',',@$classnums) .')';
 486   }
 487
 488   # subtract all usage from the line item regardless of date
 489   my $item_usage;
 490   if ( $opt{'project'} ) {
 491     $item_usage = 'usage'; #already calculated
 492   }
 493   else {
 494     $item_usage = '( SELECT COALESCE(SUM(amount),0)
 495       FROM cust_bill_pkg_detail
 496       WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum )';
 497   }
 498   my $recur_fraction = '';
 499
 500   if ( $opt{'distribute'} ) {
 501     push @where, "cust_main.agentnum = $agentnum" if $agentnum;
 502     push @where,
 503       "$cust_bill_pkg.sdate <  $eperiod",
 504       "$cust_bill_pkg.edate >= $speriod",
 505     ;
 506     # the fraction of edate - sdate that's within [speriod, eperiod]
 507     $recur_fraction = " *
 508       CAST(LEAST($eperiod, $cust_bill_pkg.edate) -
 509        GREATEST($speriod, $cust_bill_pkg.sdate) AS DECIMAL) /
 510       ($cust_bill_pkg.edate - $cust_bill_pkg.sdate)";
 511   }
 512   else {
 513     # we don't want to have to create v_cust_bill
 514     my $_date = $opt{'project'} ? 'v_cust_bill_pkg._date' : 'cust_bill._date';
 515     push @where,
 516       $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, $_date);
 517   }
 518
 519   my $total_sql = 'SELECT '.
 520   "COALESCE(SUM(($cust_bill_pkg.recur - $item_usage) $recur_fraction),0)
 521   FROM $cust_bill_pkg
 522   $cust_bill_pkg_join
 523   WHERE ".join(' AND ', grep $_, @where);
 524
 525   $self->scalar_sql($total_sql);
 526 }
 527
 528 =item cust_bill_pkg_detail: the total usage charges in detail lines.
 529
 530 Arguments as for C<cust_bill_pkg>, plus:
 531
 532 'usageclass': limit to this usage class number.
 533
 534 =cut
 535
 536 sub cust_bill_pkg_detail {
 537   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 538
 539   my @where = ( "cust_bill_pkg.pkgnum != 0" );
 540
 541   push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'};
 542
 543   if ( $opt{'cust_classnum'} ) {
 544     my $classnums = $opt{'cust_classnum'};
 545     $classnums = [ $classnums ] if !ref($classnums);
 546     @$classnums = grep /^\d+$/, @$classnums;
 547     push @where, 'cust_main.classnum in('. join(',',@$classnums) .')';
 548   }
 549
 550   $agentnum ||= $opt{'agentnum'};
 551
 552   push @where,
 553     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 554     $self->with_usageclass($opt{'usageclass'}),
 555     ;
 556
 557   if ( $opt{'distribute'} ) {
 558     # then limit according to the usage time, not the billing date
 559     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 560       'cust_bill_pkg_detail.startdate'
 561     );
 562   }
 563   else {
 564     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 565       'cust_bill._date'
 566     );
 567   }
 568
 569   my $total_sql = " SELECT SUM(amount) ";
 570
 571   $total_sql .=
 572     " / CASE COUNT(cust_pkg.*) WHEN 0 THEN 1 ELSE COUNT(cust_pkg.*) END "
 573       if $opt{average_per_cust_pkg};
 574
 575   $total_sql .=
 576     " FROM cust_bill_pkg_detail
 577         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 578         LEFT JOIN cust_bill ON cust_bill_pkg.invnum = cust_bill.invnum
 579         LEFT JOIN cust_main USING ( custnum )
 580         LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum
 581         LEFT JOIN part_pkg USING ( pkgpart )
 582         LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 583       WHERE ".join( ' AND ', grep $_, @where );
 584
 585   $self->scalar_sql($total_sql);
 586
 587 }
 588
 589 sub cust_bill_pkg_discount {
 590   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 591
 592   #my $where = '';
 593   #my $comparison = '';
 594   #if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
 595   #  if ( $1 == 0 ) {
 596   #    $comparison = "IS NULL";
 597   #  } else {
 598   #    $comparison = "= $1";
 599   #  }
 600   #
 601   #  if ( $opt{'use_override'} ) {
 602   #    $where = "(
 603   #      part_pkg.classnum $comparison AND pkgpart_override IS NULL OR
 604   #      override.classnum $comparison AND pkgpart_override IS NOT NULL
 605   #    )";
 606   #  } else {
 607   #    $where = "part_pkg.classnum $comparison";
 608   #  }
 609   #}
 610
 611   $agentnum ||= $opt{'agentnum'};
 612
 613   my $total_sql =
 614     " SELECT COALESCE( SUM( cust_bill_pkg_discount.amount ), 0 ) ";
 615
 616   #$total_sql .=
 617   #  " / CASE COUNT(cust_pkg.*) WHEN 0 THEN 1 ELSE COUNT(cust_pkg.*) END "
 618   #    if $opt{average_per_cust_pkg};
 619
 620   $total_sql .=
 621     " FROM cust_bill_pkg_discount
 622         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 623         LEFT JOIN cust_bill USING ( invnum )
 624         LEFT JOIN cust_main USING ( custnum )
 625       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum);
 626   #      LEFT JOIN cust_pkg_discount USING ( pkgdiscountnum )
 627   #      LEFT JOIN discount USING ( discountnum )
 628   #      LEFT JOIN cust_pkg USING ( pkgnum )
 629   #      LEFT JOIN part_pkg USING ( pkgpart )
 630   #      LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 631
 632   return $self->scalar_sql($total_sql);
 633
 634 }
 635
 636 sub setup_pkg  { shift->pkg_field( 'setup',  @_ ); }
 637 sub susp_pkg   { shift->pkg_field( 'susp',   @_ ); }
 638 sub cancel_pkg { shift->pkg_field( 'cancel', @_ ); }
 639
 640 sub pkg_field {
 641   my( $self, $field, $speriod, $eperiod, $agentnum ) = @_;
 642   $self->scalar_sql("
 643     SELECT COUNT(*) FROM cust_pkg
 644         LEFT JOIN cust_main USING ( custnum )
 645       WHERE ". $self->in_time_period_and_agent( $speriod,
 646                                                 $eperiod,
 647                                                 $agentnum,
 648                                                 "cust_pkg.$field",
 649                                               )
 650   );
 651
 652 }
 653
 654 #this is going to be harder..
 655 #sub unsusp_pkg {
 656 #  my( $self, $speriod, $eperiod, $agentnum ) = @_;
 657 #  $self->scalar_sql("
 658 #    SELECT COUNT(*) FROM h_cust_pkg
 659 #      WHERE
 660 #
 661 #}
 662
 663 sub in_time_period_and_agent {
 664   my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4);
 665   my $col = @_ ? shift() : '_date';
 666
 667   my $sql = "$col >= $speriod AND $col < $eperiod";
 668
 669   #agent selection
 670   $sql .= " AND cust_main.agentnum = $agentnum"
 671     if $agentnum;
 672
 673   #agent virtualization
 674   $sql .= ' AND '.
 675           $FS::CurrentUser::CurrentUser->agentnums_sql( 'table'=>'cust_main' );
 676
 677   $sql;
 678 }
 679
 680 sub for_opts {
 681     my ( $self, %opt ) = @_;
 682     my $sql = '';
 683     if ( $opt{'custnum'} =~ /^(\d+)$/ ) {
 684       $sql .= " and custnum = $1 ";
 685     }
 686     if ( $opt{'refnum'} =~ /^(\d+)$/ ) {
 687       $sql .= " and refnum = $1 ";
 688     }
 689     if ( $opt{'cust_classnum'} ) {
 690       my $classnums = $opt{'cust_classnum'};
 691       $classnums = [ $classnums ] if !ref($classnums);
 692       @$classnums = grep /^\d+$/, @$classnums;
 693       $sql .= ' and cust_main.classnum in('. join(',',@$classnums) .')'
 694         if @$classnums;
 695     }
 696
 697     $sql;
 698 }
 699
 700 sub with_classnum {
 701   my $self = shift;
 702   my ($classnum, $use_override) = @_;
 703   return '' unless $classnum =~ /^\d+$/;
 704   my $comparison;
 705   if ( $classnum == 0 ) {
 706     $comparison = 'IS NULL';
 707   }
 708   else {
 709     $comparison = "= $classnum";
 710   }
 711   if ( $use_override ) {
 712     return "(
 713       part_pkg.classnum $comparison AND pkgpart_override IS NULL OR
 714       override.classnum $comparison AND pkgpart_override IS NOT NULL
 715     )";
 716   }
 717   else {
 718     return "part_pkg.classnum $comparison";
 719   }
 720 }
 721
 722 sub with_usageclass {
 723   my $self = shift;
 724   my ($classnum, $use_override) = @_;
 725   return '' unless $classnum =~ /^\d+$/;
 726   my $comparison;
 727   if ( $classnum == 0 ) {
 728     $comparison = 'IS NULL';
 729   }
 730   else {
 731     $comparison = "= $classnum";
 732   }
 733   return "cust_bill_pkg_detail.classnum $comparison";
 734 }
 735
 736 sub scalar_sql {
 737   my( $self, $sql ) = ( shift, shift );
 738   my $sth = dbh->prepare($sql) or die dbh->errstr;
 739   warn "FS::Report::Table\n$sql\n" if $DEBUG;
 740   $sth->execute
 741     or die "Unexpected error executing statement $sql: ". $sth->errstr;
 742   $sth->fetchrow_arrayref->[0] || 0;
 743 }
 744
 745 =back
 746
 747 =head1 METHODS
 748
 749 =over 4
 750
 751 =item init_projection
 752
 753 Sets up for future projection of all observables on the report.  Currently
 754 this is limited to 'cust_bill_pkg'.
 755
 756 =cut
 757
 758 sub init_projection {
 759   # this is weird special case stuff--some redesign may be needed
 760   # to use it for anything else
 761   my $self = shift;
 762
 763   if ( driver_name ne 'Pg' ) {
 764     # also database-specific for now
 765     die "projection reports not supported on this platform";
 766   }
 767
 768   my %items = map {$_ => 1} @{ $self->{items} };
 769   if ($items{'cust_bill_pkg'}) {
 770     my $dbh = dbh;
 771     # v_ for 'virtual'
 772     my @sql = (
 773       # could use TEMPORARY TABLE but we're already transaction-protected
 774       'DROP TABLE IF EXISTS v_cust_bill_pkg',
 775       'CREATE TABLE v_cust_bill_pkg ' .
 776        '(LIKE cust_bill_pkg,
 777           usage numeric(10,2), _date integer, expire integer)',
 778       # XXX this should be smart enough to take only the ones with
 779       # sdate/edate overlapping the ROI, for performance
 780       "INSERT INTO v_cust_bill_pkg (
 781         SELECT cust_bill_pkg.*,
 782           (SELECT COALESCE(SUM(amount),0) FROM cust_bill_pkg_detail
 783           WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum),
 784           cust_bill._date,
 785           cust_pkg.expire
 786         FROM cust_bill_pkg $cust_bill_pkg_join
 787       )",
 788     );
 789     foreach my $sql (@sql) {
 790       warn "[init_projection] $sql\n" if $DEBUG;
 791       $dbh->do($sql) or die $dbh->errstr;
 792     }
 793   }
 794 }
 795
 796 =item extend_projection START END
 797
 798 Generates data for the next period of projection.  This will be called
 799 for sequential periods where the END of one equals the START of the next
 800 (with no gaps).
 801
 802 =cut
 803
 804 sub extend_projection {
 805   my $self = shift;
 806   my ($speriod, $eperiod) = @_;
 807   my %items = map {$_ => 1} @{ $self->{items} };
 808   if ($items{'cust_bill_pkg'}) {
 809     # What we do here:
 810     # Find all line items that end after the start of the period (and have
 811     # recurring fees, and don't expire before they end).  Choose the latest
 812     # one for each package.  If it ends before the end of the period, copy
 813     # it forward by one billing period.
 814     # Repeat this until the latest line item for each package no longer ends
 815     # within the period.  This is certain to happen in finitely many
 816     # iterations as long as freq > 0.
 817     # - Pg only, obviously.
 818     # - Gives bad results if freq_override is used.
 819     my @fields = ( FS::cust_bill_pkg->fields, qw( usage _date expire ) );
 820     my $insert_fields = join(',', @fields);
 821     my $add_freq = sub { # emulate FS::part_pkg::add_freq
 822       my $field = shift;
 823       "EXTRACT( EPOCH FROM TO_TIMESTAMP($field) + (CASE WHEN freq ~ E'\\\\D' ".
 824       "THEN freq ELSE freq || 'mon' END)::INTERVAL) AS $field";
 825     };
 826     foreach (@fields) {
 827       if ($_ eq 'edate') {
 828         $_ = $add_freq->('edate');
 829       }
 830       elsif ($_ eq 'sdate') {
 831         $_ = 'edate AS sdate'
 832       }
 833       elsif ($_ eq 'setup') {
 834         $_ = '0 AS setup' #because recurring only
 835       }
 836       elsif ($_ eq '_date') {
 837         $_ = $add_freq->('_date');
 838       }
 839     }
 840     my $select_fields = join(',', @fields);
 841     my $dbh = dbh;
 842     my $sql =
 843     # Subquery here because we need to DISTINCT the whole set, select the
 844     # latest charge per pkgnum, and _then_ check edate < $eperiod
 845     # and edate < expire.
 846       "INSERT INTO v_cust_bill_pkg ($insert_fields)
 847         SELECT $select_fields FROM (
 848           SELECT DISTINCT ON (pkgnum) * FROM v_cust_bill_pkg
 849             WHERE edate >= $speriod
 850               AND recur > 0
 851               AND freq IS NOT NULL
 852               AND freq != '0'
 853             ORDER BY pkgnum, edate DESC
 854           ) AS v1
 855           WHERE edate < $eperiod AND (edate < expire OR expire IS NULL)";
 856     my $rows;
 857     do {
 858       warn "[extend_projection] $sql\n" if $DEBUG;
 859       $rows = $dbh->do($sql) or die $dbh->errstr;
 860       warn "[extend_projection] $rows rows\n" if $DEBUG;
 861     } until $rows == 0;
 862   }
 863 }
 864
 865 =head1 BUGS
 866
 867 Documentation.
 868
 869 =head1 SEE ALSO
 870
 871 L<FS::Report::Table::Monthly>, reports in the web interface.
 872
 873 =cut
 874
 875 1;