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(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 'freq': limit to packages with this frequency.  Currently uses the part_pkg
 394 frequency, so term discounted packages may give odd results.
 395
 396 'distribute': for non-monthly recurring charges, ignore the invoice
 397 date.  Instead, consider the line item's starting/ending dates.  Determine
 398 the fraction of the line item duration that falls within the specified
 399 interval and return that fraction of the recurring charges.  This is
 400 somewhat experimental.
 401
 402 'project': enable if this is a projected period.  This is very experimental.
 403
 404 =cut
 405
 406 sub cust_bill_pkg {
 407   my $self = shift;
 408   my( $speriod, $eperiod, $agentnum, %opt ) = @_;
 409
 410   my %charges = map {$_=>1} split('', $opt{'charges'} || 'SRU');
 411
 412   my $sum = 0;
 413   $sum += $self->cust_bill_pkg_setup(@_) if $charges{S};
 414   $sum += $self->cust_bill_pkg_recur(@_) if $charges{R};
 415   $sum += $self->cust_bill_pkg_detail(@_) if $charges{U};
 416   $sum;
 417 }
 418
 419 my $cust_bill_pkg_join = '
 420     LEFT JOIN cust_bill USING ( invnum )
 421     LEFT JOIN cust_main USING ( custnum )
 422     LEFT JOIN cust_pkg USING ( pkgnum )
 423     LEFT JOIN part_pkg USING ( pkgpart )
 424     LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart';
 425
 426 sub cust_bill_pkg_setup {
 427   my $self = shift;
 428   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 429   # no projecting setup fees--use real invoices only
 430   # but evaluate this anyway, because the design of projection is that
 431   # if there are somehow real setup fees in the future, we want to count
 432   # them
 433
 434   $agentnum ||= $opt{'agentnum'};
 435
 436   my @where = (
 437     'pkgnum != 0',
 438     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 439     $self->with_report_option(%opt),
 440     $self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
 441   );
 442
 443   # yuck, false laziness
 444   push @where, "cust_main.refnum = ". $opt{'refnum'} if $opt{'refnum'};
 445
 446   push @where, $self->with_cust_classnum(%opt);
 447
 448   my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0)
 449   FROM cust_bill_pkg
 450   $cust_bill_pkg_join
 451   WHERE " . join(' AND ', grep $_, @where);
 452
 453   $self->scalar_sql($total_sql);
 454 }
 455
 456 sub cust_bill_pkg_recur {
 457   my $self = shift;
 458   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 459
 460   $agentnum ||= $opt{'agentnum'};
 461   my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg';
 462
 463   my @where = (
 464     'pkgnum != 0',
 465     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 466     $self->with_report_option(%opt),
 467   );
 468
 469   push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'};
 470
 471   push @where, $self->with_cust_classnum(%opt);
 472
 473   # subtract all usage from the line item regardless of date
 474   my $item_usage;
 475   if ( $opt{'project'} ) {
 476     $item_usage = 'usage'; #already calculated
 477   }
 478   else {
 479     $item_usage = '( SELECT COALESCE(SUM(amount),0)
 480       FROM cust_bill_pkg_detail
 481       WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum )';
 482   }
 483   my $recur_fraction = '';
 484
 485   if ( $opt{'distribute'} ) {
 486     push @where, "cust_main.agentnum = $agentnum" if $agentnum;
 487     push @where,
 488       "$cust_bill_pkg.sdate <  $eperiod",
 489       "$cust_bill_pkg.edate >= $speriod",
 490     ;
 491     # the fraction of edate - sdate that's within [speriod, eperiod]
 492     $recur_fraction = " *
 493       CAST(LEAST($eperiod, $cust_bill_pkg.edate) -
 494        GREATEST($speriod, $cust_bill_pkg.sdate) AS DECIMAL) /
 495       ($cust_bill_pkg.edate - $cust_bill_pkg.sdate)";
 496   }
 497   else {
 498     # we don't want to have to create v_cust_bill
 499     my $_date = $opt{'project'} ? 'v_cust_bill_pkg._date' : 'cust_bill._date';
 500     push @where,
 501       $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, $_date);
 502   }
 503
 504   my $total_sql = 'SELECT '.
 505   "COALESCE(SUM(($cust_bill_pkg.recur - $item_usage) $recur_fraction),0)
 506   FROM $cust_bill_pkg
 507   $cust_bill_pkg_join
 508   WHERE ".join(' AND ', grep $_, @where);
 509
 510   $self->scalar_sql($total_sql);
 511 }
 512
 513 =item cust_bill_pkg_detail: the total usage charges in detail lines.
 514
 515 Arguments as for C<cust_bill_pkg>, plus:
 516
 517 'usageclass': limit to this usage class number.
 518
 519 =cut
 520
 521 sub cust_bill_pkg_detail {
 522   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 523
 524   my @where = ( "cust_bill_pkg.pkgnum != 0" );
 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     # then limit according to the usage time, not the billing date
 540     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 541       'cust_bill_pkg_detail.startdate'
 542     );
 543   }
 544   else {
 545     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 546       'cust_bill._date'
 547     );
 548   }
 549
 550   my $total_sql = " SELECT SUM(amount) ";
 551
 552   $total_sql .=
 553     " / CASE COUNT(cust_pkg.*) WHEN 0 THEN 1 ELSE COUNT(cust_pkg.*) END "
 554       if $opt{average_per_cust_pkg};
 555
 556   $total_sql .=
 557     " FROM cust_bill_pkg_detail
 558         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 559         LEFT JOIN cust_bill ON cust_bill_pkg.invnum = cust_bill.invnum
 560         LEFT JOIN cust_main USING ( custnum )
 561         LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum
 562         LEFT JOIN part_pkg USING ( pkgpart )
 563         LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 564       WHERE ".join( ' AND ', grep $_, @where );
 565
 566   $self->scalar_sql($total_sql);
 567
 568 }
 569
 570 sub cust_bill_pkg_discount {
 571   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 572
 573   #need to do this the new multi-classnum way if it gets re-enabled
 574   #my $where = '';
 575   #my $comparison = '';
 576   #if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
 577   #  if ( $1 == 0 ) {
 578   #    $comparison = "IS NULL";
 579   #  } else {
 580   #    $comparison = "= $1";
 581   #  }
 582   #
 583   #  if ( $opt{'use_override'} ) {
 584   #    $where = "(
 585   #      part_pkg.classnum $comparison AND pkgpart_override IS NULL OR
 586   #      override.classnum $comparison AND pkgpart_override IS NOT NULL
 587   #    )";
 588   #  } else {
 589   #    $where = "part_pkg.classnum $comparison";
 590   #  }
 591   #}
 592
 593   $agentnum ||= $opt{'agentnum'};
 594
 595   my $total_sql =
 596     " SELECT COALESCE( SUM( cust_bill_pkg_discount.amount ), 0 ) ";
 597
 598   #$total_sql .=
 599   #  " / CASE COUNT(cust_pkg.*) WHEN 0 THEN 1 ELSE COUNT(cust_pkg.*) END "
 600   #    if $opt{average_per_cust_pkg};
 601
 602   $total_sql .=
 603     " FROM cust_bill_pkg_discount
 604         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 605         LEFT JOIN cust_bill USING ( invnum )
 606         LEFT JOIN cust_main USING ( custnum )
 607       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum);
 608   #      LEFT JOIN cust_pkg_discount USING ( pkgdiscountnum )
 609   #      LEFT JOIN discount USING ( discountnum )
 610   #      LEFT JOIN cust_pkg USING ( pkgnum )
 611   #      LEFT JOIN part_pkg USING ( pkgpart )
 612   #      LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 613
 614   return $self->scalar_sql($total_sql);
 615
 616 }
 617
 618 sub setup_pkg  { shift->pkg_field( 'setup',  @_ ); }
 619 sub susp_pkg   { shift->pkg_field( 'susp',   @_ ); }
 620 sub cancel_pkg { shift->pkg_field( 'cancel', @_ ); }
 621
 622 sub pkg_field {
 623   my( $self, $field, $speriod, $eperiod, $agentnum ) = @_;
 624   $self->scalar_sql("
 625     SELECT COUNT(*) FROM cust_pkg
 626         LEFT JOIN cust_main USING ( custnum )
 627       WHERE ". $self->in_time_period_and_agent( $speriod,
 628                                                 $eperiod,
 629                                                 $agentnum,
 630                                                 "cust_pkg.$field",
 631                                               )
 632   );
 633
 634 }
 635
 636 #this is going to be harder..
 637 #sub unsusp_pkg {
 638 #  my( $self, $speriod, $eperiod, $agentnum ) = @_;
 639 #  $self->scalar_sql("
 640 #    SELECT COUNT(*) FROM h_cust_pkg
 641 #      WHERE
 642 #
 643 #}
 644
 645 sub in_time_period_and_agent {
 646   my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4);
 647   my $col = @_ ? shift() : '_date';
 648
 649   my $sql = "$col >= $speriod AND $col < $eperiod";
 650
 651   #agent selection
 652   $sql .= " AND cust_main.agentnum = $agentnum"
 653     if $agentnum;
 654
 655   #agent virtualization
 656   $sql .= ' AND '.
 657           $FS::CurrentUser::CurrentUser->agentnums_sql( 'table'=>'cust_main' );
 658
 659   $sql;
 660 }
 661
 662 sub for_opts {
 663     my ( $self, %opt ) = @_;
 664     my $sql = '';
 665     if ( $opt{'custnum'} =~ /^(\d+)$/ ) {
 666       $sql .= " and custnum = $1 ";
 667     }
 668     if ( $opt{'refnum'} =~ /^(\d+)$/ ) {
 669       $sql .= " and refnum = $1 ";
 670     }
 671     if ( my $where = $self->with_cust_classnum(%opt) ) {
 672       $sql .= " and $where";
 673     }
 674
 675     $sql;
 676 }
 677
 678 sub with_classnum {
 679   my ($self, $classnum, $use_override) = @_;
 680   return '' if $classnum eq '';
 681
 682   $classnum = [ $classnum ] if !ref($classnum);
 683   @$classnum = grep /^\d+$/, @$classnum;
 684   my $in = 'IN ('. join(',', @$classnum). ')';
 685
 686   if ( $use_override ) {
 687     "(
 688          ( COALESCE(part_pkg.classnum, 0) $in AND pkgpart_override IS NULL)
 689       OR ( COALESCE(override.classnum, 0) $in AND pkgpart_override IS NOT NULL )
 690     )";
 691   } else {
 692     "COALESCE(part_pkg.classnum, 0) $in";
 693   }
 694 }
 695
 696 sub with_usageclass {
 697   my $self = shift;
 698   my ($classnum, $use_override) = @_;
 699   return '' unless $classnum =~ /^\d+$/;
 700   my $comparison;
 701   if ( $classnum == 0 ) {
 702     $comparison = 'IS NULL';
 703   }
 704   else {
 705     $comparison = "= $classnum";
 706   }
 707   return "cust_bill_pkg_detail.classnum $comparison";
 708 }
 709
 710 sub with_report_option {
 711   my ($self, %opt) = @_;
 712   # %opt can contain:
 713   # - report_optionnum: a comma-separated list of numbers.  Zero means to
 714   #   include packages with _no_ report classes.
 715   # - not_report_optionnum: a comma-separated list.  Packages that have
 716   #   any of these report options will be excluded from the result.
 717   #   Zero does nothing.
 718   # - use_override: also matches line items that are add-ons to a package
 719   #   matching the report class.
 720   # - all_report_options: returns only packages that have ALL of the
 721   #   report classes listed in $num.  Otherwise, will return packages that
 722   #   have ANY of those classes.
 723
 724   my @num = ref($opt{'report_optionnum'})
 725                   ? @{ $opt{'report_optionnum'} }
 726                   : split(/\s*,\s*/, $opt{'report_optionnum'});
 727   my @not_num = ref($opt{'not_report_optionnum'})
 728                       ? @{ $opt{'not_report_optionnum'} }
 729                       : split(/\s*,\s*/, $opt{'not_report_optionnum'});
 730   my $null;
 731   $null = 1 if ( grep {$_ == 0} @num );
 732   @num = grep {$_ > 0} @num;
 733   @not_num = grep {$_ > 0} @not_num;
 734
 735   # brute force
 736   my $table = $opt{'use_override'} ? 'override' : 'part_pkg';
 737   my $op = ' OR ';
 738   if ( $opt{'all_report_options'} ) {
 739     if ( @num and $null ) {
 740       return 'false'; # mutually exclusive criteria, so just bail out
 741     }
 742     $op = ' AND ';
 743   }
 744   my @where_num = map {
 745     "EXISTS(SELECT 1 FROM part_pkg_option ".
 746     "WHERE optionname = 'report_option_$_' ".
 747     "AND part_pkg_option.pkgpart = $table.pkgpart)"
 748   } @num;
 749   if ( $null ) {
 750     push @where_num, "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
 751                      "WHERE optionname LIKE 'report_option_%' ".
 752                      "AND part_pkg_option.pkgpart = $table.pkgpart)";
 753   }
 754   my @where_not_num = map {
 755     "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
 756     "WHERE optionname = 'report_option_$_' ".
 757     "AND part_pkg_option.pkgpart = $table.pkgpart)"
 758   } @not_num;
 759
 760   my @where;
 761   if (@where_num) {
 762     push @where, '( '.join($op, @where_num).' )';
 763   }
 764   if (@where_not_num) {
 765     push @where, '( '.join(' AND ', @where_not_num).' )';
 766   }
 767
 768   return @where;
 769   # this messes up totals
 770   #if ( $opt{'use_override'} ) {
 771   #  # then also allow the non-override package to match
 772   #  delete $opt{'use_override'};
 773   #  $comparison = "( $comparison OR " . $self->with_report_option(%opt) . ")";
 774   #}
 775
 776 }
 777
 778 sub with_cust_classnum {
 779   my ($self, %opt) = @_;
 780   if ( $opt{'cust_classnum'} ) {
 781     my $classnums = $opt{'cust_classnum'};
 782     $classnums = [ $classnums ] if !ref($classnums);
 783     @$classnums = grep /^\d+$/, @$classnums;
 784     return 'cust_main.classnum in('. join(',',@$classnums) .')'
 785       if @$classnums;
 786   }
 787   ();
 788 }
 789
 790
 791 sub scalar_sql {
 792   my( $self, $sql ) = ( shift, shift );
 793   my $sth = dbh->prepare($sql) or die dbh->errstr;
 794   warn "FS::Report::Table\n$sql\n" if $DEBUG;
 795   $sth->execute
 796     or die "Unexpected error executing statement $sql: ". $sth->errstr;
 797   $sth->fetchrow_arrayref->[0] || 0;
 798 }
 799
 800 =back
 801
 802 =head1 METHODS
 803
 804 =over 4
 805
 806 =item init_projection
 807
 808 Sets up for future projection of all observables on the report.  Currently
 809 this is limited to 'cust_bill_pkg'.
 810
 811 =cut
 812
 813 sub init_projection {
 814   # this is weird special case stuff--some redesign may be needed
 815   # to use it for anything else
 816   my $self = shift;
 817
 818   if ( driver_name ne 'Pg' ) {
 819     # also database-specific for now
 820     die "projection reports not supported on this platform";
 821   }
 822
 823   my %items = map {$_ => 1} @{ $self->{items} };
 824   if ($items{'cust_bill_pkg'}) {
 825     my $dbh = dbh;
 826     # v_ for 'virtual'
 827     my @sql = (
 828       # could use TEMPORARY TABLE but we're already transaction-protected
 829       'DROP TABLE IF EXISTS v_cust_bill_pkg',
 830       'CREATE TABLE v_cust_bill_pkg ' .
 831        '(LIKE cust_bill_pkg,
 832           usage numeric(10,2), _date integer, expire integer)',
 833       # XXX this should be smart enough to take only the ones with
 834       # sdate/edate overlapping the ROI, for performance
 835       "INSERT INTO v_cust_bill_pkg (
 836         SELECT cust_bill_pkg.*,
 837           (SELECT COALESCE(SUM(amount),0) FROM cust_bill_pkg_detail
 838           WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum),
 839           cust_bill._date,
 840           cust_pkg.expire
 841         FROM cust_bill_pkg $cust_bill_pkg_join
 842       )",
 843     );
 844     foreach my $sql (@sql) {
 845       warn "[init_projection] $sql\n" if $DEBUG;
 846       $dbh->do($sql) or die $dbh->errstr;
 847     }
 848   }
 849 }
 850
 851 =item extend_projection START END
 852
 853 Generates data for the next period of projection.  This will be called
 854 for sequential periods where the END of one equals the START of the next
 855 (with no gaps).
 856
 857 =cut
 858
 859 sub extend_projection {
 860   my $self = shift;
 861   my ($speriod, $eperiod) = @_;
 862   my %items = map {$_ => 1} @{ $self->{items} };
 863   if ($items{'cust_bill_pkg'}) {
 864     # What we do here:
 865     # Find all line items that end after the start of the period (and have
 866     # recurring fees, and don't expire before they end).  Choose the latest
 867     # one for each package.  If it ends before the end of the period, copy
 868     # it forward by one billing period.
 869     # Repeat this until the latest line item for each package no longer ends
 870     # within the period.  This is certain to happen in finitely many
 871     # iterations as long as freq > 0.
 872     # - Pg only, obviously.
 873     # - Gives bad results if freq_override is used.
 874     my @fields = ( FS::cust_bill_pkg->fields, qw( usage _date expire ) );
 875     my $insert_fields = join(',', @fields);
 876     my $add_freq = sub { # emulate FS::part_pkg::add_freq
 877       my $field = shift;
 878       "EXTRACT( EPOCH FROM TO_TIMESTAMP($field) + (CASE WHEN freq ~ E'\\\\D' ".
 879       "THEN freq ELSE freq || 'mon' END)::INTERVAL) AS $field";
 880     };
 881     foreach (@fields) {
 882       if ($_ eq 'edate') {
 883         $_ = $add_freq->('edate');
 884       }
 885       elsif ($_ eq 'sdate') {
 886         $_ = 'edate AS sdate'
 887       }
 888       elsif ($_ eq 'setup') {
 889         $_ = '0 AS setup' #because recurring only
 890       }
 891       elsif ($_ eq '_date') {
 892         $_ = $add_freq->('_date');
 893       }
 894     }
 895     my $select_fields = join(',', @fields);
 896     my $dbh = dbh;
 897     my $sql =
 898     # Subquery here because we need to DISTINCT the whole set, select the
 899     # latest charge per pkgnum, and _then_ check edate < $eperiod
 900     # and edate < expire.
 901       "INSERT INTO v_cust_bill_pkg ($insert_fields)
 902         SELECT $select_fields FROM (
 903           SELECT DISTINCT ON (pkgnum) * FROM v_cust_bill_pkg
 904             WHERE edate >= $speriod
 905               AND recur > 0
 906               AND freq IS NOT NULL
 907               AND freq != '0'
 908             ORDER BY pkgnum, edate DESC
 909           ) AS v1
 910           WHERE edate < $eperiod AND (edate < expire OR expire IS NULL)";
 911     my $rows;
 912     do {
 913       warn "[extend_projection] $sql\n" if $DEBUG;
 914       $rows = $dbh->do($sql) or die $dbh->errstr;
 915       warn "[extend_projection] $rows rows\n" if $DEBUG;
 916     } until $rows == 0;
 917   }
 918 }
 919
 920 =head1 BUGS
 921
 922 Documentation.
 923
 924 =head1 SEE ALSO
 925
 926 L<FS::Report::Table::Monthly>, reports in the web interface.
 927
 928 =cut
 929
 930 1;