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