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