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 =item discounted: The sum of discounts on invoices in the period.
 270
 271 =cut
 272
 273 sub discounted {
 274   my( $self, $speriod, $eperiod, $agentnum, %opt) = @_;
 275   $self->scalar_sql('SELECT SUM(cust_bill_pkg_discount.amount)
 276     FROM cust_bill_pkg_discount
 277       JOIN cust_bill_pkg USING  ( billpkgnum )
 278       JOIN cust_bill     USING  ( invnum )
 279       JOIN cust_main     USING  ( custnum )
 280     WHERE '. $self->in_time_period_and_agent( $speriod,
 281                                               $eperiod,
 282                                               $agentnum,
 283                                               'cust_bill._date'
 284                                             ).
 285               $self->for_opts(%opt)
 286   );
 287 }
 288
 289 =item gross: invoiced + discounted
 290
 291 =cut
 292
 293 sub gross {
 294   my( $self, $speriod, $eperiod, $agentnum, %opt) = @_;
 295     $self->invoiced(   $speriod, $eperiod, $agentnum, %opt)
 296   + $self->discounted( $speriod, $eperiod, $agentnum, %opt);
 297 }
 298
 299 #XXX docs
 300
 301 #these should be auto-generated or $AUTOLOADed or something
 302 sub invoiced_12mo {
 303   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 304   $speriod = $self->_subtract_11mo($speriod);
 305   $self->invoiced($speriod, $eperiod, $agentnum);
 306 }
 307
 308 sub netsales_12mo {
 309   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 310   $speriod = $self->_subtract_11mo($speriod);
 311   $self->netsales($speriod, $eperiod, $agentnum);
 312 }
 313
 314 sub receipts_12mo {
 315   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 316   $speriod = $self->_subtract_11mo($speriod);
 317   $self->receipts($speriod, $eperiod, $agentnum);
 318 }
 319
 320 sub payments_12mo {
 321   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 322   $speriod = $self->_subtract_11mo($speriod);
 323   $self->payments($speriod, $eperiod, $agentnum);
 324 }
 325
 326 sub credits_12mo {
 327   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 328   $speriod = $self->_subtract_11mo($speriod);
 329   $self->credits($speriod, $eperiod, $agentnum);
 330 }
 331
 332 sub netcredits_12mo {
 333   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 334   $speriod = $self->_subtract_11mo($speriod);
 335   $self->netcredits($speriod, $eperiod, $agentnum);
 336 }
 337
 338 sub cashflow_12mo {
 339   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 340   $speriod = $self->_subtract_11mo($speriod);
 341   $self->cashflow($speriod, $eperiod, $agentnum);
 342 }
 343
 344 sub netcashflow_12mo {
 345   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 346   $speriod = $self->_subtract_11mo($speriod);
 347   $self->cashflow($speriod, $eperiod, $agentnum);
 348 }
 349
 350 sub refunds_12mo {
 351   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 352   $speriod = $self->_subtract_11mo($speriod);
 353   $self->refunds($speriod, $eperiod, $agentnum);
 354 }
 355
 356 sub netrefunds_12mo {
 357   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 358   $speriod = $self->_subtract_11mo($speriod);
 359   $self->netrefunds($speriod, $eperiod, $agentnum);
 360 }
 361
 362
 363 #not being too bad with the false laziness
 364 sub _subtract_11mo {
 365   my($self, $time) = @_;
 366   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
 367   $mon -= 11;
 368   if ( $mon < 0 ) { $mon+=12; $year--; }
 369   timelocal($sec,$min,$hour,$mday,$mon,$year);
 370 }
 371
 372 =item cust_pkg_setup_cost: The total setup costs of packages setup in the period
 373
 374 'classnum': limit to this package class.
 375
 376 =cut
 377
 378 sub cust_pkg_setup_cost {
 379   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 380   my $where = '';
 381
 382   if ( $opt{'classnum'} ne '' ) {
 383     my $classnums = $opt{'classnum'};
 384     $classnums = [ $classnums ] if !ref($classnums);
 385     @$classnums = grep /^\d+$/, @$classnums;
 386     $where .= ' AND COALESCE(part_pkg.classnum,0) IN ('. join(',', @$classnums).
 387                                                     ')';
 388   }
 389
 390   $agentnum ||= $opt{'agentnum'};
 391
 392   my $total_sql = " SELECT SUM(part_pkg.setup_cost) ";
 393   $total_sql .= " FROM cust_pkg
 394              LEFT JOIN cust_main USING ( custnum )
 395              LEFT JOIN part_pkg  USING ( pkgpart )
 396                   WHERE pkgnum != 0
 397                   $where
 398                   AND ".$self->in_time_period_and_agent(
 399                     $speriod, $eperiod, $agentnum, 'cust_pkg.setup');
 400   return $self->scalar_sql($total_sql);
 401 }
 402
 403 =item cust_pkg_recur_cust: the total recur costs of packages in the period
 404
 405 'classnum': limit to this package class.
 406
 407 =cut
 408
 409 sub cust_pkg_recur_cost {
 410   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 411   my $where = '';
 412
 413   if ( $opt{'classnum'} ne '' ) {
 414     my $classnums = $opt{'classnum'};
 415     $classnums = [ $classnums ] if !ref($classnums);
 416     @$classnums = grep /^\d+$/, @$classnums;
 417     $where .= ' AND COALESCE(part_pkg.classnum,0) IN ('. join(',', @$classnums).
 418                                                     ')';
 419   }
 420
 421   $agentnum ||= $opt{'agentnum'};
 422   # duplication of in_time_period_and_agent
 423   # because we do it a little differently here
 424   $where .= " AND cust_main.agentnum = $agentnum" if $agentnum;
 425   $where .= " AND ".
 426           $FS::CurrentUser::CurrentUser->agentnums_sql('table' => 'cust_main');
 427
 428   my $total_sql = " SELECT SUM(part_pkg.recur_cost) ";
 429   $total_sql .= " FROM cust_pkg
 430              LEFT JOIN cust_main USING ( custnum )
 431              LEFT JOIN part_pkg  USING ( pkgpart )
 432                   WHERE pkgnum != 0
 433                   $where
 434                   AND cust_pkg.setup < $eperiod
 435                   AND (cust_pkg.cancel > $speriod OR cust_pkg.cancel IS NULL)
 436                   ";
 437   return $self->scalar_sql($total_sql);
 438 }
 439
 440 =item cust_bill_pkg: the total package charges on invoice line items.
 441
 442 'charges': limit the type of charges included (setup, recur, usage, discount).
 443 Should be a string containing one or more of 'S', 'R', 'U', or 'D'; if
 444 unspecified, defaults to all three.
 445
 446 'classnum': limit to this package class.
 447
 448 'use_override': for line items generated by an add-on package, use the class
 449 of the add-on rather than the base package.
 450
 451 'average_per_cust_pkg': divide the result by the number of distinct packages.
 452
 453 'distribute': for non-monthly recurring charges, ignore the invoice
 454 date.  Instead, consider the line item's starting/ending dates.  Determine
 455 the fraction of the line item duration that falls within the specified
 456 interval and return that fraction of the recurring charges.  This is
 457 somewhat experimental.
 458
 459 'project': enable if this is a projected period.  This is very experimental.
 460
 461 =cut
 462
 463 sub cust_bill_pkg {
 464   my $self = shift;
 465   my( $speriod, $eperiod, $agentnum, %opt ) = @_;
 466
 467   my %charges = map {$_=>1} split('', $opt{'charges'} || 'SRU');
 468
 469   my $sum = 0;
 470   $sum += $self->cust_bill_pkg_setup(@_) if $charges{S};
 471   $sum += $self->cust_bill_pkg_recur(@_) if $charges{R};
 472   $sum += $self->cust_bill_pkg_detail(@_) if $charges{U};
 473   $sum += $self->cust_bill_pkg_discount(@_) if $charges{D};
 474
 475   if ($opt{'average_per_cust_pkg'}) {
 476     my $count = $self->cust_bill_pkg_count_pkgnum(@_);
 477     return '' if $count == 0;
 478     $sum = sprintf('%.2f', $sum / $count);
 479   }
 480   $sum;
 481 }
 482
 483 my $cust_bill_pkg_join = '
 484     LEFT JOIN cust_bill USING ( invnum )
 485     LEFT JOIN cust_main USING ( custnum )
 486     LEFT JOIN cust_pkg USING ( pkgnum )
 487     LEFT JOIN part_pkg USING ( pkgpart )
 488     LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 489     LEFT JOIN part_fee USING ( feepart )';
 490
 491 sub cust_bill_pkg_setup {
 492   my $self = shift;
 493   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 494   # no projecting setup fees--use real invoices only
 495   # but evaluate this anyway, because the design of projection is that
 496   # if there are somehow real setup fees in the future, we want to count
 497   # them
 498
 499   $agentnum ||= $opt{'agentnum'};
 500
 501   my @where = (
 502     '(pkgnum != 0 OR feepart IS NOT NULL)',
 503     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 504     $self->with_report_option(%opt),
 505     $self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
 506     $self->with_refnum(%opt),
 507     $self->with_cust_classnum(%opt)
 508   );
 509
 510   my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0)
 511   FROM cust_bill_pkg
 512   $cust_bill_pkg_join
 513   WHERE " . join(' AND ', grep $_, @where);
 514
 515   $self->scalar_sql($total_sql);
 516 }
 517
 518 sub _cust_bill_pkg_recurring {
 519   # returns the FROM/WHERE part of the statement to query all recurring
 520   # line items in the period
 521   my $self = shift;
 522   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 523
 524   $agentnum ||= $opt{'agentnum'};
 525   my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg';
 526
 527   my @where = (
 528     '(pkgnum != 0 OR feepart IS NOT NULL)',
 529     $self->with_report_option(%opt),
 530     $self->with_refnum(%opt),
 531     $self->with_cust_classnum(%opt)
 532   );
 533
 534   my $where_classnum = $self->with_classnum($opt{'classnum'}, $opt{'use_override'});
 535   if ($opt{'project'}) {
 536     $where_classnum =~ s/\bcust_bill_pkg/v_cust_bill_pkg/g;
 537   }
 538   push @where, $where_classnum;
 539
 540   if ( $opt{'distribute'} ) {
 541     $where[0] = 'pkgnum != 0'; # specifically exclude fees
 542     push @where, "cust_main.agentnum = $agentnum" if $agentnum;
 543     push @where,
 544       "$cust_bill_pkg.sdate <  $eperiod",
 545       "$cust_bill_pkg.edate >= $speriod",
 546     ;
 547   }
 548   else {
 549     # we don't want to have to create v_cust_bill
 550     my $_date = $opt{'project'} ? 'v_cust_bill_pkg._date' : 'cust_bill._date';
 551     push @where,
 552       $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, $_date);
 553   }
 554
 555   return "
 556   FROM $cust_bill_pkg
 557   $cust_bill_pkg_join
 558   WHERE ".join(' AND ', grep $_, @where);
 559
 560 }
 561
 562 sub cust_bill_pkg_recur {
 563   my $self = shift;
 564   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 565
 566   # subtract all usage from the line item regardless of date
 567   my $item_usage;
 568   if ( $opt{'project'} ) {
 569     $item_usage = 'usage'; #already calculated
 570   }
 571   else {
 572     $item_usage = '( SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
 573       FROM cust_bill_pkg_detail
 574       WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum )';
 575   }
 576
 577   my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg';
 578
 579   my $recur_fraction = '';
 580   if ($opt{'distribute'}) {
 581     # the fraction of edate - sdate that's within [speriod, eperiod]
 582     $recur_fraction = " *
 583       CAST(LEAST($eperiod, $cust_bill_pkg.edate) -
 584        GREATEST($speriod, $cust_bill_pkg.sdate) AS DECIMAL) /
 585       ($cust_bill_pkg.edate - $cust_bill_pkg.sdate)";
 586   }
 587
 588   my $total_sql =
 589     "SELECT COALESCE(SUM(($cust_bill_pkg.recur - $item_usage) $recur_fraction),0)" .
 590     $self->_cust_bill_pkg_recurring(@_);
 591
 592   $self->scalar_sql($total_sql);
 593 }
 594
 595 sub cust_bill_pkg_count_pkgnum {
 596   # for ARPU calculation
 597   my $self = shift;
 598   my $total_sql = 'SELECT COUNT(DISTINCT pkgnum) '.
 599     $self->_cust_bill_pkg_recurring(@_);
 600
 601   $self->scalar_sql($total_sql);
 602 }
 603
 604 =item cust_bill_pkg_detail: the total usage charges in detail lines.
 605
 606 Arguments as for C<cust_bill_pkg>, plus:
 607
 608 'usageclass': limit to this usage class number.
 609
 610 =cut
 611
 612 sub cust_bill_pkg_detail {
 613   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 614
 615   my @where =
 616     ( "(cust_bill_pkg.pkgnum != 0 OR cust_bill_pkg.feepart IS NOT NULL)" );
 617
 618   $agentnum ||= $opt{'agentnum'};
 619
 620   push @where,
 621     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 622     $self->with_usageclass($opt{'usageclass'}),
 623     $self->with_report_option(%opt),
 624     $self->with_refnum(%opt),
 625     $self->with_cust_classnum(%opt)
 626     ;
 627
 628   if ( $opt{'distribute'} ) {
 629     # exclude fees
 630     $where[0] = 'cust_bill_pkg.pkgnum != 0';
 631     # and limit according to the usage time, not the billing date
 632     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 633       'cust_bill_pkg_detail.startdate'
 634     );
 635   }
 636   else {
 637     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 638       'cust_bill._date'
 639     );
 640   }
 641
 642   my $total_sql = " SELECT SUM(cust_bill_pkg_detail.amount) ";
 643
 644   $total_sql .=
 645     " FROM cust_bill_pkg_detail
 646         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 647         LEFT JOIN cust_bill ON cust_bill_pkg.invnum = cust_bill.invnum
 648         LEFT JOIN cust_main USING ( custnum )
 649         LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum
 650         LEFT JOIN part_pkg USING ( pkgpart )
 651         LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 652         LEFT JOIN part_fee USING ( feepart )
 653       WHERE ".join( ' AND ', grep $_, @where );
 654
 655   $self->scalar_sql($total_sql);
 656
 657 }
 658
 659 sub cust_bill_pkg_discount {
 660   my $self = shift;
 661   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 662   # apply all the same constraints here as for setup/recur
 663
 664   $agentnum ||= $opt{'agentnum'};
 665
 666   my @where = (
 667     '(pkgnum != 0 OR feepart IS NOT NULL)',
 668     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 669     $self->with_report_option(%opt),
 670     $self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
 671     $self->with_refnum(%opt),
 672     $self->with_cust_classnum(%opt)
 673   );
 674
 675   my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg_discount.amount), 0)
 676   FROM cust_bill_pkg_discount
 677   JOIN cust_bill_pkg USING (billpkgnum)
 678   $cust_bill_pkg_join
 679   WHERE " . join(' AND ', grep $_, @where);
 680
 681   $self->scalar_sql($total_sql);
 682 }
 683
 684 ##### package churn report #####
 685
 686 =item active_pkg: The number of packages that were active at the start of
 687 the period. The end date of the period is ignored. Options:
 688
 689 - refnum: Limit to customers with this advertising source.
 690 - classnum: Limit to packages with this class.
 691 - towernum: Limit to packages that have a broadband service with this tower.
 692 - zip: Limit to packages with this service location zip code.
 693
 694 Except for zip, any of these can be an arrayref to allow multiple values for
 695 the field.
 696
 697 =item setup_pkg: The number of packages with setup dates in the period. This
 698 excludes packages created by package changes. Options are as for active_pkg.
 699
 700 =item susp_pkg: The number of packages that were suspended in the period
 701 (and not canceled).  Options are as for active_pkg.
 702
 703 =item unsusp_pkg: The number of packages that were unsuspended in the period.
 704 Options are as for active_pkg.
 705
 706 =item cancel_pkg: The number of packages with cancel dates in the period.
 707 Excludes packages that were canceled to be changed to a new package. Options
 708 are as for active_pkg.
 709
 710 =cut
 711
 712 sub active_pkg {
 713   my $self = shift;
 714   $self->churn_pkg('active', @_);
 715 }
 716
 717 sub setup_pkg {
 718   my $self = shift;
 719   $self->churn_pkg('setup', @_);
 720 }
 721
 722 sub cancel_pkg {
 723   my $self = shift;
 724   $self->churn_pkg('cancel', @_);
 725 }
 726
 727 sub susp_pkg {
 728   my $self = shift;
 729   $self->churn_pkg('susp', @_);
 730 }
 731
 732 sub unsusp_pkg {
 733   my $self = shift;
 734   $self->churn_pkg('unsusp', @_);
 735 }
 736
 737 sub churn_pkg {
 738   my $self = shift;
 739   my ( $status, $speriod, $eperiod, $agentnum, %opt ) = @_;
 740   my ($from, @where) =
 741     FS::h_cust_pkg->churn_fromwhere_sql( $status, $speriod, $eperiod);
 742
 743   push @where, $self->pkg_where(%opt, 'agentnum' => $agentnum);
 744
 745   my $sql = "SELECT COUNT(*) FROM $from
 746     JOIN part_pkg ON (cust_pkg.pkgpart = part_pkg.pkgpart)
 747     JOIN cust_main ON (cust_pkg.custnum = cust_main.custnum)";
 748   $sql .= ' WHERE '.join(' AND ', @where)
 749     if scalar(@where);
 750
 751   $self->scalar_sql($sql);
 752 }
 753
 754 sub pkg_where {
 755   my $self = shift;
 756   my %opt = @_;
 757   my @where = (
 758     "part_pkg.freq != '0'",
 759     $self->with_refnum(%opt),
 760     $self->with_towernum(%opt),
 761     $self->with_zip(%opt),
 762   );
 763   if ($opt{agentnum} =~ /^(\d+)$/) {
 764     push @where, "cust_main.agentnum = $1";
 765   }
 766   if ($opt{classnum}) {
 767     my $classnum = $opt{classnum};
 768     $classnum = [ $classnum ] if !ref($classnum);
 769     @$classnum = grep /^\d+$/, @$classnum;
 770     my $in = 'IN ('. join(',', @$classnum). ')';
 771     push @where, "COALESCE(part_pkg.classnum, 0) $in" if scalar @$classnum;
 772   }
 773   @where;
 774 }
 775
 776 ##### end of package churn report stuff #####
 777
 778 ##### customer churn report #####
 779
 780 =item active_cust: The number of customers who had any active recurring
 781 packages at the start of the period. The end date is ignored, agentnum is
 782 mandatory, and no other parameters are accepted.
 783
 784 =item started_cust: The number of customers who had no active packages at
 785 the start of the period, but had active packages at the end. Like
 786 active_cust, agentnum is mandatory and no other parameters are accepted.
 787
 788 =item suspended_cust: The number of customers who had active packages at
 789 the start of the period, and at the end had no active packages but some
 790 suspended packages. Note that this does not necessarily mean that their
 791 packages were suspended during the period.
 792
 793 =item resumed_cust: The inverse of suspended_cust: the number of customers
 794 who had suspended packages and no active packages at the start of the
 795 period, and active packages at the end.
 796
 797 =item cancelled_cust: The number of customers who had active packages
 798 at the start of the period, and only cancelled packages at the end.
 799
 800 =cut
 801
 802 sub active_cust {
 803   my $self = shift;
 804   $self->churn_cust(@_)->{active};
 805 }
 806 sub started_cust {
 807   my $self = shift;
 808   $self->churn_cust(@_)->{started};
 809 }
 810 sub suspended_cust {
 811   my $self = shift;
 812   $self->churn_cust(@_)->{suspended};
 813 }
 814 sub resumed_cust {
 815   my $self = shift;
 816   $self->churn_cust(@_)->{resumed};
 817 }
 818 sub cancelled_cust {
 819   my $self = shift;
 820   $self->churn_cust(@_)->{cancelled};
 821 }
 822
 823 sub churn_cust {
 824   my $self = shift;
 825   my ( $speriod ) = @_;
 826
 827   # run one query for each interval
 828   return $self->{_interval}{$speriod} ||= $self->calculate_churn_cust(@_);
 829 }
 830
 831 sub calculate_churn_cust {
 832   my $self = shift;
 833   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 834
 835   my $churn_sql = FS::cust_main::Status->churn_sql($speriod, $eperiod);
 836   my $where = '';
 837   $where = " WHERE cust_main.agentnum = $agentnum " if $agentnum;
 838   my $cust_sql =
 839     "SELECT churn.* ".
 840     "FROM cust_main JOIN ($churn_sql) AS churn USING (custnum)".
 841     $where;
 842
 843   # query to count the ones with certain status combinations
 844   my $total_sql = "
 845     SELECT SUM((s_active > 0)::int)                   as active,
 846            SUM((s_active = 0 and e_active > 0)::int)  as started,
 847            SUM((s_active > 0 and e_active = 0 and e_suspended > 0)::int)
 848                                                       as suspended,
 849            SUM((s_active = 0 and s_suspended > 0 and e_active > 0)::int)
 850                                                       as resumed,
 851            SUM((s_active > 0 and e_active = 0 and e_suspended = 0)::int)
 852                                                       as cancelled
 853     FROM ($cust_sql) AS x
 854   ";
 855
 856   my $sth = dbh->prepare($total_sql);
 857   $sth->execute or die "failed to execute churn query: " . $sth->errstr;
 858
 859   $self->{_interval}{$speriod} = $sth->fetchrow_hashref;
 860 }
 861
 862 sub in_time_period_and_agent {
 863   my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4);
 864   my $col = @_ ? shift() : '_date';
 865
 866   my $sql = "$col >= $speriod AND $col < $eperiod";
 867
 868   #agent selection
 869   $sql .= " AND cust_main.agentnum = $agentnum"
 870     if $agentnum;
 871
 872   #agent virtualization
 873   $sql .= ' AND '.
 874           $FS::CurrentUser::CurrentUser->agentnums_sql( 'table'=>'cust_main' );
 875
 876   $sql;
 877 }
 878
 879 sub for_opts {
 880     my ( $self, %opt ) = @_;
 881     my $sql = '';
 882     if ( $opt{'custnum'} =~ /^(\d+)$/ ) {
 883       $sql .= " and custnum = $1 ";
 884     }
 885     if ( $opt{'refnum'} ) {
 886       my $refnum = $opt{'refnum'};
 887       $refnum = [ $refnum ] if !ref($refnum);
 888       my $in = join(',', grep /^\d+$/, @$refnum);
 889       $sql .= " and refnum IN ($in)" if length $in;
 890     }
 891     if ( my $where = $self->with_cust_classnum(%opt) ) {
 892       $sql .= " and $where";
 893     }
 894
 895     $sql;
 896 }
 897
 898 sub with_classnum {
 899   my ($self, $classnum, $use_override) = @_;
 900   return '' if $classnum eq '';
 901
 902   $classnum = [ $classnum ] if !ref($classnum);
 903   @$classnum = grep /^\d+$/, @$classnum;
 904   return '' if !@$classnum;
 905   my $in = 'IN ('. join(',', @$classnum). ')';
 906
 907   if ( $use_override ) {
 908     # then include packages if their base package is in the set and they are
 909     # not overridden,
 910     # or if they are overridden and their override package is in the set,
 911     # or fees if they are in the set
 912     return "(
 913          ( COALESCE(part_pkg.classnum, 0) $in AND cust_pkg.pkgpart IS NOT NULL AND pkgpart_override IS NULL )
 914       OR ( COALESCE(override.classnum, 0) $in AND pkgpart_override IS NOT NULL )
 915       OR ( COALESCE(part_fee.classnum, 0) $in AND cust_bill_pkg.feepart IS NOT NULL )
 916     )";
 917   } else {
 918     # include packages if their base package is in the set,
 919     # or fees if they are in the set
 920     return "(
 921          ( COALESCE(part_pkg.classnum, 0) $in AND cust_pkg.pkgpart IS NOT NULL )
 922       OR ( COALESCE(part_fee.classnum, 0) $in AND cust_bill_pkg.feepart IS NOT NULL )
 923     )";
 924   }
 925 }
 926
 927 sub with_usageclass {
 928   my $self = shift;
 929   my ($classnum, $use_override) = @_;
 930   return '' unless $classnum =~ /^\d+$/;
 931   my $comparison;
 932   if ( $classnum == 0 ) {
 933     $comparison = 'IS NULL';
 934   }
 935   else {
 936     $comparison = "= $classnum";
 937   }
 938   return "cust_bill_pkg_detail.classnum $comparison";
 939 }
 940
 941 sub with_report_option {
 942   my ($self, %opt) = @_;
 943   # %opt can contain:
 944   # - report_optionnum: a comma-separated list of numbers.  Zero means to
 945   #   include packages with _no_ report classes.
 946   # - not_report_optionnum: a comma-separated list.  Packages that have
 947   #   any of these report options will be excluded from the result.
 948   #   Zero does nothing.
 949   # - use_override: also matches line items that are add-ons to a package
 950   #   matching the report class.
 951   # - all_report_options: returns only packages that have ALL of the
 952   #   report classes listed in $num.  Otherwise, will return packages that
 953   #   have ANY of those classes.
 954
 955   my @num = ref($opt{'report_optionnum'})
 956                   ? @{ $opt{'report_optionnum'} }
 957                   : split(/\s*,\s*/, $opt{'report_optionnum'});
 958   my @not_num = ref($opt{'not_report_optionnum'})
 959                       ? @{ $opt{'not_report_optionnum'} }
 960                       : split(/\s*,\s*/, $opt{'not_report_optionnum'});
 961   my $null;
 962   $null = 1 if ( grep {$_ == 0} @num );
 963   @num = grep {$_ > 0} @num;
 964   @not_num = grep {$_ > 0} @not_num;
 965
 966   # brute force
 967   my $table = $opt{'use_override'} ? 'override' : 'part_pkg';
 968   my $op = ' OR ';
 969   if ( $opt{'all_report_options'} ) {
 970     if ( @num and $null ) {
 971       return 'false'; # mutually exclusive criteria, so just bail out
 972     }
 973     $op = ' AND ';
 974   }
 975   my @where_num = map {
 976     "EXISTS(SELECT 1 FROM part_pkg_option ".
 977     "WHERE optionname = 'report_option_$_' ".
 978     "AND part_pkg_option.pkgpart = $table.pkgpart)"
 979   } @num;
 980   if ( $null ) {
 981     push @where_num, "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
 982                      "WHERE optionname LIKE 'report_option_%' ".
 983                      "AND part_pkg_option.pkgpart = $table.pkgpart)";
 984   }
 985   my @where_not_num = map {
 986     "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
 987     "WHERE optionname = 'report_option_$_' ".
 988     "AND part_pkg_option.pkgpart = $table.pkgpart)"
 989   } @not_num;
 990
 991   my @where;
 992   if (@where_num) {
 993     push @where, '( '.join($op, @where_num).' )';
 994   }
 995   if (@where_not_num) {
 996     push @where, '( '.join(' AND ', @where_not_num).' )';
 997   }
 998
 999   return @where;
1000   # this messes up totals
1001   #if ( $opt{'use_override'} ) {
1002   #  # then also allow the non-override package to match
1003   #  delete $opt{'use_override'};
1004   #  $comparison = "( $comparison OR " . $self->with_report_option(%opt) . ")";
1005   #}
1006
1007 }
1008
1009 sub with_refnum {
1010   my ($self, %opt) = @_;
1011   if ( $opt{'refnum'} ) {
1012     my $refnum = $opt{'refnum'};
1013     $refnum = [ $refnum ] if !ref($refnum);
1014     my $in = join(',', grep /^\d+$/, @$refnum);
1015     return "cust_main.refnum IN ($in)" if length $in;
1016   }
1017   return;
1018 }
1019
1020 sub with_towernum {
1021   my ($self, %opt) = @_;
1022   if ( $opt{'towernum'} ) {
1023     my $towernum = $opt{'towernum'};
1024     $towernum = [ $towernum ] if !ref($towernum);
1025     my $in = join(',', grep /^\d+$/, @$towernum);
1026     return unless length($in); # if no towers are specified, don't restrict
1027
1028     # materialize/cache the set of pkgnums that, as of the last
1029     # svc_broadband history record, had a certain towernum
1030     # (because otherwise this is painfully slow)
1031     $self->_init_tower_pkg_cache;
1032
1033     return "EXISTS(
1034             SELECT 1 FROM tower_pkg_cache
1035               WHERE towernum IN($in)
1036               AND cust_pkg.pkgnum = tower_pkg_cache.pkgnum
1037             )";
1038   }
1039   return;
1040 }
1041
1042 sub with_zip {
1043   my ($self, %opt) = @_;
1044   if (length($opt{'zip'})) {
1045     return "(SELECT zip FROM cust_location
1046              WHERE cust_location.locationnum = cust_pkg.locationnum
1047             ) = " . dbh->quote($opt{'zip'});
1048   }
1049   return;
1050 }
1051
1052 sub with_cust_classnum {
1053   my ($self, %opt) = @_;
1054   if ( $opt{'cust_classnum'} ) {
1055     my $classnums = $opt{'cust_classnum'};
1056     $classnums = [ $classnums ] if !ref($classnums);
1057     @$classnums = grep /^\d+$/, @$classnums;
1058     return 'cust_main.classnum in('. join(',',@$classnums) .')'
1059       if @$classnums;
1060   }
1061   return;
1062 }
1063
1064
1065 sub scalar_sql {
1066   my( $self, $sql ) = ( shift, shift );
1067   my $sth = dbh->prepare($sql) or die dbh->errstr;
1068   warn "FS::Report::Table\n$sql\n" if $DEBUG;
1069   $sth->execute
1070     or die "Unexpected error executing statement $sql: ". $sth->errstr;
1071   $sth->fetchrow_arrayref->[0] || 0;
1072 }
1073
1074 =back
1075
1076 =head1 METHODS
1077
1078 =over 4
1079
1080 =item init_projection
1081
1082 Sets up for future projection of all observables on the report.  Currently
1083 this is limited to 'cust_bill_pkg'.
1084
1085 =cut
1086
1087 sub init_projection {
1088   # this is weird special case stuff--some redesign may be needed
1089   # to use it for anything else
1090   my $self = shift;
1091
1092   if ( driver_name ne 'Pg' ) {
1093     # also database-specific for now
1094     die "projection reports not supported on this platform";
1095   }
1096
1097   my %items = map {$_ => 1} @{ $self->{items} };
1098   if ($items{'cust_bill_pkg'}) {
1099     my $dbh = dbh;
1100     # v_ for 'virtual'
1101     my @sql = (
1102       # could use TEMPORARY TABLE but we're already transaction-protected
1103       'DROP TABLE IF EXISTS v_cust_bill_pkg',
1104       'CREATE TABLE v_cust_bill_pkg ' .
1105        '(LIKE cust_bill_pkg,
1106           usage numeric(10,2), _date integer, expire integer)',
1107       # XXX this should be smart enough to take only the ones with
1108       # sdate/edate overlapping the ROI, for performance
1109       "INSERT INTO v_cust_bill_pkg (
1110         SELECT cust_bill_pkg.*,
1111           (SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
1112           FROM cust_bill_pkg_detail
1113           WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum),
1114           cust_bill._date,
1115           cust_pkg.expire
1116         FROM cust_bill_pkg $cust_bill_pkg_join
1117       )",
1118     );
1119     foreach my $sql (@sql) {
1120       warn "[init_projection] $sql\n" if $DEBUG;
1121       $dbh->do($sql) or die $dbh->errstr;
1122     }
1123   }
1124 }
1125
1126 =item extend_projection START END
1127
1128 Generates data for the next period of projection.  This will be called
1129 for sequential periods where the END of one equals the START of the next
1130 (with no gaps).
1131
1132 =cut
1133
1134 sub extend_projection {
1135   my $self = shift;
1136   my ($speriod, $eperiod) = @_;
1137   my %items = map {$_ => 1} @{ $self->{items} };
1138   if ($items{'cust_bill_pkg'}) {
1139     # What we do here:
1140     # Find all line items that end after the start of the period (and have
1141     # recurring fees, and don't expire before they end).  Choose the latest
1142     # one for each package.  If it ends before the end of the period, copy
1143     # it forward by one billing period.
1144     # Repeat this until the latest line item for each package no longer ends
1145     # within the period.  This is certain to happen in finitely many
1146     # iterations as long as freq > 0.
1147     # - Pg only, obviously.
1148     # - Gives bad results if freq_override is used.
1149     my @fields = ( FS::cust_bill_pkg->fields, qw( usage _date expire ) );
1150     my $insert_fields = join(',', @fields);
1151     my $add_freq = sub { # emulate FS::part_pkg::add_freq
1152       my $field = shift;
1153       "EXTRACT( EPOCH FROM TO_TIMESTAMP($field) + (CASE WHEN freq ~ E'\\\\D' ".
1154       "THEN freq ELSE freq || 'mon' END)::INTERVAL) AS $field";
1155     };
1156     foreach (@fields) {
1157       if ($_ eq 'edate') {
1158         $_ = $add_freq->('edate');
1159       }
1160       elsif ($_ eq 'sdate') {
1161         $_ = 'edate AS sdate'
1162       }
1163       elsif ($_ eq 'setup') {
1164         $_ = '0 AS setup' #because recurring only
1165       }
1166       elsif ($_ eq '_date') {
1167         $_ = $add_freq->('_date');
1168       }
1169     }
1170     my $select_fields = join(',', @fields);
1171     my $dbh = dbh;
1172     my $sql =
1173     # Subquery here because we need to DISTINCT the whole set, select the
1174     # latest charge per pkgnum, and _then_ check edate < $eperiod
1175     # and edate < expire.
1176       "INSERT INTO v_cust_bill_pkg ($insert_fields)
1177         SELECT $select_fields FROM (
1178           SELECT DISTINCT ON (pkgnum) * FROM v_cust_bill_pkg
1179             WHERE edate >= $speriod
1180               AND recur > 0
1181               AND freq IS NOT NULL
1182               AND freq != '0'
1183             ORDER BY pkgnum, edate DESC
1184           ) AS v1
1185           WHERE edate < $eperiod AND (edate < expire OR expire IS NULL)";
1186     my $rows;
1187     do {
1188       warn "[extend_projection] $sql\n" if $DEBUG;
1189       $rows = $dbh->do($sql) or die $dbh->errstr;
1190       warn "[extend_projection] $rows rows\n" if $DEBUG;
1191     } until $rows == 0;
1192   }
1193 }
1194
1195 =item _init_tower_pkg_cache
1196
1197 Internal method: creates a temporary table relating pkgnums to towernums.
1198 A (pkgnum, towernum) record indicates that this package once had a
1199 svc_broadband service which, as of its last insert or replace_new history
1200 record, had a sectornum associated with that towernum.
1201
1202 This is expensive, so it won't be done more than once an hour. Historical
1203 data about package churn shouldn't be changing in realtime anyway.
1204
1205 =cut
1206
1207 sub _init_tower_pkg_cache {
1208   my $self = shift;
1209   my $dbh = dbh;
1210
1211   my $current = $CACHE->get('tower_pkg_cache_update');
1212   return if $current;
1213
1214   # XXX or should this be in the schema?
1215   my $sql = "DROP TABLE IF EXISTS tower_pkg_cache";
1216   $dbh->do($sql) or die $dbh->errstr;
1217   $sql = "CREATE TABLE tower_pkg_cache (towernum int, pkgnum int)";
1218   $dbh->do($sql) or die $dbh->errstr;
1219
1220   # assumptions:
1221   # sectornums never get reused, or move from one tower to another
1222   # all service history is intact
1223   # svcnums never get reused (this would be bad)
1224   # pkgnums NEVER get reused (this would be extremely bad)
1225   $sql = "INSERT INTO tower_pkg_cache (
1226     SELECT COALESCE(towernum,0), pkgnum
1227     FROM ( SELECT DISTINCT pkgnum, svcnum FROM h_cust_svc ) AS pkgnum_svcnum
1228     LEFT JOIN (
1229       SELECT DISTINCT ON(svcnum) svcnum, sectornum
1230         FROM h_svc_broadband
1231         WHERE (history_action = 'replace_new'
1232                OR history_action = 'replace_old')
1233         ORDER BY svcnum ASC, history_date DESC
1234     ) AS svcnum_sectornum USING (svcnum)
1235     LEFT JOIN tower_sector USING (sectornum)
1236   )";
1237   $dbh->do($sql) or die $dbh->errstr;
1238
1239   $CACHE->set('tower_pkg_cache_update', 1, 3600);
1240
1241 };
1242
1243 =head1 BUGS
1244
1245 Documentation.
1246
1247 =head1 SEE ALSO
1248
1249 L<FS::Report::Table::Monthly>, reports in the web interface.
1250
1251 =cut
1252
1253 1;