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   my $expr = "
 890          ( COALESCE(part_pkg.classnum, 0) $in AND pkgpart_override IS NULL)
 891       OR ( COALESCE(part_fee.classnum, 0) $in AND feepart IS NOT NULL )";
 892   if ( $use_override ) {
 893     $expr .= "
 894       OR ( COALESCE(override.classnum, 0) $in AND pkgpart_override IS NOT NULL )";
 895   }
 896   "( $expr )";
 897 }
 898
 899 sub with_usageclass {
 900   my $self = shift;
 901   my ($classnum, $use_override) = @_;
 902   return '' unless $classnum =~ /^\d+$/;
 903   my $comparison;
 904   if ( $classnum == 0 ) {
 905     $comparison = 'IS NULL';
 906   }
 907   else {
 908     $comparison = "= $classnum";
 909   }
 910   return "cust_bill_pkg_detail.classnum $comparison";
 911 }
 912
 913 sub with_report_option {
 914   my ($self, %opt) = @_;
 915   # %opt can contain:
 916   # - report_optionnum: a comma-separated list of numbers.  Zero means to
 917   #   include packages with _no_ report classes.
 918   # - not_report_optionnum: a comma-separated list.  Packages that have
 919   #   any of these report options will be excluded from the result.
 920   #   Zero does nothing.
 921   # - use_override: also matches line items that are add-ons to a package
 922   #   matching the report class.
 923   # - all_report_options: returns only packages that have ALL of the
 924   #   report classes listed in $num.  Otherwise, will return packages that
 925   #   have ANY of those classes.
 926
 927   my @num = ref($opt{'report_optionnum'})
 928                   ? @{ $opt{'report_optionnum'} }
 929                   : split(/\s*,\s*/, $opt{'report_optionnum'});
 930   my @not_num = ref($opt{'not_report_optionnum'})
 931                       ? @{ $opt{'not_report_optionnum'} }
 932                       : split(/\s*,\s*/, $opt{'not_report_optionnum'});
 933   my $null;
 934   $null = 1 if ( grep {$_ == 0} @num );
 935   @num = grep {$_ > 0} @num;
 936   @not_num = grep {$_ > 0} @not_num;
 937
 938   # brute force
 939   my $table = $opt{'use_override'} ? 'override' : 'part_pkg';
 940   my $op = ' OR ';
 941   if ( $opt{'all_report_options'} ) {
 942     if ( @num and $null ) {
 943       return 'false'; # mutually exclusive criteria, so just bail out
 944     }
 945     $op = ' AND ';
 946   }
 947   my @where_num = map {
 948     "EXISTS(SELECT 1 FROM part_pkg_option ".
 949     "WHERE optionname = 'report_option_$_' ".
 950     "AND part_pkg_option.pkgpart = $table.pkgpart)"
 951   } @num;
 952   if ( $null ) {
 953     push @where_num, "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
 954                      "WHERE optionname LIKE 'report_option_%' ".
 955                      "AND part_pkg_option.pkgpart = $table.pkgpart)";
 956   }
 957   my @where_not_num = map {
 958     "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
 959     "WHERE optionname = 'report_option_$_' ".
 960     "AND part_pkg_option.pkgpart = $table.pkgpart)"
 961   } @not_num;
 962
 963   my @where;
 964   if (@where_num) {
 965     push @where, '( '.join($op, @where_num).' )';
 966   }
 967   if (@where_not_num) {
 968     push @where, '( '.join(' AND ', @where_not_num).' )';
 969   }
 970
 971   return @where;
 972   # this messes up totals
 973   #if ( $opt{'use_override'} ) {
 974   #  # then also allow the non-override package to match
 975   #  delete $opt{'use_override'};
 976   #  $comparison = "( $comparison OR " . $self->with_report_option(%opt) . ")";
 977   #}
 978
 979 }
 980
 981 sub with_refnum {
 982   my ($self, %opt) = @_;
 983   if ( $opt{'refnum'} ) {
 984     my $refnum = $opt{'refnum'};
 985     $refnum = [ $refnum ] if !ref($refnum);
 986     my $in = join(',', grep /^\d+$/, @$refnum);
 987     return "cust_main.refnum IN ($in)" if length $in;
 988   }
 989   return;
 990 }
 991
 992 sub with_towernum {
 993   my ($self, %opt) = @_;
 994   if ( $opt{'towernum'} ) {
 995     my $towernum = $opt{'towernum'};
 996     $towernum = [ $towernum ] if !ref($towernum);
 997     my $in = join(',', grep /^\d+$/, @$towernum);
 998     return unless length($in); # if no towers are specified, don't restrict
 999
1000     # materialize/cache the set of pkgnums that, as of the last
1001     # svc_broadband history record, had a certain towernum
1002     # (because otherwise this is painfully slow)
1003     $self->_init_tower_pkg_cache;
1004
1005     return "EXISTS(
1006             SELECT 1 FROM tower_pkg_cache
1007               WHERE towernum IN($in)
1008               AND cust_pkg.pkgnum = tower_pkg_cache.pkgnum
1009             )";
1010   }
1011   return;
1012 }
1013
1014 sub with_zip {
1015   my ($self, %opt) = @_;
1016   if (length($opt{'zip'})) {
1017     return "(SELECT zip FROM cust_location
1018              WHERE cust_location.locationnum = cust_pkg.locationnum
1019             ) = " . dbh->quote($opt{'zip'});
1020   }
1021   return;
1022 }
1023
1024 sub with_cust_classnum {
1025   my ($self, %opt) = @_;
1026   if ( $opt{'cust_classnum'} ) {
1027     my $classnums = $opt{'cust_classnum'};
1028     $classnums = [ $classnums ] if !ref($classnums);
1029     @$classnums = grep /^\d+$/, @$classnums;
1030     return 'cust_main.classnum in('. join(',',@$classnums) .')'
1031       if @$classnums;
1032   }
1033   return;
1034 }
1035
1036
1037 sub scalar_sql {
1038   my( $self, $sql ) = ( shift, shift );
1039   my $sth = dbh->prepare($sql) or die dbh->errstr;
1040   warn "FS::Report::Table\n$sql\n" if $DEBUG;
1041   $sth->execute
1042     or die "Unexpected error executing statement $sql: ". $sth->errstr;
1043   $sth->fetchrow_arrayref->[0] || 0;
1044 }
1045
1046 =back
1047
1048 =head1 METHODS
1049
1050 =over 4
1051
1052 =item init_projection
1053
1054 Sets up for future projection of all observables on the report.  Currently
1055 this is limited to 'cust_bill_pkg'.
1056
1057 =cut
1058
1059 sub init_projection {
1060   # this is weird special case stuff--some redesign may be needed
1061   # to use it for anything else
1062   my $self = shift;
1063
1064   if ( driver_name ne 'Pg' ) {
1065     # also database-specific for now
1066     die "projection reports not supported on this platform";
1067   }
1068
1069   my %items = map {$_ => 1} @{ $self->{items} };
1070   if ($items{'cust_bill_pkg'}) {
1071     my $dbh = dbh;
1072     # v_ for 'virtual'
1073     my @sql = (
1074       # could use TEMPORARY TABLE but we're already transaction-protected
1075       'DROP TABLE IF EXISTS v_cust_bill_pkg',
1076       'CREATE TABLE v_cust_bill_pkg ' .
1077        '(LIKE cust_bill_pkg,
1078           usage numeric(10,2), _date integer, expire integer)',
1079       # XXX this should be smart enough to take only the ones with
1080       # sdate/edate overlapping the ROI, for performance
1081       "INSERT INTO v_cust_bill_pkg (
1082         SELECT cust_bill_pkg.*,
1083           (SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
1084           FROM cust_bill_pkg_detail
1085           WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum),
1086           cust_bill._date,
1087           cust_pkg.expire
1088         FROM cust_bill_pkg $cust_bill_pkg_join
1089       )",
1090     );
1091     foreach my $sql (@sql) {
1092       warn "[init_projection] $sql\n" if $DEBUG;
1093       $dbh->do($sql) or die $dbh->errstr;
1094     }
1095   }
1096 }
1097
1098 =item extend_projection START END
1099
1100 Generates data for the next period of projection.  This will be called
1101 for sequential periods where the END of one equals the START of the next
1102 (with no gaps).
1103
1104 =cut
1105
1106 sub extend_projection {
1107   my $self = shift;
1108   my ($speriod, $eperiod) = @_;
1109   my %items = map {$_ => 1} @{ $self->{items} };
1110   if ($items{'cust_bill_pkg'}) {
1111     # What we do here:
1112     # Find all line items that end after the start of the period (and have
1113     # recurring fees, and don't expire before they end).  Choose the latest
1114     # one for each package.  If it ends before the end of the period, copy
1115     # it forward by one billing period.
1116     # Repeat this until the latest line item for each package no longer ends
1117     # within the period.  This is certain to happen in finitely many
1118     # iterations as long as freq > 0.
1119     # - Pg only, obviously.
1120     # - Gives bad results if freq_override is used.
1121     my @fields = ( FS::cust_bill_pkg->fields, qw( usage _date expire ) );
1122     my $insert_fields = join(',', @fields);
1123     my $add_freq = sub { # emulate FS::part_pkg::add_freq
1124       my $field = shift;
1125       "EXTRACT( EPOCH FROM TO_TIMESTAMP($field) + (CASE WHEN freq ~ E'\\\\D' ".
1126       "THEN freq ELSE freq || 'mon' END)::INTERVAL) AS $field";
1127     };
1128     foreach (@fields) {
1129       if ($_ eq 'edate') {
1130         $_ = $add_freq->('edate');
1131       }
1132       elsif ($_ eq 'sdate') {
1133         $_ = 'edate AS sdate'
1134       }
1135       elsif ($_ eq 'setup') {
1136         $_ = '0 AS setup' #because recurring only
1137       }
1138       elsif ($_ eq '_date') {
1139         $_ = $add_freq->('_date');
1140       }
1141     }
1142     my $select_fields = join(',', @fields);
1143     my $dbh = dbh;
1144     my $sql =
1145     # Subquery here because we need to DISTINCT the whole set, select the
1146     # latest charge per pkgnum, and _then_ check edate < $eperiod
1147     # and edate < expire.
1148       "INSERT INTO v_cust_bill_pkg ($insert_fields)
1149         SELECT $select_fields FROM (
1150           SELECT DISTINCT ON (pkgnum) * FROM v_cust_bill_pkg
1151             WHERE edate >= $speriod
1152               AND recur > 0
1153               AND freq IS NOT NULL
1154               AND freq != '0'
1155             ORDER BY pkgnum, edate DESC
1156           ) AS v1
1157           WHERE edate < $eperiod AND (edate < expire OR expire IS NULL)";
1158     my $rows;
1159     do {
1160       warn "[extend_projection] $sql\n" if $DEBUG;
1161       $rows = $dbh->do($sql) or die $dbh->errstr;
1162       warn "[extend_projection] $rows rows\n" if $DEBUG;
1163     } until $rows == 0;
1164   }
1165 }
1166
1167 =item _init_tower_pkg_cache
1168
1169 Internal method: creates a temporary table relating pkgnums to towernums.
1170 A (pkgnum, towernum) record indicates that this package once had a
1171 svc_broadband service which, as of its last insert or replace_new history
1172 record, had a sectornum associated with that towernum.
1173
1174 This is expensive, so it won't be done more than once an hour. Historical
1175 data about package churn shouldn't be changing in realtime anyway.
1176
1177 =cut
1178
1179 sub _init_tower_pkg_cache {
1180   my $self = shift;
1181   my $dbh = dbh;
1182
1183   my $current = $CACHE->get('tower_pkg_cache_update');
1184   return if $current;
1185
1186   # XXX or should this be in the schema?
1187   my $sql = "DROP TABLE IF EXISTS tower_pkg_cache";
1188   $dbh->do($sql) or die $dbh->errstr;
1189   $sql = "CREATE TABLE tower_pkg_cache (towernum int, pkgnum int)";
1190   $dbh->do($sql) or die $dbh->errstr;
1191
1192   # assumptions:
1193   # sectornums never get reused, or move from one tower to another
1194   # all service history is intact
1195   # svcnums never get reused (this would be bad)
1196   # pkgnums NEVER get reused (this would be extremely bad)
1197   $sql = "INSERT INTO tower_pkg_cache (
1198     SELECT COALESCE(towernum,0), pkgnum
1199     FROM ( SELECT DISTINCT pkgnum, svcnum FROM h_cust_svc ) AS pkgnum_svcnum
1200     LEFT JOIN (
1201       SELECT DISTINCT ON(svcnum) svcnum, sectornum
1202         FROM h_svc_broadband
1203         WHERE (history_action = 'replace_new'
1204                OR history_action = 'replace_old')
1205         ORDER BY svcnum ASC, history_date DESC
1206     ) AS svcnum_sectornum USING (svcnum)
1207     LEFT JOIN tower_sector USING (sectornum)
1208   )";
1209   $dbh->do($sql) or die $dbh->errstr;
1210
1211   $CACHE->set('tower_pkg_cache_update', 1, 3600);
1212
1213 };
1214
1215 =head1 BUGS
1216
1217 Documentation.
1218
1219 =head1 SEE ALSO
1220
1221 L<FS::Report::Table::Monthly>, reports in the web interface.
1222
1223 =cut
1224
1225 1;