FS/FS/Report/Table.pm

   1 package FS::Report::Table;
   2
   3 use strict;
   4 use base 'FS::Report';
   5 use Time::Local qw( timelocal );
   6 use FS::UID qw( dbh driver_name );
   7 use FS::Report::Table;
   8 use FS::CurrentUser;
   9 use Cache::FileCache;
  10
  11 our $DEBUG = 0; # turning this on will trace all SQL statements, VERY noisy
  12
  13 our $CACHE; # feel free to use this for whatever
  14
  15 FS::UID->install_callback(sub {
  16     $CACHE = Cache::FileCache->new( {
  17       'namespace'   => __PACKAGE__,
  18       'cache_root'  => "$FS::UID::cache_dir/cache.$FS::UID::datasrc",
  19     } );
  20     # reset this on startup (causes problems with database backups, etc.)
  21     $CACHE->remove('tower_pkg_cache_update');
  22 });
  23
  24 =head1 NAME
  25
  26 FS::Report::Table - Tables of report data
  27
  28 =head1 SYNOPSIS
  29
  30 See the more specific report objects, currently only
  31 FS::Report::Table::Monthly and FS::Report::Table::Daily.
  32
  33 =head1 OBSERVABLES
  34
  35 The common interface for an observable named 'foo' is:
  36
  37 $report->foo($startdate, $enddate, $agentnum, %options)
  38
  39 This returns a scalar value for foo, over the period from
  40 $startdate to $enddate, limited to agent $agentnum, subject to
  41 options in %opt.
  42
  43 =over 4
  44
  45 =item signups: The number of customers signed up.  Options are:
  46
  47 - cust_classnum: limit to this customer class
  48 - pkg_classnum: limit to customers with a package of this class.  If this is
  49   an arrayref, it's an ANY match.
  50 - refnum: limit to this advertising source
  51 - indirect: boolean; limit to customers that have a referral_custnum that
  52   matches the advertising source
  53
  54 =cut
  55
  56 sub signups {
  57   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
  58   my @where = ( $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
  59       'cust_main.signupdate')
  60   );
  61   my $join = '';
  62   if ( $opt{'indirect'} ) {
  63     $join = " JOIN cust_main AS referring_cust_main".
  64             " ON (cust_main.referral_custnum = referring_cust_main.custnum)";
  65
  66     if ( $opt{'refnum'} ) {
  67       push @where, "referring_cust_main.refnum = ".$opt{'refnum'};
  68     }
  69   }
  70   elsif ( $opt{'refnum'} ) {
  71     push @where, "refnum = ".$opt{'refnum'};
  72   }
  73
  74   push @where, $self->with_cust_classnum(%opt);
  75   if ( $opt{'pkg_classnum'} ) {
  76     my $classnum = $opt{'pkg_classnum'};
  77     $classnum = [ $classnum ] unless ref $classnum;
  78     @$classnum = grep /^\d+$/, @$classnum;
  79     if (@$classnum) {
  80       my $in = 'IN ('. join(',', @$classnum). ')';
  81       push @where,
  82         "EXISTS(SELECT 1 FROM cust_pkg JOIN part_pkg USING (pkgpart) ".
  83                "WHERE cust_pkg.custnum = cust_main.custnum ".
  84                "AND part_pkg.classnum $in".
  85                ")";
  86     }
  87   }
  88
  89   $self->scalar_sql(
  90     "SELECT COUNT(*) FROM cust_main $join WHERE ".join(' AND ', @where)
  91   );
  92 }
  93
  94 =item invoiced: The total amount charged on all invoices.
  95
  96 =cut
  97
  98 sub invoiced { #invoiced
  99   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 100
 101   my $sql = 'SELECT SUM(cust_bill.charged) FROM cust_bill';
 102   if ( $opt{'setuprecur'} ) {
 103     $sql = 'SELECT SUM('.
 104             FS::cust_bill_pkg->charged_sql($speriod, $eperiod, %opt).
 105            ') FROM cust_bill_pkg JOIN cust_bill USING (invnum)';
 106   }
 107
 108   $self->scalar_sql("
 109       $sql
 110         LEFT JOIN cust_main USING ( custnum )
 111       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 112                $self->for_opts(%opt)
 113   );
 114
 115 }
 116
 117 =item netsales: invoiced - netcredits
 118
 119 =cut
 120
 121 sub netsales { #net sales
 122   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 123
 124     $self->invoiced(  $speriod, $eperiod, $agentnum, %opt)
 125   - $self->netcredits($speriod, $eperiod, $agentnum, %opt);
 126 }
 127
 128 =item cashflow: payments - refunds
 129
 130 =cut
 131
 132 sub cashflow {
 133   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 134
 135     $self->payments($speriod, $eperiod, $agentnum, %opt)
 136   - $self->refunds( $speriod, $eperiod, $agentnum, %opt);
 137 }
 138
 139 =item netcashflow: payments - netrefunds
 140
 141 =cut
 142
 143 sub netcashflow {
 144   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 145
 146     $self->receipts(   $speriod, $eperiod, $agentnum, %opt)
 147   - $self->netrefunds( $speriod, $eperiod, $agentnum, %opt);
 148 }
 149
 150 =item payments: The sum of payments received in the period.
 151
 152 =cut
 153
 154 sub payments {
 155   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 156   $self->scalar_sql("
 157     SELECT SUM(paid)
 158       FROM cust_pay
 159         LEFT JOIN cust_main USING ( custnum )
 160       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 161                $self->for_opts(%opt)
 162   );
 163 }
 164
 165 =item credits: The sum of credits issued in the period.
 166
 167 =cut
 168
 169 sub credits {
 170   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 171   $self->scalar_sql("
 172     SELECT SUM(cust_credit.amount)
 173       FROM cust_credit
 174         LEFT JOIN cust_main USING ( custnum )
 175       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 176                $self->for_opts(%opt)
 177   );
 178 }
 179
 180 =item refunds: The sum of refunds paid in the period.
 181
 182 =cut
 183
 184 sub refunds {
 185   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 186   $self->scalar_sql("
 187     SELECT SUM(refund)
 188       FROM cust_refund
 189         LEFT JOIN cust_main USING ( custnum )
 190       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 191                $self->for_opts(%opt)
 192   );
 193 }
 194
 195 =item netcredits: The sum of credit applications to invoices in the period.
 196
 197 =cut
 198
 199 sub netcredits {
 200   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 201
 202   my $sql = 'SELECT SUM(cust_credit_bill.amount) FROM cust_credit_bill';
 203   if ( $opt{'setuprecur'} ) {
 204     $sql = 'SELECT SUM('.
 205             FS::cust_bill_pkg->credited_sql($speriod, $eperiod, %opt).
 206            ') FROM cust_bill_pkg';
 207   }
 208
 209   $self->scalar_sql("
 210     $sql
 211         LEFT JOIN cust_bill USING ( invnum  )
 212         LEFT JOIN cust_main USING ( custnum )
 213       WHERE ". $self->in_time_period_and_agent( $speriod,
 214                                                 $eperiod,
 215                                                 $agentnum,
 216                                                 'cust_bill._date'
 217                                               ).
 218                $self->for_opts(%opt)
 219   );
 220 }
 221
 222 =item receipts: The sum of payment applications to invoices in the period.
 223
 224 =cut
 225
 226 sub receipts { #net payments
 227   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 228
 229   my $sql = 'SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay';
 230   if ( $opt{'setuprecur'} ) {
 231     $sql = 'SELECT SUM('.
 232             FS::cust_bill_pkg->paid_sql($speriod, $eperiod, %opt).
 233            ') FROM cust_bill_pkg';
 234   }
 235
 236   $self->scalar_sql("
 237     $sql
 238         LEFT JOIN cust_bill USING ( invnum  )
 239         LEFT JOIN cust_main USING ( custnum )
 240       WHERE ". $self->in_time_period_and_agent( $speriod,
 241                                                 $eperiod,
 242                                                 $agentnum,
 243                                                 'cust_bill._date'
 244                                               ).
 245                $self->for_opts(%opt)
 246   );
 247 }
 248
 249 =item netrefunds: The sum of refund applications to credits in the period.
 250
 251 =cut
 252
 253 sub netrefunds {
 254   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 255   $self->scalar_sql("
 256     SELECT SUM(cust_credit_refund.amount)
 257       FROM cust_credit_refund
 258         LEFT JOIN cust_credit USING ( crednum  )
 259         LEFT JOIN cust_main   USING ( custnum )
 260       WHERE ". $self->in_time_period_and_agent( $speriod,
 261                                                 $eperiod,
 262                                                 $agentnum,
 263                                                 'cust_credit._date'
 264                                               ).
 265                $self->for_opts(%opt)
 266   );
 267 }
 268
 269 #XXX docs
 270
 271 #these should be auto-generated or $AUTOLOADed or something
 272 sub invoiced_12mo {
 273   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 274   $speriod = $self->_subtract_11mo($speriod);
 275   $self->invoiced($speriod, $eperiod, $agentnum);
 276 }
 277
 278 sub netsales_12mo {
 279   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 280   $speriod = $self->_subtract_11mo($speriod);
 281   $self->netsales($speriod, $eperiod, $agentnum);
 282 }
 283
 284 sub receipts_12mo {
 285   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 286   $speriod = $self->_subtract_11mo($speriod);
 287   $self->receipts($speriod, $eperiod, $agentnum);
 288 }
 289
 290 sub payments_12mo {
 291   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 292   $speriod = $self->_subtract_11mo($speriod);
 293   $self->payments($speriod, $eperiod, $agentnum);
 294 }
 295
 296 sub credits_12mo {
 297   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 298   $speriod = $self->_subtract_11mo($speriod);
 299   $self->credits($speriod, $eperiod, $agentnum);
 300 }
 301
 302 sub netcredits_12mo {
 303   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 304   $speriod = $self->_subtract_11mo($speriod);
 305   $self->netcredits($speriod, $eperiod, $agentnum);
 306 }
 307
 308 sub cashflow_12mo {
 309   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 310   $speriod = $self->_subtract_11mo($speriod);
 311   $self->cashflow($speriod, $eperiod, $agentnum);
 312 }
 313
 314 sub netcashflow_12mo {
 315   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 316   $speriod = $self->_subtract_11mo($speriod);
 317   $self->cashflow($speriod, $eperiod, $agentnum);
 318 }
 319
 320 sub refunds_12mo {
 321   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 322   $speriod = $self->_subtract_11mo($speriod);
 323   $self->refunds($speriod, $eperiod, $agentnum);
 324 }
 325
 326 sub netrefunds_12mo {
 327   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 328   $speriod = $self->_subtract_11mo($speriod);
 329   $self->netrefunds($speriod, $eperiod, $agentnum);
 330 }
 331
 332
 333 #not being too bad with the false laziness
 334 sub _subtract_11mo {
 335   my($self, $time) = @_;
 336   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
 337   $mon -= 11;
 338   if ( $mon < 0 ) { $mon+=12; $year--; }
 339   timelocal($sec,$min,$hour,$mday,$mon,$year);
 340 }
 341
 342 =item cust_pkg_setup_cost: The total setup costs of packages setup in the period
 343
 344 'classnum': limit to this package class.
 345
 346 =cut
 347
 348 sub cust_pkg_setup_cost {
 349   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 350   my $where = '';
 351
 352   if ( $opt{'classnum'} ne '' ) {
 353     my $classnums = $opt{'classnum'};
 354     $classnums = [ $classnums ] if !ref($classnums);
 355     @$classnums = grep /^\d+$/, @$classnums;
 356     $where .= ' AND COALESCE(part_pkg.classnum,0) IN ('. join(',', @$classnums).
 357                                                     ')';
 358   }
 359
 360   $agentnum ||= $opt{'agentnum'};
 361
 362   my $total_sql = " SELECT SUM(part_pkg.setup_cost) ";
 363   $total_sql .= " FROM cust_pkg
 364              LEFT JOIN cust_main USING ( custnum )
 365              LEFT JOIN part_pkg  USING ( pkgpart )
 366                   WHERE pkgnum != 0
 367                   $where
 368                   AND ".$self->in_time_period_and_agent(
 369                     $speriod, $eperiod, $agentnum, 'cust_pkg.setup');
 370   return $self->scalar_sql($total_sql);
 371 }
 372
 373 =item cust_pkg_recur_cust: the total recur costs of packages in the period
 374
 375 'classnum': limit to this package class.
 376
 377 =cut
 378
 379 sub cust_pkg_recur_cost {
 380   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 381   my $where = '';
 382
 383   if ( $opt{'classnum'} ne '' ) {
 384     my $classnums = $opt{'classnum'};
 385     $classnums = [ $classnums ] if !ref($classnums);
 386     @$classnums = grep /^\d+$/, @$classnums;
 387     $where .= ' AND COALESCE(part_pkg.classnum,0) IN ('. join(',', @$classnums).
 388                                                     ')';
 389   }
 390
 391   $agentnum ||= $opt{'agentnum'};
 392   # duplication of in_time_period_and_agent
 393   # because we do it a little differently here
 394   $where .= " AND cust_main.agentnum = $agentnum" if $agentnum;
 395   $where .= " AND ".
 396           $FS::CurrentUser::CurrentUser->agentnums_sql('table' => 'cust_main');
 397
 398   my $total_sql = " SELECT SUM(part_pkg.recur_cost) ";
 399   $total_sql .= " FROM cust_pkg
 400              LEFT JOIN cust_main USING ( custnum )
 401              LEFT JOIN part_pkg  USING ( pkgpart )
 402                   WHERE pkgnum != 0
 403                   $where
 404                   AND cust_pkg.setup < $eperiod
 405                   AND (cust_pkg.cancel > $speriod OR cust_pkg.cancel IS NULL)
 406                   ";
 407   return $self->scalar_sql($total_sql);
 408 }
 409
 410 =item cust_bill_pkg: the total package charges on invoice line items.
 411
 412 'charges': limit the type of charges included (setup, recur, usage).
 413 Should be a string containing one or more of 'S', 'R', or 'U'; if
 414 unspecified, defaults to all three.
 415
 416 'classnum': limit to this package class.
 417
 418 'use_override': for line items generated by an add-on package, use the class
 419 of the add-on rather than the base package.
 420
 421 'average_per_cust_pkg': divide the result by the number of distinct packages.
 422
 423 'distribute': for non-monthly recurring charges, ignore the invoice
 424 date.  Instead, consider the line item's starting/ending dates.  Determine
 425 the fraction of the line item duration that falls within the specified
 426 interval and return that fraction of the recurring charges.  This is
 427 somewhat experimental.
 428
 429 'project': enable if this is a projected period.  This is very experimental.
 430
 431 =cut
 432
 433 sub cust_bill_pkg {
 434   my $self = shift;
 435   my( $speriod, $eperiod, $agentnum, %opt ) = @_;
 436
 437   my %charges = map {$_=>1} split('', $opt{'charges'} || 'SRU');
 438
 439   my $sum = 0;
 440   $sum += $self->cust_bill_pkg_setup(@_) if $charges{S};
 441   $sum += $self->cust_bill_pkg_recur(@_) if $charges{R};
 442   $sum += $self->cust_bill_pkg_detail(@_) if $charges{U};
 443
 444   if ($opt{'average_per_cust_pkg'}) {
 445     my $count = $self->cust_bill_pkg_count_pkgnum(@_);
 446     return '' if $count == 0;
 447     $sum = sprintf('%.2f', $sum / $count);
 448   }
 449   $sum;
 450 }
 451
 452 my $cust_bill_pkg_join = '
 453     LEFT JOIN cust_bill USING ( invnum )
 454     LEFT JOIN cust_main USING ( custnum )
 455     LEFT JOIN cust_pkg USING ( pkgnum )
 456     LEFT JOIN part_pkg USING ( pkgpart )
 457     LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 458     LEFT JOIN part_fee USING ( feepart )';
 459
 460 sub cust_bill_pkg_setup {
 461   my $self = shift;
 462   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 463   # no projecting setup fees--use real invoices only
 464   # but evaluate this anyway, because the design of projection is that
 465   # if there are somehow real setup fees in the future, we want to count
 466   # them
 467
 468   $agentnum ||= $opt{'agentnum'};
 469
 470   my @where = (
 471     '(pkgnum != 0 OR feepart IS NOT NULL)',
 472     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 473     $self->with_report_option(%opt),
 474     $self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
 475     $self->with_refnum(%opt),
 476     $self->with_cust_classnum(%opt)
 477   );
 478
 479   my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0)
 480   FROM cust_bill_pkg
 481   $cust_bill_pkg_join
 482   WHERE " . join(' AND ', grep $_, @where);
 483
 484   $self->scalar_sql($total_sql);
 485 }
 486
 487 sub _cust_bill_pkg_recurring {
 488   # returns the FROM/WHERE part of the statement to query all recurring
 489   # line items in the period
 490   my $self = shift;
 491   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 492
 493   $agentnum ||= $opt{'agentnum'};
 494   my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg';
 495
 496   my @where = (
 497     '(pkgnum != 0 OR feepart IS NOT NULL)',
 498     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 499     $self->with_report_option(%opt),
 500     $self->with_refnum(%opt),
 501     $self->with_cust_classnum(%opt)
 502   );
 503
 504   if ( $opt{'distribute'} ) {
 505     $where[0] = 'pkgnum != 0'; # specifically exclude fees
 506     push @where, "cust_main.agentnum = $agentnum" if $agentnum;
 507     push @where,
 508       "$cust_bill_pkg.sdate <  $eperiod",
 509       "$cust_bill_pkg.edate >= $speriod",
 510     ;
 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   return "
 520   FROM $cust_bill_pkg
 521   $cust_bill_pkg_join
 522   WHERE ".join(' AND ', grep $_, @where);
 523
 524 }
 525
 526 sub cust_bill_pkg_recur {
 527   my $self = shift;
 528   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 529
 530   # subtract all usage from the line item regardless of date
 531   my $item_usage;
 532   if ( $opt{'project'} ) {
 533     $item_usage = 'usage'; #already calculated
 534   }
 535   else {
 536     $item_usage = '( SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
 537       FROM cust_bill_pkg_detail
 538       WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum )';
 539   }
 540
 541   my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg';
 542
 543   my $recur_fraction = '';
 544   if ($opt{'distribute'}) {
 545     # the fraction of edate - sdate that's within [speriod, eperiod]
 546     $recur_fraction = " *
 547       CAST(LEAST($eperiod, $cust_bill_pkg.edate) -
 548        GREATEST($speriod, $cust_bill_pkg.sdate) AS DECIMAL) /
 549       ($cust_bill_pkg.edate - $cust_bill_pkg.sdate)";
 550   }
 551
 552   my $total_sql =
 553     "SELECT COALESCE(SUM(($cust_bill_pkg.recur - $item_usage) $recur_fraction),0)" .
 554     $self->_cust_bill_pkg_recurring(@_);
 555
 556   $self->scalar_sql($total_sql);
 557 }
 558
 559 sub cust_bill_pkg_count_pkgnum {
 560   # for ARPU calculation
 561   my $self = shift;
 562   my $total_sql = 'SELECT COUNT(DISTINCT pkgnum) '.
 563     $self->_cust_bill_pkg_recurring(@_);
 564
 565   $self->scalar_sql($total_sql);
 566 }
 567
 568 =item cust_bill_pkg_detail: the total usage charges in detail lines.
 569
 570 Arguments as for C<cust_bill_pkg>, plus:
 571
 572 'usageclass': limit to this usage class number.
 573
 574 =cut
 575
 576 sub cust_bill_pkg_detail {
 577   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 578
 579   my @where =
 580     ( "(cust_bill_pkg.pkgnum != 0 OR cust_bill_pkg.feepart IS NOT NULL)" );
 581
 582   $agentnum ||= $opt{'agentnum'};
 583
 584   push @where,
 585     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 586     $self->with_usageclass($opt{'usageclass'}),
 587     $self->with_report_option(%opt),
 588     $self->with_refnum(%opt),
 589     $self->with_cust_classnum(%opt)
 590     ;
 591
 592   if ( $opt{'distribute'} ) {
 593     # exclude fees
 594     $where[0] = 'cust_bill_pkg.pkgnum != 0';
 595     # and limit according to the usage time, not the billing date
 596     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 597       'cust_bill_pkg_detail.startdate'
 598     );
 599   }
 600   else {
 601     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 602       'cust_bill._date'
 603     );
 604   }
 605
 606   my $total_sql = " SELECT SUM(cust_bill_pkg_detail.amount) ";
 607
 608   $total_sql .=
 609     " FROM cust_bill_pkg_detail
 610         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 611         LEFT JOIN cust_bill ON cust_bill_pkg.invnum = cust_bill.invnum
 612         LEFT JOIN cust_main USING ( custnum )
 613         LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum
 614         LEFT JOIN part_pkg USING ( pkgpart )
 615         LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 616         LEFT JOIN part_fee USING ( feepart )
 617       WHERE ".join( ' AND ', grep $_, @where );
 618
 619   $self->scalar_sql($total_sql);
 620
 621 }
 622
 623 sub cust_bill_pkg_discount {
 624   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 625
 626   #need to do this the new multi-classnum way if it gets re-enabled
 627   #my $where = '';
 628   #my $comparison = '';
 629   #if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
 630   #  if ( $1 == 0 ) {
 631   #    $comparison = "IS NULL";
 632   #  } else {
 633   #    $comparison = "= $1";
 634   #  }
 635   #
 636   #  if ( $opt{'use_override'} ) {
 637   #    $where = "(
 638   #      part_pkg.classnum $comparison AND pkgpart_override IS NULL OR
 639   #      override.classnum $comparison AND pkgpart_override IS NOT NULL
 640   #    )";
 641   #  } else {
 642   #    $where = "part_pkg.classnum $comparison";
 643   #  }
 644   #}
 645
 646   $agentnum ||= $opt{'agentnum'};
 647
 648   my $total_sql =
 649     " SELECT COALESCE( SUM( cust_bill_pkg_discount.amount ), 0 ) ";
 650
 651   $total_sql .=
 652     " FROM cust_bill_pkg_discount
 653         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 654         LEFT JOIN cust_bill USING ( invnum )
 655         LEFT JOIN cust_main USING ( custnum )
 656       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum);
 657   #      LEFT JOIN cust_pkg_discount USING ( pkgdiscountnum )
 658   #      LEFT JOIN discount USING ( discountnum )
 659   #      LEFT JOIN cust_pkg USING ( pkgnum )
 660   #      LEFT JOIN part_pkg USING ( pkgpart )
 661   #      LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 662
 663   return $self->scalar_sql($total_sql);
 664
 665 }
 666
 667 sub pkg_field_where {
 668   my( $self, $field, $speriod, $eperiod, $agentnum, %opt ) = @_;
 669   # someday this will use an aggregate query and return all the columns
 670   # at once
 671   # and I will drive a Tesla and have a live-in sushi chef who is also a
 672   # ninja bodyguard
 673   my @where = (
 674     $self->in_time_period_and_agent($speriod,
 675                                     $eperiod,
 676                                     $agentnum,
 677                                     "cust_pkg.$field",
 678                                    ),
 679     $self->with_refnum(%opt),
 680     $self->with_towernum(%opt),
 681     $self->with_zip(%opt),
 682     # can't use with_classnum here...
 683   );
 684   if ($opt{classnum}) {
 685     my $classnum = $opt{classnum};
 686     $classnum = [ $classnum ] if !ref($classnum);
 687     @$classnum = grep /^\d+$/, @$classnum;
 688     my $in = 'IN ('. join(',', @$classnum). ')';
 689     push @where, "COALESCE(part_pkg.classnum, 0) $in" if scalar @$classnum;
 690   }
 691
 692   ' WHERE ' . join(' AND ', grep $_, @where);
 693 }
 694
 695 =item setup_pkg: The number of packages with setup dates in the period.
 696
 697 This excludes packages created by package changes. Options:
 698
 699 - refnum: Limit to customers with this advertising source.
 700 - classnum: Limit to packages with this class.
 701 - towernum: Limit to packages that have a broadband service with this tower.
 702 - zip: Limit to packages with this service location zip code.
 703
 704 Except for zip, any of these can be an arrayref to allow multiple values for
 705 the field.
 706
 707 =item susp_pkg: The number of suspended packages that were last suspended
 708 in the period. Options are as for setup_pkg.
 709
 710 =item cancel_pkg: The number of packages with cancel dates in the period.
 711 Excludes packages that were canceled to be changed to a new package. Options
 712 are as for setup_pkg.
 713
 714 =cut
 715
 716 sub setup_pkg {
 717   my $self = shift;
 718   my $sql = 'SELECT COUNT(*) FROM cust_pkg
 719               LEFT JOIN part_pkg USING (pkgpart)
 720               LEFT JOIN cust_main USING (custnum)'.
 721               $self->pkg_field_where('setup', @_) .
 722               ' AND change_pkgnum IS NULL';
 723
 724   $self->scalar_sql($sql);
 725 }
 726
 727 sub susp_pkg {
 728   # number of currently suspended packages that were suspended in the period
 729   my $self = shift;
 730   my $sql = 'SELECT COUNT(*) FROM cust_pkg
 731               LEFT JOIN part_pkg USING (pkgpart)
 732               LEFT JOIN cust_main USING (custnum) '.
 733               $self->pkg_field_where('susp', @_);
 734
 735   $self->scalar_sql($sql);
 736 }
 737
 738 sub cancel_pkg {
 739   # number of packages canceled in the period and not changed to another
 740   # package
 741   my $self = shift;
 742   my $sql = 'SELECT COUNT(*) FROM cust_pkg
 743               LEFT JOIN part_pkg USING (pkgpart)
 744               LEFT JOIN cust_main USING (custnum)
 745               LEFT JOIN cust_pkg changed_to_pkg ON(
 746                 cust_pkg.pkgnum = changed_to_pkg.change_pkgnum
 747               ) '.
 748               $self->pkg_field_where('cancel', @_) .
 749               ' AND changed_to_pkg.pkgnum IS NULL';
 750
 751   $self->scalar_sql($sql);
 752 }
 753
 754 #this is going to be harder..
 755 #sub unsusp_pkg {
 756 #  my( $self, $speriod, $eperiod, $agentnum ) = @_;
 757 #  $self->scalar_sql("
 758 #    SELECT COUNT(*) FROM h_cust_pkg
 759 #      WHERE
 760 #
 761 #}
 762
 763 sub in_time_period_and_agent {
 764   my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4);
 765   my $col = @_ ? shift() : '_date';
 766
 767   my $sql = "$col >= $speriod AND $col < $eperiod";
 768
 769   #agent selection
 770   $sql .= " AND cust_main.agentnum = $agentnum"
 771     if $agentnum;
 772
 773   #agent virtualization
 774   $sql .= ' AND '.
 775           $FS::CurrentUser::CurrentUser->agentnums_sql( 'table'=>'cust_main' );
 776
 777   $sql;
 778 }
 779
 780 sub for_opts {
 781     my ( $self, %opt ) = @_;
 782     my $sql = '';
 783     if ( $opt{'custnum'} =~ /^(\d+)$/ ) {
 784       $sql .= " and custnum = $1 ";
 785     }
 786     if ( $opt{'refnum'} ) {
 787       my $refnum = $opt{'refnum'};
 788       $refnum = [ $refnum ] if !ref($refnum);
 789       my $in = join(',', grep /^\d+$/, @$refnum);
 790       $sql .= " and refnum IN ($in)" if length $in;
 791     }
 792     if ( my $where = $self->with_cust_classnum(%opt) ) {
 793       $sql .= " and $where";
 794     }
 795
 796     $sql;
 797 }
 798
 799 sub with_classnum {
 800   my ($self, $classnum, $use_override) = @_;
 801   return '' if $classnum eq '';
 802
 803   $classnum = [ $classnum ] if !ref($classnum);
 804   @$classnum = grep /^\d+$/, @$classnum;
 805   my $in = 'IN ('. join(',', @$classnum). ')';
 806
 807   my $expr = "
 808          ( COALESCE(part_pkg.classnum, 0) $in AND pkgpart_override IS NULL)
 809       OR ( COALESCE(part_fee.classnum, 0) $in AND feepart IS NOT NULL )";
 810   if ( $use_override ) {
 811     $expr .= "
 812       OR ( COALESCE(override.classnum, 0) $in AND pkgpart_override IS NOT NULL )";
 813   }
 814   "( $expr )";
 815 }
 816
 817 sub with_usageclass {
 818   my $self = shift;
 819   my ($classnum, $use_override) = @_;
 820   return '' unless $classnum =~ /^\d+$/;
 821   my $comparison;
 822   if ( $classnum == 0 ) {
 823     $comparison = 'IS NULL';
 824   }
 825   else {
 826     $comparison = "= $classnum";
 827   }
 828   return "cust_bill_pkg_detail.classnum $comparison";
 829 }
 830
 831 sub with_report_option {
 832   my ($self, %opt) = @_;
 833   # %opt can contain:
 834   # - report_optionnum: a comma-separated list of numbers.  Zero means to
 835   #   include packages with _no_ report classes.
 836   # - not_report_optionnum: a comma-separated list.  Packages that have
 837   #   any of these report options will be excluded from the result.
 838   #   Zero does nothing.
 839   # - use_override: also matches line items that are add-ons to a package
 840   #   matching the report class.
 841   # - all_report_options: returns only packages that have ALL of the
 842   #   report classes listed in $num.  Otherwise, will return packages that
 843   #   have ANY of those classes.
 844
 845   my @num = ref($opt{'report_optionnum'})
 846                   ? @{ $opt{'report_optionnum'} }
 847                   : split(/\s*,\s*/, $opt{'report_optionnum'});
 848   my @not_num = ref($opt{'not_report_optionnum'})
 849                       ? @{ $opt{'not_report_optionnum'} }
 850                       : split(/\s*,\s*/, $opt{'not_report_optionnum'});
 851   my $null;
 852   $null = 1 if ( grep {$_ == 0} @num );
 853   @num = grep {$_ > 0} @num;
 854   @not_num = grep {$_ > 0} @not_num;
 855
 856   # brute force
 857   my $table = $opt{'use_override'} ? 'override' : 'part_pkg';
 858   my $op = ' OR ';
 859   if ( $opt{'all_report_options'} ) {
 860     if ( @num and $null ) {
 861       return 'false'; # mutually exclusive criteria, so just bail out
 862     }
 863     $op = ' AND ';
 864   }
 865   my @where_num = map {
 866     "EXISTS(SELECT 1 FROM part_pkg_option ".
 867     "WHERE optionname = 'report_option_$_' ".
 868     "AND part_pkg_option.pkgpart = $table.pkgpart)"
 869   } @num;
 870   if ( $null ) {
 871     push @where_num, "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
 872                      "WHERE optionname LIKE 'report_option_%' ".
 873                      "AND part_pkg_option.pkgpart = $table.pkgpart)";
 874   }
 875   my @where_not_num = map {
 876     "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
 877     "WHERE optionname = 'report_option_$_' ".
 878     "AND part_pkg_option.pkgpart = $table.pkgpart)"
 879   } @not_num;
 880
 881   my @where;
 882   if (@where_num) {
 883     push @where, '( '.join($op, @where_num).' )';
 884   }
 885   if (@where_not_num) {
 886     push @where, '( '.join(' AND ', @where_not_num).' )';
 887   }
 888
 889   return @where;
 890   # this messes up totals
 891   #if ( $opt{'use_override'} ) {
 892   #  # then also allow the non-override package to match
 893   #  delete $opt{'use_override'};
 894   #  $comparison = "( $comparison OR " . $self->with_report_option(%opt) . ")";
 895   #}
 896
 897 }
 898
 899 sub with_refnum {
 900   my ($self, %opt) = @_;
 901   if ( $opt{'refnum'} ) {
 902     my $refnum = $opt{'refnum'};
 903     $refnum = [ $refnum ] if !ref($refnum);
 904     my $in = join(',', grep /^\d+$/, @$refnum);
 905     return "cust_main.refnum IN ($in)" if length $in;
 906   }
 907   return;
 908 }
 909
 910 sub with_towernum {
 911   my ($self, %opt) = @_;
 912   if ( $opt{'towernum'} ) {
 913     my $towernum = $opt{'towernum'};
 914     $towernum = [ $towernum ] if !ref($towernum);
 915     my $in = join(',', grep /^\d+$/, @$towernum);
 916     return unless length($in); # if no towers are specified, don't restrict
 917
 918     # materialize/cache the set of pkgnums that, as of the last
 919     # svc_broadband history record, had a certain towernum
 920     # (because otherwise this is painfully slow)
 921     $self->_init_tower_pkg_cache;
 922
 923     return "EXISTS(
 924             SELECT 1 FROM tower_pkg_cache
 925               WHERE towernum IN($in)
 926               AND cust_pkg.pkgnum = tower_pkg_cache.pkgnum
 927             )";
 928   }
 929   return;
 930 }
 931
 932 sub with_zip {
 933   my ($self, %opt) = @_;
 934   if (length($opt{'zip'})) {
 935     return "(SELECT zip FROM cust_location
 936              WHERE cust_location.locationnum = cust_pkg.locationnum
 937             ) = " . dbh->quote($opt{'zip'});
 938   }
 939   return;
 940 }
 941
 942 sub with_cust_classnum {
 943   my ($self, %opt) = @_;
 944   if ( $opt{'cust_classnum'} ) {
 945     my $classnums = $opt{'cust_classnum'};
 946     $classnums = [ $classnums ] if !ref($classnums);
 947     @$classnums = grep /^\d+$/, @$classnums;
 948     return 'cust_main.classnum in('. join(',',@$classnums) .')'
 949       if @$classnums;
 950   }
 951   return;
 952 }
 953
 954
 955 sub scalar_sql {
 956   my( $self, $sql ) = ( shift, shift );
 957   my $sth = dbh->prepare($sql) or die dbh->errstr;
 958   warn "FS::Report::Table\n$sql\n" if $DEBUG;
 959   $sth->execute
 960     or die "Unexpected error executing statement $sql: ". $sth->errstr;
 961   $sth->fetchrow_arrayref->[0] || 0;
 962 }
 963
 964 =back
 965
 966 =head1 METHODS
 967
 968 =over 4
 969
 970 =item init_projection
 971
 972 Sets up for future projection of all observables on the report.  Currently
 973 this is limited to 'cust_bill_pkg'.
 974
 975 =cut
 976
 977 sub init_projection {
 978   # this is weird special case stuff--some redesign may be needed
 979   # to use it for anything else
 980   my $self = shift;
 981
 982   if ( driver_name ne 'Pg' ) {
 983     # also database-specific for now
 984     die "projection reports not supported on this platform";
 985   }
 986
 987   my %items = map {$_ => 1} @{ $self->{items} };
 988   if ($items{'cust_bill_pkg'}) {
 989     my $dbh = dbh;
 990     # v_ for 'virtual'
 991     my @sql = (
 992       # could use TEMPORARY TABLE but we're already transaction-protected
 993       'DROP TABLE IF EXISTS v_cust_bill_pkg',
 994       'CREATE TABLE v_cust_bill_pkg ' .
 995        '(LIKE cust_bill_pkg,
 996           usage numeric(10,2), _date integer, expire integer)',
 997       # XXX this should be smart enough to take only the ones with
 998       # sdate/edate overlapping the ROI, for performance
 999       "INSERT INTO v_cust_bill_pkg (
1000         SELECT cust_bill_pkg.*,
1001           (SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
1002           FROM cust_bill_pkg_detail
1003           WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum),
1004           cust_bill._date,
1005           cust_pkg.expire
1006         FROM cust_bill_pkg $cust_bill_pkg_join
1007       )",
1008     );
1009     foreach my $sql (@sql) {
1010       warn "[init_projection] $sql\n" if $DEBUG;
1011       $dbh->do($sql) or die $dbh->errstr;
1012     }
1013   }
1014 }
1015
1016 =item extend_projection START END
1017
1018 Generates data for the next period of projection.  This will be called
1019 for sequential periods where the END of one equals the START of the next
1020 (with no gaps).
1021
1022 =cut
1023
1024 sub extend_projection {
1025   my $self = shift;
1026   my ($speriod, $eperiod) = @_;
1027   my %items = map {$_ => 1} @{ $self->{items} };
1028   if ($items{'cust_bill_pkg'}) {
1029     # What we do here:
1030     # Find all line items that end after the start of the period (and have
1031     # recurring fees, and don't expire before they end).  Choose the latest
1032     # one for each package.  If it ends before the end of the period, copy
1033     # it forward by one billing period.
1034     # Repeat this until the latest line item for each package no longer ends
1035     # within the period.  This is certain to happen in finitely many
1036     # iterations as long as freq > 0.
1037     # - Pg only, obviously.
1038     # - Gives bad results if freq_override is used.
1039     my @fields = ( FS::cust_bill_pkg->fields, qw( usage _date expire ) );
1040     my $insert_fields = join(',', @fields);
1041     my $add_freq = sub { # emulate FS::part_pkg::add_freq
1042       my $field = shift;
1043       "EXTRACT( EPOCH FROM TO_TIMESTAMP($field) + (CASE WHEN freq ~ E'\\\\D' ".
1044       "THEN freq ELSE freq || 'mon' END)::INTERVAL) AS $field";
1045     };
1046     foreach (@fields) {
1047       if ($_ eq 'edate') {
1048         $_ = $add_freq->('edate');
1049       }
1050       elsif ($_ eq 'sdate') {
1051         $_ = 'edate AS sdate'
1052       }
1053       elsif ($_ eq 'setup') {
1054         $_ = '0 AS setup' #because recurring only
1055       }
1056       elsif ($_ eq '_date') {
1057         $_ = $add_freq->('_date');
1058       }
1059     }
1060     my $select_fields = join(',', @fields);
1061     my $dbh = dbh;
1062     my $sql =
1063     # Subquery here because we need to DISTINCT the whole set, select the
1064     # latest charge per pkgnum, and _then_ check edate < $eperiod
1065     # and edate < expire.
1066       "INSERT INTO v_cust_bill_pkg ($insert_fields)
1067         SELECT $select_fields FROM (
1068           SELECT DISTINCT ON (pkgnum) * FROM v_cust_bill_pkg
1069             WHERE edate >= $speriod
1070               AND recur > 0
1071               AND freq IS NOT NULL
1072               AND freq != '0'
1073             ORDER BY pkgnum, edate DESC
1074           ) AS v1
1075           WHERE edate < $eperiod AND (edate < expire OR expire IS NULL)";
1076     my $rows;
1077     do {
1078       warn "[extend_projection] $sql\n" if $DEBUG;
1079       $rows = $dbh->do($sql) or die $dbh->errstr;
1080       warn "[extend_projection] $rows rows\n" if $DEBUG;
1081     } until $rows == 0;
1082   }
1083 }
1084
1085 =item _init_tower_pkg_cache
1086
1087 Internal method: creates a temporary table relating pkgnums to towernums.
1088 A (pkgnum, towernum) record indicates that this package once had a
1089 svc_broadband service which, as of its last insert or replace_new history
1090 record, had a sectornum associated with that towernum.
1091
1092 This is expensive, so it won't be done more than once an hour. Historical
1093 data about package churn shouldn't be changing in realtime anyway.
1094
1095 =cut
1096
1097 sub _init_tower_pkg_cache {
1098   my $self = shift;
1099   my $dbh = dbh;
1100
1101   my $current = $CACHE->get('tower_pkg_cache_update');
1102   return if $current;
1103
1104   # XXX or should this be in the schema?
1105   my $sql = "DROP TABLE IF EXISTS tower_pkg_cache";
1106   $dbh->do($sql) or die $dbh->errstr;
1107   $sql = "CREATE TABLE tower_pkg_cache (towernum int, pkgnum int)";
1108   $dbh->do($sql) or die $dbh->errstr;
1109
1110   # assumptions:
1111   # sectornums never get reused, or move from one tower to another
1112   # all service history is intact
1113   # svcnums never get reused (this would be bad)
1114   # pkgnums NEVER get reused (this would be extremely bad)
1115   $sql = "INSERT INTO tower_pkg_cache (
1116     SELECT COALESCE(towernum,0), pkgnum
1117     FROM ( SELECT DISTINCT pkgnum, svcnum FROM h_cust_svc ) AS pkgnum_svcnum
1118     LEFT JOIN (
1119       SELECT DISTINCT ON(svcnum) svcnum, sectornum
1120         FROM h_svc_broadband
1121         WHERE (history_action = 'replace_new'
1122                OR history_action = 'replace_old')
1123         ORDER BY svcnum ASC, history_date DESC
1124     ) AS svcnum_sectornum USING (svcnum)
1125     LEFT JOIN tower_sector USING (sectornum)
1126   )";
1127   $dbh->do($sql) or die $dbh->errstr;
1128
1129   $CACHE->set('tower_pkg_cache_update', 1, 3600);
1130
1131 };
1132
1133 =head1 BUGS
1134
1135 Documentation.
1136
1137 =head1 SEE ALSO
1138
1139 L<FS::Report::Table::Monthly>, reports in the web interface.
1140
1141 =cut
1142
1143 1;