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 ##### package churn report #####
 668
 669 =item active_pkg: The number of packages that were active at the start of
 670 the period. The end date of the period is ignored. Options:
 671
 672 - refnum: Limit to customers with this advertising source.
 673 - classnum: Limit to packages with this class.
 674 - towernum: Limit to packages that have a broadband service with this tower.
 675 - zip: Limit to packages with this service location zip code.
 676
 677 Except for zip, any of these can be an arrayref to allow multiple values for
 678 the field.
 679
 680 =item setup_pkg: The number of packages with setup dates in the period. This
 681 excludes packages created by package changes. Options are as for active_pkg.
 682
 683 =item susp_pkg: The number of packages that were suspended in the period
 684 (and not canceled).  Options are as for active_pkg.
 685
 686 =item unsusp_pkg: The number of packages that were unsuspended in the period.
 687 Options are as for active_pkg.
 688
 689 =item cancel_pkg: The number of packages with cancel dates in the period.
 690 Excludes packages that were canceled to be changed to a new package. Options
 691 are as for active_pkg.
 692
 693 =cut
 694
 695 sub active_pkg {
 696   my $self = shift;
 697   $self->churn_pkg('active', @_);
 698 }
 699
 700 sub setup_pkg {
 701   my $self = shift;
 702   $self->churn_pkg('setup', @_);
 703 }
 704
 705 sub cancel_pkg {
 706   my $self = shift;
 707   $self->churn_pkg('cancel', @_);
 708 }
 709
 710 sub susp_pkg {
 711   my $self = shift;
 712   $self->churn_pkg('susp', @_);
 713 }
 714
 715 sub unsusp_pkg {
 716   my $self = shift;
 717   $self->churn_pkg('unsusp', @_);
 718 }
 719
 720 sub churn_pkg {
 721   my $self = shift;
 722   my ( $status, $speriod, $eperiod, $agentnum, %opt ) = @_;
 723   my ($from, @where) =
 724     FS::h_cust_pkg->churn_fromwhere_sql( $status, $speriod, $eperiod);
 725
 726   push @where, $self->pkg_where(%opt, 'agentnum' => $agentnum);
 727
 728   my $sql = "SELECT COUNT(*) FROM $from
 729     JOIN part_pkg ON (cust_pkg.pkgpart = part_pkg.pkgpart)
 730     JOIN cust_main ON (cust_pkg.custnum = cust_main.custnum)";
 731   $sql .= ' WHERE '.join(' AND ', @where)
 732     if scalar(@where);
 733
 734   $self->scalar_sql($sql);
 735 }
 736
 737 sub pkg_where {
 738   my $self = shift;
 739   my %opt = @_;
 740   my @where = (
 741     "part_pkg.freq != '0'",
 742     $self->with_refnum(%opt),
 743     $self->with_towernum(%opt),
 744     $self->with_zip(%opt),
 745   );
 746   if ($opt{agentnum} =~ /^(\d+)$/) {
 747     push @where, "cust_main.agentnum = $1";
 748   }
 749   if ($opt{classnum}) {
 750     my $classnum = $opt{classnum};
 751     $classnum = [ $classnum ] if !ref($classnum);
 752     @$classnum = grep /^\d+$/, @$classnum;
 753     my $in = 'IN ('. join(',', @$classnum). ')';
 754     push @where, "COALESCE(part_pkg.classnum, 0) $in" if scalar @$classnum;
 755   }
 756   @where;
 757 }
 758
 759 ##### end of package churn report stuff #####
 760
 761 ##### customer churn report #####
 762
 763 =item active_cust: The number of customers who had any active recurring
 764 packages at the start of the period. The end date is ignored, agentnum is
 765 mandatory, and no other parameters are accepted.
 766
 767 =item started_cust: The number of customers who had no active packages at
 768 the start of the period, but had active packages at the end. Like
 769 active_cust, agentnum is mandatory and no other parameters are accepted.
 770
 771 =item suspended_cust: The number of customers who had active packages at
 772 the start of the period, and at the end had no active packages but some
 773 suspended packages. Note that this does not necessarily mean that their
 774 packages were suspended during the period.
 775
 776 =item resumed_cust: The inverse of suspended_cust: the number of customers
 777 who had suspended packages and no active packages at the start of the
 778 period, and active packages at the end.
 779
 780 =item cancelled_cust: The number of customers who had active packages
 781 at the start of the period, and only cancelled packages at the end.
 782
 783 =cut
 784
 785 sub active_cust {
 786   my $self = shift;
 787   $self->churn_cust(@_)->{active};
 788 }
 789 sub started_cust {
 790   my $self = shift;
 791   $self->churn_cust(@_)->{started};
 792 }
 793 sub suspended_cust {
 794   my $self = shift;
 795   $self->churn_cust(@_)->{suspended};
 796 }
 797 sub resumed_cust {
 798   my $self = shift;
 799   $self->churn_cust(@_)->{resumed};
 800 }
 801 sub cancelled_cust {
 802   my $self = shift;
 803   $self->churn_cust(@_)->{cancelled};
 804 }
 805
 806 sub churn_cust {
 807   my $self = shift;
 808   my ( $speriod ) = @_;
 809
 810   # run one query for each interval
 811   return $self->{_interval}{$speriod} ||= $self->calculate_churn_cust(@_);
 812 }
 813
 814 sub calculate_churn_cust {
 815   my $self = shift;
 816   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 817
 818   my $churn_sql = FS::cust_main::Status->churn_sql($speriod, $eperiod);
 819   my $where = '';
 820   $where = " WHERE cust_main.agentnum = $agentnum " if $agentnum;
 821   my $cust_sql =
 822     "SELECT churn.* ".
 823     "FROM cust_main JOIN ($churn_sql) AS churn USING (custnum)".
 824     $where;
 825
 826   # query to count the ones with certain status combinations
 827   my $total_sql = "
 828     SELECT SUM((s_active > 0)::int)                   as active,
 829            SUM((s_active = 0 and e_active > 0)::int)  as started,
 830            SUM((s_active > 0 and e_active = 0 and e_suspended > 0)::int)
 831                                                       as suspended,
 832            SUM((s_active = 0 and s_suspended > 0 and e_active > 0)::int)
 833                                                       as resumed,
 834            SUM((s_active > 0 and e_active = 0 and e_suspended = 0)::int)
 835                                                       as cancelled
 836     FROM ($cust_sql) AS x
 837   ";
 838
 839   my $sth = dbh->prepare($total_sql);
 840   $sth->execute or die "failed to execute churn query: " . $sth->errstr;
 841
 842   $self->{_interval}{$speriod} = $sth->fetchrow_hashref;
 843 }
 844
 845 sub in_time_period_and_agent {
 846   my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4);
 847   my $col = @_ ? shift() : '_date';
 848
 849   my $sql = "$col >= $speriod AND $col < $eperiod";
 850
 851   #agent selection
 852   $sql .= " AND cust_main.agentnum = $agentnum"
 853     if $agentnum;
 854
 855   #agent virtualization
 856   $sql .= ' AND '.
 857           $FS::CurrentUser::CurrentUser->agentnums_sql( 'table'=>'cust_main' );
 858
 859   $sql;
 860 }
 861
 862 sub for_opts {
 863     my ( $self, %opt ) = @_;
 864     my $sql = '';
 865     if ( $opt{'custnum'} =~ /^(\d+)$/ ) {
 866       $sql .= " and custnum = $1 ";
 867     }
 868     if ( $opt{'refnum'} ) {
 869       my $refnum = $opt{'refnum'};
 870       $refnum = [ $refnum ] if !ref($refnum);
 871       my $in = join(',', grep /^\d+$/, @$refnum);
 872       $sql .= " and refnum IN ($in)" if length $in;
 873     }
 874     if ( my $where = $self->with_cust_classnum(%opt) ) {
 875       $sql .= " and $where";
 876     }
 877
 878     $sql;
 879 }
 880
 881 sub with_classnum {
 882   my ($self, $classnum, $use_override) = @_;
 883   return '' if $classnum eq '';
 884
 885   $classnum = [ $classnum ] if !ref($classnum);
 886   @$classnum = grep /^\d+$/, @$classnum;
 887   my $in = 'IN ('. join(',', @$classnum). ')';
 888
 889   if ( $use_override ) {
 890     # then include packages if their base package is in the set and they are
 891     # not overridden,
 892     # or if they are overridden and their override package is in the set,
 893     # or fees if they are in the set
 894     return "(
 895          ( COALESCE(part_pkg.classnum, 0) $in AND cust_pkg.pkgpart IS NOT NULL AND pkgpart_override IS NULL )
 896       OR ( COALESCE(override.classnum, 0) $in AND pkgpart_override IS NOT NULL )
 897       OR ( COALESCE(part_fee.classnum, 0) $in AND cust_bill_pkg.feepart IS NOT NULL )
 898     )";
 899   } else {
 900     # include packages if their base package is in the set,
 901     # or fees if they are in the set
 902     return "(
 903          ( COALESCE(part_pkg.classnum, 0) $in AND cust_pkg.pkgpart IS NOT NULL )
 904       OR ( COALESCE(part_fee.classnum, 0) $in AND cust_bill_pkg.feepart IS NOT NULL )
 905     )";
 906   }
 907 }
 908
 909 sub with_usageclass {
 910   my $self = shift;
 911   my ($classnum, $use_override) = @_;
 912   return '' unless $classnum =~ /^\d+$/;
 913   my $comparison;
 914   if ( $classnum == 0 ) {
 915     $comparison = 'IS NULL';
 916   }
 917   else {
 918     $comparison = "= $classnum";
 919   }
 920   return "cust_bill_pkg_detail.classnum $comparison";
 921 }
 922
 923 sub with_report_option {
 924   my ($self, %opt) = @_;
 925   # %opt can contain:
 926   # - report_optionnum: a comma-separated list of numbers.  Zero means to
 927   #   include packages with _no_ report classes.
 928   # - not_report_optionnum: a comma-separated list.  Packages that have
 929   #   any of these report options will be excluded from the result.
 930   #   Zero does nothing.
 931   # - use_override: also matches line items that are add-ons to a package
 932   #   matching the report class.
 933   # - all_report_options: returns only packages that have ALL of the
 934   #   report classes listed in $num.  Otherwise, will return packages that
 935   #   have ANY of those classes.
 936
 937   my @num = ref($opt{'report_optionnum'})
 938                   ? @{ $opt{'report_optionnum'} }
 939                   : split(/\s*,\s*/, $opt{'report_optionnum'});
 940   my @not_num = ref($opt{'not_report_optionnum'})
 941                       ? @{ $opt{'not_report_optionnum'} }
 942                       : split(/\s*,\s*/, $opt{'not_report_optionnum'});
 943   my $null;
 944   $null = 1 if ( grep {$_ == 0} @num );
 945   @num = grep {$_ > 0} @num;
 946   @not_num = grep {$_ > 0} @not_num;
 947
 948   # brute force
 949   my $table = $opt{'use_override'} ? 'override' : 'part_pkg';
 950   my $op = ' OR ';
 951   if ( $opt{'all_report_options'} ) {
 952     if ( @num and $null ) {
 953       return 'false'; # mutually exclusive criteria, so just bail out
 954     }
 955     $op = ' AND ';
 956   }
 957   my @where_num = map {
 958     "EXISTS(SELECT 1 FROM part_pkg_option ".
 959     "WHERE optionname = 'report_option_$_' ".
 960     "AND part_pkg_option.pkgpart = $table.pkgpart)"
 961   } @num;
 962   if ( $null ) {
 963     push @where_num, "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
 964                      "WHERE optionname LIKE 'report_option_%' ".
 965                      "AND part_pkg_option.pkgpart = $table.pkgpart)";
 966   }
 967   my @where_not_num = map {
 968     "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
 969     "WHERE optionname = 'report_option_$_' ".
 970     "AND part_pkg_option.pkgpart = $table.pkgpart)"
 971   } @not_num;
 972
 973   my @where;
 974   if (@where_num) {
 975     push @where, '( '.join($op, @where_num).' )';
 976   }
 977   if (@where_not_num) {
 978     push @where, '( '.join(' AND ', @where_not_num).' )';
 979   }
 980
 981   return @where;
 982   # this messes up totals
 983   #if ( $opt{'use_override'} ) {
 984   #  # then also allow the non-override package to match
 985   #  delete $opt{'use_override'};
 986   #  $comparison = "( $comparison OR " . $self->with_report_option(%opt) . ")";
 987   #}
 988
 989 }
 990
 991 sub with_refnum {
 992   my ($self, %opt) = @_;
 993   if ( $opt{'refnum'} ) {
 994     my $refnum = $opt{'refnum'};
 995     $refnum = [ $refnum ] if !ref($refnum);
 996     my $in = join(',', grep /^\d+$/, @$refnum);
 997     return "cust_main.refnum IN ($in)" if length $in;
 998   }
 999   return;
1000 }
1001
1002 sub with_towernum {
1003   my ($self, %opt) = @_;
1004   if ( $opt{'towernum'} ) {
1005     my $towernum = $opt{'towernum'};
1006     $towernum = [ $towernum ] if !ref($towernum);
1007     my $in = join(',', grep /^\d+$/, @$towernum);
1008     return unless length($in); # if no towers are specified, don't restrict
1009
1010     # materialize/cache the set of pkgnums that, as of the last
1011     # svc_broadband history record, had a certain towernum
1012     # (because otherwise this is painfully slow)
1013     $self->_init_tower_pkg_cache;
1014
1015     return "EXISTS(
1016             SELECT 1 FROM tower_pkg_cache
1017               WHERE towernum IN($in)
1018               AND cust_pkg.pkgnum = tower_pkg_cache.pkgnum
1019             )";
1020   }
1021   return;
1022 }
1023
1024 sub with_zip {
1025   my ($self, %opt) = @_;
1026   if (length($opt{'zip'})) {
1027     return "(SELECT zip FROM cust_location
1028              WHERE cust_location.locationnum = cust_pkg.locationnum
1029             ) = " . dbh->quote($opt{'zip'});
1030   }
1031   return;
1032 }
1033
1034 sub with_cust_classnum {
1035   my ($self, %opt) = @_;
1036   if ( $opt{'cust_classnum'} ) {
1037     my $classnums = $opt{'cust_classnum'};
1038     $classnums = [ $classnums ] if !ref($classnums);
1039     @$classnums = grep /^\d+$/, @$classnums;
1040     return 'cust_main.classnum in('. join(',',@$classnums) .')'
1041       if @$classnums;
1042   }
1043   return;
1044 }
1045
1046
1047 sub scalar_sql {
1048   my( $self, $sql ) = ( shift, shift );
1049   my $sth = dbh->prepare($sql) or die dbh->errstr;
1050   warn "FS::Report::Table\n$sql\n" if $DEBUG;
1051   $sth->execute
1052     or die "Unexpected error executing statement $sql: ". $sth->errstr;
1053   $sth->fetchrow_arrayref->[0] || 0;
1054 }
1055
1056 =back
1057
1058 =head1 METHODS
1059
1060 =over 4
1061
1062 =item init_projection
1063
1064 Sets up for future projection of all observables on the report.  Currently
1065 this is limited to 'cust_bill_pkg'.
1066
1067 =cut
1068
1069 sub init_projection {
1070   # this is weird special case stuff--some redesign may be needed
1071   # to use it for anything else
1072   my $self = shift;
1073
1074   if ( driver_name ne 'Pg' ) {
1075     # also database-specific for now
1076     die "projection reports not supported on this platform";
1077   }
1078
1079   my %items = map {$_ => 1} @{ $self->{items} };
1080   if ($items{'cust_bill_pkg'}) {
1081     my $dbh = dbh;
1082     # v_ for 'virtual'
1083     my @sql = (
1084       # could use TEMPORARY TABLE but we're already transaction-protected
1085       'DROP TABLE IF EXISTS v_cust_bill_pkg',
1086       'CREATE TABLE v_cust_bill_pkg ' .
1087        '(LIKE cust_bill_pkg,
1088           usage numeric(10,2), _date integer, expire integer)',
1089       # XXX this should be smart enough to take only the ones with
1090       # sdate/edate overlapping the ROI, for performance
1091       "INSERT INTO v_cust_bill_pkg (
1092         SELECT cust_bill_pkg.*,
1093           (SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
1094           FROM cust_bill_pkg_detail
1095           WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum),
1096           cust_bill._date,
1097           cust_pkg.expire
1098         FROM cust_bill_pkg $cust_bill_pkg_join
1099       )",
1100     );
1101     foreach my $sql (@sql) {
1102       warn "[init_projection] $sql\n" if $DEBUG;
1103       $dbh->do($sql) or die $dbh->errstr;
1104     }
1105   }
1106 }
1107
1108 =item extend_projection START END
1109
1110 Generates data for the next period of projection.  This will be called
1111 for sequential periods where the END of one equals the START of the next
1112 (with no gaps).
1113
1114 =cut
1115
1116 sub extend_projection {
1117   my $self = shift;
1118   my ($speriod, $eperiod) = @_;
1119   my %items = map {$_ => 1} @{ $self->{items} };
1120   if ($items{'cust_bill_pkg'}) {
1121     # What we do here:
1122     # Find all line items that end after the start of the period (and have
1123     # recurring fees, and don't expire before they end).  Choose the latest
1124     # one for each package.  If it ends before the end of the period, copy
1125     # it forward by one billing period.
1126     # Repeat this until the latest line item for each package no longer ends
1127     # within the period.  This is certain to happen in finitely many
1128     # iterations as long as freq > 0.
1129     # - Pg only, obviously.
1130     # - Gives bad results if freq_override is used.
1131     my @fields = ( FS::cust_bill_pkg->fields, qw( usage _date expire ) );
1132     my $insert_fields = join(',', @fields);
1133     my $add_freq = sub { # emulate FS::part_pkg::add_freq
1134       my $field = shift;
1135       "EXTRACT( EPOCH FROM TO_TIMESTAMP($field) + (CASE WHEN freq ~ E'\\\\D' ".
1136       "THEN freq ELSE freq || 'mon' END)::INTERVAL) AS $field";
1137     };
1138     foreach (@fields) {
1139       if ($_ eq 'edate') {
1140         $_ = $add_freq->('edate');
1141       }
1142       elsif ($_ eq 'sdate') {
1143         $_ = 'edate AS sdate'
1144       }
1145       elsif ($_ eq 'setup') {
1146         $_ = '0 AS setup' #because recurring only
1147       }
1148       elsif ($_ eq '_date') {
1149         $_ = $add_freq->('_date');
1150       }
1151     }
1152     my $select_fields = join(',', @fields);
1153     my $dbh = dbh;
1154     my $sql =
1155     # Subquery here because we need to DISTINCT the whole set, select the
1156     # latest charge per pkgnum, and _then_ check edate < $eperiod
1157     # and edate < expire.
1158       "INSERT INTO v_cust_bill_pkg ($insert_fields)
1159         SELECT $select_fields FROM (
1160           SELECT DISTINCT ON (pkgnum) * FROM v_cust_bill_pkg
1161             WHERE edate >= $speriod
1162               AND recur > 0
1163               AND freq IS NOT NULL
1164               AND freq != '0'
1165             ORDER BY pkgnum, edate DESC
1166           ) AS v1
1167           WHERE edate < $eperiod AND (edate < expire OR expire IS NULL)";
1168     my $rows;
1169     do {
1170       warn "[extend_projection] $sql\n" if $DEBUG;
1171       $rows = $dbh->do($sql) or die $dbh->errstr;
1172       warn "[extend_projection] $rows rows\n" if $DEBUG;
1173     } until $rows == 0;
1174   }
1175 }
1176
1177 =item _init_tower_pkg_cache
1178
1179 Internal method: creates a temporary table relating pkgnums to towernums.
1180 A (pkgnum, towernum) record indicates that this package once had a
1181 svc_broadband service which, as of its last insert or replace_new history
1182 record, had a sectornum associated with that towernum.
1183
1184 This is expensive, so it won't be done more than once an hour. Historical
1185 data about package churn shouldn't be changing in realtime anyway.
1186
1187 =cut
1188
1189 sub _init_tower_pkg_cache {
1190   my $self = shift;
1191   my $dbh = dbh;
1192
1193   my $current = $CACHE->get('tower_pkg_cache_update');
1194   return if $current;
1195
1196   # XXX or should this be in the schema?
1197   my $sql = "DROP TABLE IF EXISTS tower_pkg_cache";
1198   $dbh->do($sql) or die $dbh->errstr;
1199   $sql = "CREATE TABLE tower_pkg_cache (towernum int, pkgnum int)";
1200   $dbh->do($sql) or die $dbh->errstr;
1201
1202   # assumptions:
1203   # sectornums never get reused, or move from one tower to another
1204   # all service history is intact
1205   # svcnums never get reused (this would be bad)
1206   # pkgnums NEVER get reused (this would be extremely bad)
1207   $sql = "INSERT INTO tower_pkg_cache (
1208     SELECT COALESCE(towernum,0), pkgnum
1209     FROM ( SELECT DISTINCT pkgnum, svcnum FROM h_cust_svc ) AS pkgnum_svcnum
1210     LEFT JOIN (
1211       SELECT DISTINCT ON(svcnum) svcnum, sectornum
1212         FROM h_svc_broadband
1213         WHERE (history_action = 'replace_new'
1214                OR history_action = 'replace_old')
1215         ORDER BY svcnum ASC, history_date DESC
1216     ) AS svcnum_sectornum USING (svcnum)
1217     LEFT JOIN tower_sector USING (sectornum)
1218   )";
1219   $dbh->do($sql) or die $dbh->errstr;
1220
1221   $CACHE->set('tower_pkg_cache_update', 1, 3600);
1222
1223 };
1224
1225 =head1 BUGS
1226
1227 Documentation.
1228
1229 =head1 SEE ALSO
1230
1231 L<FS::Report::Table::Monthly>, reports in the web interface.
1232
1233 =cut
1234
1235 1;