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{'report_optionnum'}, $opt{'use_override'}),
 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{'report_optionnum'}, $opt{'use_override'}),
 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{'report_optionnum'}, $opt{'use_override'}),
 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, $num, $use_override) = @_;
 712   # $num can be a single number, or a comma-delimited list of numbers,
 713   # or an arrayref.  0 matches the empty set
 714   # or the word 'multiple' for all packages with more than one report class
 715   return '' if !defined($num);
 716
 717   $num = join(',', @$num) if ref($num);
 718
 719   # stringify the set of report options for each pkgpart
 720   my $table = $use_override ? 'override' : 'part_pkg';
 721   my $subselect = "
 722     SELECT replace(optionname, 'report_option_', '') AS num
 723       FROM part_pkg_option
 724       WHERE optionname like 'report_option_%'
 725         AND part_pkg_option.pkgpart = $table.pkgpart
 726       ORDER BY num";
 727
 728   my $comparison;
 729   if ( $num eq 'multiple' ) {
 730     $comparison = "(SELECT COUNT(*) FROM ($subselect) AS x) > 1";
 731   } else {
 732
 733     my @num = split(/\s*,\s*/, $num);
 734
 735     #$comparison = "(SELECT COALESCE(string_agg(num, ','), '') FROM ( #Pg 9-ism
 736     $comparison = "(SELECT COALESCE(array_to_string(array_agg(num), ','), '')
 737                       FROM ($subselect) AS x
 738                    ) = '". join(',', grep $_, @num). "'";
 739
 740     $comparison = "( $comparison OR NOT EXISTS ($subselect) )"
 741       if grep !$_, @num;
 742
 743   }
 744   if ( $use_override ) {
 745     # then also allow the non-override package to match
 746     $comparison = "( $comparison OR " . $self->with_report_option($num) . ")";
 747   }
 748   $comparison;
 749 }
 750
 751 sub with_cust_classnum {
 752   my ($self, %opt) = @_;
 753   if ( $opt{'cust_classnum'} ) {
 754     my $classnums = $opt{'cust_classnum'};
 755     $classnums = [ $classnums ] if !ref($classnums);
 756     @$classnums = grep /^\d+$/, @$classnums;
 757     return 'cust_main.classnum in('. join(',',@$classnums) .')'
 758       if @$classnums;
 759   }
 760   '';
 761 }
 762
 763
 764 sub scalar_sql {
 765   my( $self, $sql ) = ( shift, shift );
 766   my $sth = dbh->prepare($sql) or die dbh->errstr;
 767   warn "FS::Report::Table\n$sql\n" if $DEBUG;
 768   $sth->execute
 769     or die "Unexpected error executing statement $sql: ". $sth->errstr;
 770   $sth->fetchrow_arrayref->[0] || 0;
 771 }
 772
 773 =back
 774
 775 =head1 METHODS
 776
 777 =over 4
 778
 779 =item init_projection
 780
 781 Sets up for future projection of all observables on the report.  Currently
 782 this is limited to 'cust_bill_pkg'.
 783
 784 =cut
 785
 786 sub init_projection {
 787   # this is weird special case stuff--some redesign may be needed
 788   # to use it for anything else
 789   my $self = shift;
 790
 791   if ( driver_name ne 'Pg' ) {
 792     # also database-specific for now
 793     die "projection reports not supported on this platform";
 794   }
 795
 796   my %items = map {$_ => 1} @{ $self->{items} };
 797   if ($items{'cust_bill_pkg'}) {
 798     my $dbh = dbh;
 799     # v_ for 'virtual'
 800     my @sql = (
 801       # could use TEMPORARY TABLE but we're already transaction-protected
 802       'DROP TABLE IF EXISTS v_cust_bill_pkg',
 803       'CREATE TABLE v_cust_bill_pkg ' .
 804        '(LIKE cust_bill_pkg,
 805           usage numeric(10,2), _date integer, expire integer)',
 806       # XXX this should be smart enough to take only the ones with
 807       # sdate/edate overlapping the ROI, for performance
 808       "INSERT INTO v_cust_bill_pkg (
 809         SELECT cust_bill_pkg.*,
 810           (SELECT COALESCE(SUM(amount),0) FROM cust_bill_pkg_detail
 811           WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum),
 812           cust_bill._date,
 813           cust_pkg.expire
 814         FROM cust_bill_pkg $cust_bill_pkg_join
 815       )",
 816     );
 817     foreach my $sql (@sql) {
 818       warn "[init_projection] $sql\n" if $DEBUG;
 819       $dbh->do($sql) or die $dbh->errstr;
 820     }
 821   }
 822 }
 823
 824 =item extend_projection START END
 825
 826 Generates data for the next period of projection.  This will be called
 827 for sequential periods where the END of one equals the START of the next
 828 (with no gaps).
 829
 830 =cut
 831
 832 sub extend_projection {
 833   my $self = shift;
 834   my ($speriod, $eperiod) = @_;
 835   my %items = map {$_ => 1} @{ $self->{items} };
 836   if ($items{'cust_bill_pkg'}) {
 837     # What we do here:
 838     # Find all line items that end after the start of the period (and have
 839     # recurring fees, and don't expire before they end).  Choose the latest
 840     # one for each package.  If it ends before the end of the period, copy
 841     # it forward by one billing period.
 842     # Repeat this until the latest line item for each package no longer ends
 843     # within the period.  This is certain to happen in finitely many
 844     # iterations as long as freq > 0.
 845     # - Pg only, obviously.
 846     # - Gives bad results if freq_override is used.
 847     my @fields = ( FS::cust_bill_pkg->fields, qw( usage _date expire ) );
 848     my $insert_fields = join(',', @fields);
 849     my $add_freq = sub { # emulate FS::part_pkg::add_freq
 850       my $field = shift;
 851       "EXTRACT( EPOCH FROM TO_TIMESTAMP($field) + (CASE WHEN freq ~ E'\\\\D' ".
 852       "THEN freq ELSE freq || 'mon' END)::INTERVAL) AS $field";
 853     };
 854     foreach (@fields) {
 855       if ($_ eq 'edate') {
 856         $_ = $add_freq->('edate');
 857       }
 858       elsif ($_ eq 'sdate') {
 859         $_ = 'edate AS sdate'
 860       }
 861       elsif ($_ eq 'setup') {
 862         $_ = '0 AS setup' #because recurring only
 863       }
 864       elsif ($_ eq '_date') {
 865         $_ = $add_freq->('_date');
 866       }
 867     }
 868     my $select_fields = join(',', @fields);
 869     my $dbh = dbh;
 870     my $sql =
 871     # Subquery here because we need to DISTINCT the whole set, select the
 872     # latest charge per pkgnum, and _then_ check edate < $eperiod
 873     # and edate < expire.
 874       "INSERT INTO v_cust_bill_pkg ($insert_fields)
 875         SELECT $select_fields FROM (
 876           SELECT DISTINCT ON (pkgnum) * FROM v_cust_bill_pkg
 877             WHERE edate >= $speriod
 878               AND recur > 0
 879               AND freq IS NOT NULL
 880               AND freq != '0'
 881             ORDER BY pkgnum, edate DESC
 882           ) AS v1
 883           WHERE edate < $eperiod AND (edate < expire OR expire IS NULL)";
 884     my $rows;
 885     do {
 886       warn "[extend_projection] $sql\n" if $DEBUG;
 887       $rows = $dbh->do($sql) or die $dbh->errstr;
 888       warn "[extend_projection] $rows rows\n" if $DEBUG;
 889     } until $rows == 0;
 890   }
 891 }
 892
 893 =head1 BUGS
 894
 895 Documentation.
 896
 897 =head1 SEE ALSO
 898
 899 L<FS::Report::Table::Monthly>, reports in the web interface.
 900
 901 =cut
 902
 903 1;