FS/FS/Report/Table.pm

   1 package FS::Report::Table;
   2
   3 use strict;
   4 use base 'FS::Report';
   5 use Time::Local qw( timelocal );
   6 use FS::UID qw( dbh driver_name );
   7 use FS::Report::Table;
   8 use FS::CurrentUser;
   9 use Cache::FileCache;
  10
  11 our $DEBUG = 0; # turning this on will trace all SQL statements, VERY noisy
  12
  13 our $CACHE; # feel free to use this for whatever
  14
  15 FS::UID->install_callback(sub {
  16     $CACHE = Cache::FileCache->new( {
  17       'namespace'   => __PACKAGE__,
  18       'cache_root'  => "$FS::UID::cache_dir/cache.$FS::UID::datasrc",
  19     } );
  20     # reset this on startup (causes problems with database backups, etc.)
  21     $CACHE->remove('tower_pkg_cache_update');
  22 });
  23
  24 =head1 NAME
  25
  26 FS::Report::Table - Tables of report data
  27
  28 =head1 SYNOPSIS
  29
  30 See the more specific report objects, currently only
  31 FS::Report::Table::Monthly and FS::Report::Table::Daily.
  32
  33 =head1 OBSERVABLES
  34
  35 The common interface for an observable named 'foo' is:
  36
  37 $report->foo($startdate, $enddate, $agentnum, %options)
  38
  39 This returns a scalar value for foo, over the period from
  40 $startdate to $enddate, limited to agent $agentnum, subject to
  41 options in %opt.
  42
  43 =over 4
  44
  45 =item signups: The number of customers signed up.  Options are:
  46
  47 - cust_classnum: limit to this customer class
  48 - pkg_classnum: limit to customers with a package of this class.  If this is
  49   an arrayref, it's an ANY match.
  50 - refnum: limit to this advertising source
  51 - indirect: boolean; limit to customers that have a referral_custnum that
  52   matches the advertising source
  53
  54 =cut
  55
  56 sub signups {
  57   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
  58   my @where = ( $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
  59       'cust_main.signupdate')
  60   );
  61   my $join = '';
  62   if ( $opt{'indirect'} ) {
  63     $join = " JOIN cust_main AS referring_cust_main".
  64             " ON (cust_main.referral_custnum = referring_cust_main.custnum)";
  65
  66     if ( $opt{'refnum'} ) {
  67       push @where, "referring_cust_main.refnum = ".$opt{'refnum'};
  68     }
  69   }
  70   elsif ( $opt{'refnum'} ) {
  71     push @where, "refnum = ".$opt{'refnum'};
  72   }
  73
  74   push @where, $self->with_cust_classnum(%opt);
  75   if ( $opt{'pkg_classnum'} ) {
  76     my $classnum = $opt{'pkg_classnum'};
  77     $classnum = [ $classnum ] unless ref $classnum;
  78     @$classnum = grep /^\d+$/, @$classnum;
  79     if (@$classnum) {
  80       my $in = 'IN ('. join(',', @$classnum). ')';
  81       push @where,
  82         "EXISTS(SELECT 1 FROM cust_pkg JOIN part_pkg USING (pkgpart) ".
  83                "WHERE cust_pkg.custnum = cust_main.custnum ".
  84                "AND part_pkg.classnum $in".
  85                ")";
  86     }
  87   }
  88
  89   $self->scalar_sql(
  90     "SELECT COUNT(*) FROM cust_main $join WHERE ".join(' AND ', @where)
  91   );
  92 }
  93
  94 =item invoiced: The total amount charged on all invoices.
  95
  96 =cut
  97
  98 sub invoiced { #invoiced
  99   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 100
 101   my $sql = 'SELECT SUM(cust_bill.charged) FROM cust_bill';
 102   if ( $opt{'setuprecur'} ) {
 103     $sql = 'SELECT SUM('.
 104             FS::cust_bill_pkg->charged_sql($speriod, $eperiod, %opt).
 105            ') FROM cust_bill_pkg JOIN cust_bill USING (invnum)';
 106   }
 107
 108   $self->scalar_sql("
 109       $sql
 110         LEFT JOIN cust_main USING ( custnum )
 111       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 112                $self->for_opts(%opt)
 113   );
 114
 115 }
 116
 117 =item netsales: invoiced - netcredits
 118
 119 =cut
 120
 121 sub netsales { #net sales
 122   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 123
 124     $self->invoiced(  $speriod, $eperiod, $agentnum, %opt)
 125   - $self->netcredits($speriod, $eperiod, $agentnum, %opt);
 126 }
 127
 128 =item cashflow: payments - refunds
 129
 130 =cut
 131
 132 sub cashflow {
 133   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 134
 135     $self->payments($speriod, $eperiod, $agentnum, %opt)
 136   - $self->refunds( $speriod, $eperiod, $agentnum, %opt);
 137 }
 138
 139 =item netcashflow: payments - netrefunds
 140
 141 =cut
 142
 143 sub netcashflow {
 144   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 145
 146     $self->receipts(   $speriod, $eperiod, $agentnum, %opt)
 147   - $self->netrefunds( $speriod, $eperiod, $agentnum, %opt);
 148 }
 149
 150 =item payments: The sum of payments received in the period.
 151
 152 =cut
 153
 154 sub payments {
 155   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 156   $self->scalar_sql("
 157     SELECT SUM(paid)
 158       FROM cust_pay
 159         LEFT JOIN cust_main USING ( custnum )
 160       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 161                $self->for_opts(%opt)
 162   );
 163 }
 164
 165 =item credits: The sum of credits issued in the period.
 166
 167 =cut
 168
 169 sub credits {
 170   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 171   $self->scalar_sql("
 172     SELECT SUM(cust_credit.amount)
 173       FROM cust_credit
 174         LEFT JOIN cust_main USING ( custnum )
 175       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 176                $self->for_opts(%opt)
 177   );
 178 }
 179
 180 =item refunds: The sum of refunds paid in the period.
 181
 182 =cut
 183
 184 sub refunds {
 185   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 186   $self->scalar_sql("
 187     SELECT SUM(refund)
 188       FROM cust_refund
 189         LEFT JOIN cust_main USING ( custnum )
 190       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum).
 191                $self->for_opts(%opt)
 192   );
 193 }
 194
 195 =item netcredits: The sum of credit applications to invoices in the period.
 196
 197 =cut
 198
 199 sub netcredits {
 200   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 201
 202   my $sql = 'SELECT SUM(cust_credit_bill.amount) FROM cust_credit_bill';
 203   if ( $opt{'setuprecur'} ) {
 204     $sql = 'SELECT SUM('.
 205             FS::cust_bill_pkg->credited_sql($speriod, $eperiod, %opt).
 206            ') FROM cust_bill_pkg';
 207   }
 208
 209   $self->scalar_sql("
 210     $sql
 211         LEFT JOIN cust_bill USING ( invnum  )
 212         LEFT JOIN cust_main USING ( custnum )
 213       WHERE ". $self->in_time_period_and_agent( $speriod,
 214                                                 $eperiod,
 215                                                 $agentnum,
 216                                                 'cust_bill._date'
 217                                               ).
 218                $self->for_opts(%opt)
 219   );
 220 }
 221
 222 =item receipts: The sum of payment applications to invoices in the period.
 223
 224 =cut
 225
 226 sub receipts { #net payments
 227   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 228
 229   my $sql = 'SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay';
 230   if ( $opt{'setuprecur'} ) {
 231     $sql = 'SELECT SUM('.
 232             FS::cust_bill_pkg->paid_sql($speriod, $eperiod, %opt).
 233            ') FROM cust_bill_pkg';
 234   }
 235
 236   $self->scalar_sql("
 237     $sql
 238         LEFT JOIN cust_bill USING ( invnum  )
 239         LEFT JOIN cust_main USING ( custnum )
 240       WHERE ". $self->in_time_period_and_agent( $speriod,
 241                                                 $eperiod,
 242                                                 $agentnum,
 243                                                 'cust_bill._date'
 244                                               ).
 245                $self->for_opts(%opt)
 246   );
 247 }
 248
 249 =item netrefunds: The sum of refund applications to credits in the period.
 250
 251 =cut
 252
 253 sub netrefunds {
 254   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 255   $self->scalar_sql("
 256     SELECT SUM(cust_credit_refund.amount)
 257       FROM cust_credit_refund
 258         LEFT JOIN cust_credit USING ( crednum  )
 259         LEFT JOIN cust_main   USING ( custnum )
 260       WHERE ". $self->in_time_period_and_agent( $speriod,
 261                                                 $eperiod,
 262                                                 $agentnum,
 263                                                 'cust_credit._date'
 264                                               ).
 265                $self->for_opts(%opt)
 266   );
 267 }
 268
 269 #XXX docs
 270
 271 #these should be auto-generated or $AUTOLOADed or something
 272 sub invoiced_12mo {
 273   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 274   $speriod = $self->_subtract_11mo($speriod);
 275   $self->invoiced($speriod, $eperiod, $agentnum);
 276 }
 277
 278 sub netsales_12mo {
 279   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 280   $speriod = $self->_subtract_11mo($speriod);
 281   $self->netsales($speriod, $eperiod, $agentnum);
 282 }
 283
 284 sub receipts_12mo {
 285   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 286   $speriod = $self->_subtract_11mo($speriod);
 287   $self->receipts($speriod, $eperiod, $agentnum);
 288 }
 289
 290 sub payments_12mo {
 291   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 292   $speriod = $self->_subtract_11mo($speriod);
 293   $self->payments($speriod, $eperiod, $agentnum);
 294 }
 295
 296 sub credits_12mo {
 297   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 298   $speriod = $self->_subtract_11mo($speriod);
 299   $self->credits($speriod, $eperiod, $agentnum);
 300 }
 301
 302 sub netcredits_12mo {
 303   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 304   $speriod = $self->_subtract_11mo($speriod);
 305   $self->netcredits($speriod, $eperiod, $agentnum);
 306 }
 307
 308 sub cashflow_12mo {
 309   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 310   $speriod = $self->_subtract_11mo($speriod);
 311   $self->cashflow($speriod, $eperiod, $agentnum);
 312 }
 313
 314 sub netcashflow_12mo {
 315   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 316   $speriod = $self->_subtract_11mo($speriod);
 317   $self->cashflow($speriod, $eperiod, $agentnum);
 318 }
 319
 320 sub refunds_12mo {
 321   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 322   $speriod = $self->_subtract_11mo($speriod);
 323   $self->refunds($speriod, $eperiod, $agentnum);
 324 }
 325
 326 sub netrefunds_12mo {
 327   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 328   $speriod = $self->_subtract_11mo($speriod);
 329   $self->netrefunds($speriod, $eperiod, $agentnum);
 330 }
 331
 332
 333 #not being too bad with the false laziness
 334 sub _subtract_11mo {
 335   my($self, $time) = @_;
 336   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
 337   $mon -= 11;
 338   if ( $mon < 0 ) { $mon+=12; $year--; }
 339   timelocal($sec,$min,$hour,$mday,$mon,$year);
 340 }
 341
 342 =item cust_pkg_setup_cost: The total setup costs of packages setup in the period
 343
 344 'classnum': limit to this package class.
 345
 346 =cut
 347
 348 sub cust_pkg_setup_cost {
 349   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 350   my $where = '';
 351
 352   if ( $opt{'classnum'} ne '' ) {
 353     my $classnums = $opt{'classnum'};
 354     $classnums = [ $classnums ] if !ref($classnums);
 355     @$classnums = grep /^\d+$/, @$classnums;
 356     $where .= ' AND COALESCE(part_pkg.classnum,0) IN ('. join(',', @$classnums).
 357                                                     ')';
 358   }
 359
 360   $agentnum ||= $opt{'agentnum'};
 361
 362   my $total_sql = " SELECT SUM(part_pkg.setup_cost) ";
 363   $total_sql .= " FROM cust_pkg
 364              LEFT JOIN cust_main USING ( custnum )
 365              LEFT JOIN part_pkg  USING ( pkgpart )
 366                   WHERE pkgnum != 0
 367                   $where
 368                   AND ".$self->in_time_period_and_agent(
 369                     $speriod, $eperiod, $agentnum, 'cust_pkg.setup');
 370   return $self->scalar_sql($total_sql);
 371 }
 372
 373 =item cust_pkg_recur_cust: the total recur costs of packages in the period
 374
 375 'classnum': limit to this package class.
 376
 377 =cut
 378
 379 sub cust_pkg_recur_cost {
 380   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 381   my $where = '';
 382
 383   if ( $opt{'classnum'} ne '' ) {
 384     my $classnums = $opt{'classnum'};
 385     $classnums = [ $classnums ] if !ref($classnums);
 386     @$classnums = grep /^\d+$/, @$classnums;
 387     $where .= ' AND COALESCE(part_pkg.classnum,0) IN ('. join(',', @$classnums).
 388                                                     ')';
 389   }
 390
 391   $agentnum ||= $opt{'agentnum'};
 392   # duplication of in_time_period_and_agent
 393   # because we do it a little differently here
 394   $where .= " AND cust_main.agentnum = $agentnum" if $agentnum;
 395   $where .= " AND ".
 396           $FS::CurrentUser::CurrentUser->agentnums_sql('table' => 'cust_main');
 397
 398   my $total_sql = " SELECT SUM(part_pkg.recur_cost) ";
 399   $total_sql .= " FROM cust_pkg
 400              LEFT JOIN cust_main USING ( custnum )
 401              LEFT JOIN part_pkg  USING ( pkgpart )
 402                   WHERE pkgnum != 0
 403                   $where
 404                   AND cust_pkg.setup < $eperiod
 405                   AND (cust_pkg.cancel > $speriod OR cust_pkg.cancel IS NULL)
 406                   ";
 407   return $self->scalar_sql($total_sql);
 408 }
 409
 410 =item cust_bill_pkg: the total package charges on invoice line items.
 411
 412 'charges': limit the type of charges included (setup, recur, usage).
 413 Should be a string containing one or more of 'S', 'R', or 'U'; if
 414 unspecified, defaults to all three.
 415
 416 'classnum': limit to this package class.
 417
 418 'use_override': for line items generated by an add-on package, use the class
 419 of the add-on rather than the base package.
 420
 421 'average_per_cust_pkg': divide the result by the number of distinct packages.
 422
 423 'distribute': for non-monthly recurring charges, ignore the invoice
 424 date.  Instead, consider the line item's starting/ending dates.  Determine
 425 the fraction of the line item duration that falls within the specified
 426 interval and return that fraction of the recurring charges.  This is
 427 somewhat experimental.
 428
 429 'project': enable if this is a projected period.  This is very experimental.
 430
 431 =cut
 432
 433 sub cust_bill_pkg {
 434   my $self = shift;
 435   my( $speriod, $eperiod, $agentnum, %opt ) = @_;
 436
 437   my %charges = map {$_=>1} split('', $opt{'charges'} || 'SRU');
 438
 439   my $sum = 0;
 440   $sum += $self->cust_bill_pkg_setup(@_) if $charges{S};
 441   $sum += $self->cust_bill_pkg_recur(@_) if $charges{R};
 442   $sum += $self->cust_bill_pkg_detail(@_) if $charges{U};
 443
 444   if ($opt{'average_per_cust_pkg'}) {
 445     my $count = $self->cust_bill_pkg_count_pkgnum(@_);
 446     return '' if $count == 0;
 447     $sum = sprintf('%.2f', $sum / $count);
 448   }
 449   $sum;
 450 }
 451
 452 my $cust_bill_pkg_join = '
 453     LEFT JOIN cust_bill USING ( invnum )
 454     LEFT JOIN cust_main USING ( custnum )
 455     LEFT JOIN cust_pkg USING ( pkgnum )
 456     LEFT JOIN part_pkg USING ( pkgpart )
 457     LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 458     LEFT JOIN part_fee USING ( feepart )';
 459
 460 sub cust_bill_pkg_setup {
 461   my $self = shift;
 462   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 463   # no projecting setup fees--use real invoices only
 464   # but evaluate this anyway, because the design of projection is that
 465   # if there are somehow real setup fees in the future, we want to count
 466   # them
 467
 468   $agentnum ||= $opt{'agentnum'};
 469
 470   my @where = (
 471     '(pkgnum != 0 OR feepart IS NOT NULL)',
 472     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 473     $self->with_report_option(%opt),
 474     $self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
 475     $self->with_refnum(%opt),
 476     $self->with_cust_classnum(%opt)
 477   );
 478
 479   my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0)
 480   FROM cust_bill_pkg
 481   $cust_bill_pkg_join
 482   WHERE " . join(' AND ', grep $_, @where);
 483
 484   $self->scalar_sql($total_sql);
 485 }
 486
 487 sub _cust_bill_pkg_recurring {
 488   # returns the FROM/WHERE part of the statement to query all recurring
 489   # line items in the period
 490   my $self = shift;
 491   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 492
 493   $agentnum ||= $opt{'agentnum'};
 494   my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg';
 495
 496   my @where = (
 497     '(pkgnum != 0 OR feepart IS NOT NULL)',
 498     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 499     $self->with_report_option(%opt),
 500     $self->with_refnum(%opt),
 501     $self->with_cust_classnum(%opt)
 502   );
 503
 504   if ( $opt{'distribute'} ) {
 505     $where[0] = 'pkgnum != 0'; # specifically exclude fees
 506     push @where, "cust_main.agentnum = $agentnum" if $agentnum;
 507     push @where,
 508       "$cust_bill_pkg.sdate <  $eperiod",
 509       "$cust_bill_pkg.edate >= $speriod",
 510     ;
 511   }
 512   else {
 513     # we don't want to have to create v_cust_bill
 514     my $_date = $opt{'project'} ? 'v_cust_bill_pkg._date' : 'cust_bill._date';
 515     push @where,
 516       $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, $_date);
 517   }
 518
 519   return "
 520   FROM $cust_bill_pkg
 521   $cust_bill_pkg_join
 522   WHERE ".join(' AND ', grep $_, @where);
 523
 524 }
 525
 526 sub cust_bill_pkg_recur {
 527   my $self = shift;
 528   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 529
 530   # subtract all usage from the line item regardless of date
 531   my $item_usage;
 532   if ( $opt{'project'} ) {
 533     $item_usage = 'usage'; #already calculated
 534   }
 535   else {
 536     $item_usage = '( SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
 537       FROM cust_bill_pkg_detail
 538       WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum )';
 539   }
 540
 541   my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg';
 542
 543   my $recur_fraction = '';
 544   if ($opt{'distribute'}) {
 545     # the fraction of edate - sdate that's within [speriod, eperiod]
 546     $recur_fraction = " *
 547       CAST(LEAST($eperiod, $cust_bill_pkg.edate) -
 548        GREATEST($speriod, $cust_bill_pkg.sdate) AS DECIMAL) /
 549       ($cust_bill_pkg.edate - $cust_bill_pkg.sdate)";
 550   }
 551
 552   my $total_sql =
 553     "SELECT COALESCE(SUM(($cust_bill_pkg.recur - $item_usage) $recur_fraction),0)" .
 554     $self->_cust_bill_pkg_recurring(@_);
 555
 556   $self->scalar_sql($total_sql);
 557 }
 558
 559 sub cust_bill_pkg_count_pkgnum {
 560   # for ARPU calculation
 561   my $self = shift;
 562   my $total_sql = 'SELECT COUNT(DISTINCT pkgnum) '.
 563     $self->_cust_bill_pkg_recurring(@_);
 564
 565   $self->scalar_sql($total_sql);
 566 }
 567
 568 =item cust_bill_pkg_detail: the total usage charges in detail lines.
 569
 570 Arguments as for C<cust_bill_pkg>, plus:
 571
 572 'usageclass': limit to this usage class number.
 573
 574 =cut
 575
 576 sub cust_bill_pkg_detail {
 577   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 578
 579   my @where =
 580     ( "(cust_bill_pkg.pkgnum != 0 OR cust_bill_pkg.feepart IS NOT NULL)" );
 581
 582   $agentnum ||= $opt{'agentnum'};
 583
 584   push @where,
 585     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 586     $self->with_usageclass($opt{'usageclass'}),
 587     $self->with_report_option(%opt),
 588     $self->with_refnum(%opt),
 589     $self->with_cust_classnum(%opt)
 590     ;
 591
 592   if ( $opt{'distribute'} ) {
 593     # exclude fees
 594     $where[0] = 'cust_bill_pkg.pkgnum != 0';
 595     # and limit according to the usage time, not the billing date
 596     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 597       'cust_bill_pkg_detail.startdate'
 598     );
 599   }
 600   else {
 601     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 602       'cust_bill._date'
 603     );
 604   }
 605
 606   my $total_sql = " SELECT SUM(cust_bill_pkg_detail.amount) ";
 607
 608   $total_sql .=
 609     " FROM cust_bill_pkg_detail
 610         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 611         LEFT JOIN cust_bill ON cust_bill_pkg.invnum = cust_bill.invnum
 612         LEFT JOIN cust_main USING ( custnum )
 613         LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum
 614         LEFT JOIN part_pkg USING ( pkgpart )
 615         LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 616         LEFT JOIN part_fee USING ( feepart )
 617       WHERE ".join( ' AND ', grep $_, @where );
 618
 619   $self->scalar_sql($total_sql);
 620
 621 }
 622
 623 sub cust_bill_pkg_discount {
 624   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 625
 626   #need to do this the new multi-classnum way if it gets re-enabled
 627   #my $where = '';
 628   #my $comparison = '';
 629   #if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
 630   #  if ( $1 == 0 ) {
 631   #    $comparison = "IS NULL";
 632   #  } else {
 633   #    $comparison = "= $1";
 634   #  }
 635   #
 636   #  if ( $opt{'use_override'} ) {
 637   #    $where = "(
 638   #      part_pkg.classnum $comparison AND pkgpart_override IS NULL OR
 639   #      override.classnum $comparison AND pkgpart_override IS NOT NULL
 640   #    )";
 641   #  } else {
 642   #    $where = "part_pkg.classnum $comparison";
 643   #  }
 644   #}
 645
 646   $agentnum ||= $opt{'agentnum'};
 647
 648   my $total_sql =
 649     " SELECT COALESCE( SUM( cust_bill_pkg_discount.amount ), 0 ) ";
 650
 651   $total_sql .=
 652     " FROM cust_bill_pkg_discount
 653         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 654         LEFT JOIN cust_bill USING ( invnum )
 655         LEFT JOIN cust_main USING ( custnum )
 656       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum);
 657   #      LEFT JOIN cust_pkg_discount USING ( pkgdiscountnum )
 658   #      LEFT JOIN discount USING ( discountnum )
 659   #      LEFT JOIN cust_pkg USING ( pkgnum )
 660   #      LEFT JOIN part_pkg USING ( pkgpart )
 661   #      LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 662
 663   return $self->scalar_sql($total_sql);
 664
 665 }
 666
 667 ##### churn report #####
 668
 669 =item active_pkg: The number of packages that were active at the start of
 670 the period. The end date of the period is ignored. Options:
 671
 672 - refnum: Limit to customers with this advertising source.
 673 - classnum: Limit to packages with this class.
 674 - towernum: Limit to packages that have a broadband service with this tower.
 675 - zip: Limit to packages with this service location zip code.
 676
 677 Except for zip, any of these can be an arrayref to allow multiple values for
 678 the field.
 679
 680 =item setup_pkg: The number of packages with setup dates in the period. This
 681 excludes packages created by package changes. Options are as for active_pkg.
 682
 683 =item susp_pkg: The number of packages that were suspended in the period
 684 (and not canceled).  Options are as for active_pkg.
 685
 686 =item unsusp_pkg: The number of packages that were unsuspended in the period.
 687 Options are as for active_pkg.
 688
 689 =item cancel_pkg: The number of packages with cancel dates in the period.
 690 Excludes packages that were canceled to be changed to a new package. Options
 691 are as for active_pkg.
 692
 693 =cut
 694
 695 sub active_pkg {
 696   my $self = shift;
 697   $self->churn_pkg('active', @_);
 698 }
 699
 700 sub setup_pkg {
 701   my $self = shift;
 702   $self->churn_pkg('setup', @_);
 703 }
 704
 705 sub cancel_pkg {
 706   my $self = shift;
 707   $self->churn_pkg('cancel', @_);
 708 }
 709
 710 sub susp_pkg {
 711   my $self = shift;
 712   $self->churn_pkg('susp', @_);
 713 }
 714
 715 sub unsusp_pkg {
 716   my $self = shift;
 717   $self->churn_pkg('unsusp', @_);
 718 }
 719
 720 sub churn_pkg {
 721   my $self = shift;
 722   my ( $status, $speriod, $eperiod, $agentnum, %opt ) = @_;
 723   my ($from, @where) =
 724     FS::h_cust_pkg->churn_fromwhere_sql( $status, $speriod, $eperiod);
 725
 726   push @where, $self->pkg_where(%opt, 'agentnum' => $agentnum);
 727
 728   my $sql = "SELECT COUNT(*) FROM $from
 729     JOIN part_pkg ON (cust_pkg.pkgpart = part_pkg.pkgpart)
 730     JOIN cust_main ON (cust_pkg.custnum = cust_main.custnum)";
 731   $sql .= ' WHERE '.join(' AND ', @where)
 732     if scalar(@where);
 733
 734   $self->scalar_sql($sql);
 735 }
 736
 737 sub pkg_where {
 738   my $self = shift;
 739   my %opt = @_;
 740   my @where = (
 741     "part_pkg.freq != '0'",
 742     $self->with_refnum(%opt),
 743     $self->with_towernum(%opt),
 744     $self->with_zip(%opt),
 745   );
 746   if ($opt{agentnum} =~ /^(\d+)$/) {
 747     push @where, "cust_main.agentnum = $1";
 748   }
 749   if ($opt{classnum}) {
 750     my $classnum = $opt{classnum};
 751     $classnum = [ $classnum ] if !ref($classnum);
 752     @$classnum = grep /^\d+$/, @$classnum;
 753     my $in = 'IN ('. join(',', @$classnum). ')';
 754     push @where, "COALESCE(part_pkg.classnum, 0) $in" if scalar @$classnum;
 755   }
 756   @where;
 757 }
 758
 759 ##### end of churn report stuff #####
 760
 761 sub in_time_period_and_agent {
 762   my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4);
 763   my $col = @_ ? shift() : '_date';
 764
 765   my $sql = "$col >= $speriod AND $col < $eperiod";
 766
 767   #agent selection
 768   $sql .= " AND cust_main.agentnum = $agentnum"
 769     if $agentnum;
 770
 771   #agent virtualization
 772   $sql .= ' AND '.
 773           $FS::CurrentUser::CurrentUser->agentnums_sql( 'table'=>'cust_main' );
 774
 775   $sql;
 776 }
 777
 778 sub for_opts {
 779     my ( $self, %opt ) = @_;
 780     my $sql = '';
 781     if ( $opt{'custnum'} =~ /^(\d+)$/ ) {
 782       $sql .= " and custnum = $1 ";
 783     }
 784     if ( $opt{'refnum'} ) {
 785       my $refnum = $opt{'refnum'};
 786       $refnum = [ $refnum ] if !ref($refnum);
 787       my $in = join(',', grep /^\d+$/, @$refnum);
 788       $sql .= " and refnum IN ($in)" if length $in;
 789     }
 790     if ( my $where = $self->with_cust_classnum(%opt) ) {
 791       $sql .= " and $where";
 792     }
 793
 794     $sql;
 795 }
 796
 797 sub with_classnum {
 798   my ($self, $classnum, $use_override) = @_;
 799   return '' if $classnum eq '';
 800
 801   $classnum = [ $classnum ] if !ref($classnum);
 802   @$classnum = grep /^\d+$/, @$classnum;
 803   my $in = 'IN ('. join(',', @$classnum). ')';
 804
 805   my $expr = "
 806          ( COALESCE(part_pkg.classnum, 0) $in AND pkgpart_override IS NULL)
 807       OR ( COALESCE(part_fee.classnum, 0) $in AND feepart IS NOT NULL )";
 808   if ( $use_override ) {
 809     $expr .= "
 810       OR ( COALESCE(override.classnum, 0) $in AND pkgpart_override IS NOT NULL )";
 811   }
 812   "( $expr )";
 813 }
 814
 815 sub with_usageclass {
 816   my $self = shift;
 817   my ($classnum, $use_override) = @_;
 818   return '' unless $classnum =~ /^\d+$/;
 819   my $comparison;
 820   if ( $classnum == 0 ) {
 821     $comparison = 'IS NULL';
 822   }
 823   else {
 824     $comparison = "= $classnum";
 825   }
 826   return "cust_bill_pkg_detail.classnum $comparison";
 827 }
 828
 829 sub with_report_option {
 830   my ($self, %opt) = @_;
 831   # %opt can contain:
 832   # - report_optionnum: a comma-separated list of numbers.  Zero means to
 833   #   include packages with _no_ report classes.
 834   # - not_report_optionnum: a comma-separated list.  Packages that have
 835   #   any of these report options will be excluded from the result.
 836   #   Zero does nothing.
 837   # - use_override: also matches line items that are add-ons to a package
 838   #   matching the report class.
 839   # - all_report_options: returns only packages that have ALL of the
 840   #   report classes listed in $num.  Otherwise, will return packages that
 841   #   have ANY of those classes.
 842
 843   my @num = ref($opt{'report_optionnum'})
 844                   ? @{ $opt{'report_optionnum'} }
 845                   : split(/\s*,\s*/, $opt{'report_optionnum'});
 846   my @not_num = ref($opt{'not_report_optionnum'})
 847                       ? @{ $opt{'not_report_optionnum'} }
 848                       : split(/\s*,\s*/, $opt{'not_report_optionnum'});
 849   my $null;
 850   $null = 1 if ( grep {$_ == 0} @num );
 851   @num = grep {$_ > 0} @num;
 852   @not_num = grep {$_ > 0} @not_num;
 853
 854   # brute force
 855   my $table = $opt{'use_override'} ? 'override' : 'part_pkg';
 856   my $op = ' OR ';
 857   if ( $opt{'all_report_options'} ) {
 858     if ( @num and $null ) {
 859       return 'false'; # mutually exclusive criteria, so just bail out
 860     }
 861     $op = ' AND ';
 862   }
 863   my @where_num = map {
 864     "EXISTS(SELECT 1 FROM part_pkg_option ".
 865     "WHERE optionname = 'report_option_$_' ".
 866     "AND part_pkg_option.pkgpart = $table.pkgpart)"
 867   } @num;
 868   if ( $null ) {
 869     push @where_num, "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
 870                      "WHERE optionname LIKE 'report_option_%' ".
 871                      "AND part_pkg_option.pkgpart = $table.pkgpart)";
 872   }
 873   my @where_not_num = map {
 874     "NOT EXISTS(SELECT 1 FROM part_pkg_option ".
 875     "WHERE optionname = 'report_option_$_' ".
 876     "AND part_pkg_option.pkgpart = $table.pkgpart)"
 877   } @not_num;
 878
 879   my @where;
 880   if (@where_num) {
 881     push @where, '( '.join($op, @where_num).' )';
 882   }
 883   if (@where_not_num) {
 884     push @where, '( '.join(' AND ', @where_not_num).' )';
 885   }
 886
 887   return @where;
 888   # this messes up totals
 889   #if ( $opt{'use_override'} ) {
 890   #  # then also allow the non-override package to match
 891   #  delete $opt{'use_override'};
 892   #  $comparison = "( $comparison OR " . $self->with_report_option(%opt) . ")";
 893   #}
 894
 895 }
 896
 897 sub with_refnum {
 898   my ($self, %opt) = @_;
 899   if ( $opt{'refnum'} ) {
 900     my $refnum = $opt{'refnum'};
 901     $refnum = [ $refnum ] if !ref($refnum);
 902     my $in = join(',', grep /^\d+$/, @$refnum);
 903     return "cust_main.refnum IN ($in)" if length $in;
 904   }
 905   return;
 906 }
 907
 908 sub with_towernum {
 909   my ($self, %opt) = @_;
 910   if ( $opt{'towernum'} ) {
 911     my $towernum = $opt{'towernum'};
 912     $towernum = [ $towernum ] if !ref($towernum);
 913     my $in = join(',', grep /^\d+$/, @$towernum);
 914     return unless length($in); # if no towers are specified, don't restrict
 915
 916     # materialize/cache the set of pkgnums that, as of the last
 917     # svc_broadband history record, had a certain towernum
 918     # (because otherwise this is painfully slow)
 919     $self->_init_tower_pkg_cache;
 920
 921     return "EXISTS(
 922             SELECT 1 FROM tower_pkg_cache
 923               WHERE towernum IN($in)
 924               AND cust_pkg.pkgnum = tower_pkg_cache.pkgnum
 925             )";
 926   }
 927   return;
 928 }
 929
 930 sub with_zip {
 931   my ($self, %opt) = @_;
 932   if (length($opt{'zip'})) {
 933     return "(SELECT zip FROM cust_location
 934              WHERE cust_location.locationnum = cust_pkg.locationnum
 935             ) = " . dbh->quote($opt{'zip'});
 936   }
 937   return;
 938 }
 939
 940 sub with_cust_classnum {
 941   my ($self, %opt) = @_;
 942   if ( $opt{'cust_classnum'} ) {
 943     my $classnums = $opt{'cust_classnum'};
 944     $classnums = [ $classnums ] if !ref($classnums);
 945     @$classnums = grep /^\d+$/, @$classnums;
 946     return 'cust_main.classnum in('. join(',',@$classnums) .')'
 947       if @$classnums;
 948   }
 949   return;
 950 }
 951
 952
 953 sub scalar_sql {
 954   my( $self, $sql ) = ( shift, shift );
 955   my $sth = dbh->prepare($sql) or die dbh->errstr;
 956   warn "FS::Report::Table\n$sql\n" if $DEBUG;
 957   $sth->execute
 958     or die "Unexpected error executing statement $sql: ". $sth->errstr;
 959   $sth->fetchrow_arrayref->[0] || 0;
 960 }
 961
 962 =back
 963
 964 =head1 METHODS
 965
 966 =over 4
 967
 968 =item init_projection
 969
 970 Sets up for future projection of all observables on the report.  Currently
 971 this is limited to 'cust_bill_pkg'.
 972
 973 =cut
 974
 975 sub init_projection {
 976   # this is weird special case stuff--some redesign may be needed
 977   # to use it for anything else
 978   my $self = shift;
 979
 980   if ( driver_name ne 'Pg' ) {
 981     # also database-specific for now
 982     die "projection reports not supported on this platform";
 983   }
 984
 985   my %items = map {$_ => 1} @{ $self->{items} };
 986   if ($items{'cust_bill_pkg'}) {
 987     my $dbh = dbh;
 988     # v_ for 'virtual'
 989     my @sql = (
 990       # could use TEMPORARY TABLE but we're already transaction-protected
 991       'DROP TABLE IF EXISTS v_cust_bill_pkg',
 992       'CREATE TABLE v_cust_bill_pkg ' .
 993        '(LIKE cust_bill_pkg,
 994           usage numeric(10,2), _date integer, expire integer)',
 995       # XXX this should be smart enough to take only the ones with
 996       # sdate/edate overlapping the ROI, for performance
 997       "INSERT INTO v_cust_bill_pkg (
 998         SELECT cust_bill_pkg.*,
 999           (SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
1000           FROM cust_bill_pkg_detail
1001           WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum),
1002           cust_bill._date,
1003           cust_pkg.expire
1004         FROM cust_bill_pkg $cust_bill_pkg_join
1005       )",
1006     );
1007     foreach my $sql (@sql) {
1008       warn "[init_projection] $sql\n" if $DEBUG;
1009       $dbh->do($sql) or die $dbh->errstr;
1010     }
1011   }
1012 }
1013
1014 =item extend_projection START END
1015
1016 Generates data for the next period of projection.  This will be called
1017 for sequential periods where the END of one equals the START of the next
1018 (with no gaps).
1019
1020 =cut
1021
1022 sub extend_projection {
1023   my $self = shift;
1024   my ($speriod, $eperiod) = @_;
1025   my %items = map {$_ => 1} @{ $self->{items} };
1026   if ($items{'cust_bill_pkg'}) {
1027     # What we do here:
1028     # Find all line items that end after the start of the period (and have
1029     # recurring fees, and don't expire before they end).  Choose the latest
1030     # one for each package.  If it ends before the end of the period, copy
1031     # it forward by one billing period.
1032     # Repeat this until the latest line item for each package no longer ends
1033     # within the period.  This is certain to happen in finitely many
1034     # iterations as long as freq > 0.
1035     # - Pg only, obviously.
1036     # - Gives bad results if freq_override is used.
1037     my @fields = ( FS::cust_bill_pkg->fields, qw( usage _date expire ) );
1038     my $insert_fields = join(',', @fields);
1039     my $add_freq = sub { # emulate FS::part_pkg::add_freq
1040       my $field = shift;
1041       "EXTRACT( EPOCH FROM TO_TIMESTAMP($field) + (CASE WHEN freq ~ E'\\\\D' ".
1042       "THEN freq ELSE freq || 'mon' END)::INTERVAL) AS $field";
1043     };
1044     foreach (@fields) {
1045       if ($_ eq 'edate') {
1046         $_ = $add_freq->('edate');
1047       }
1048       elsif ($_ eq 'sdate') {
1049         $_ = 'edate AS sdate'
1050       }
1051       elsif ($_ eq 'setup') {
1052         $_ = '0 AS setup' #because recurring only
1053       }
1054       elsif ($_ eq '_date') {
1055         $_ = $add_freq->('_date');
1056       }
1057     }
1058     my $select_fields = join(',', @fields);
1059     my $dbh = dbh;
1060     my $sql =
1061     # Subquery here because we need to DISTINCT the whole set, select the
1062     # latest charge per pkgnum, and _then_ check edate < $eperiod
1063     # and edate < expire.
1064       "INSERT INTO v_cust_bill_pkg ($insert_fields)
1065         SELECT $select_fields FROM (
1066           SELECT DISTINCT ON (pkgnum) * FROM v_cust_bill_pkg
1067             WHERE edate >= $speriod
1068               AND recur > 0
1069               AND freq IS NOT NULL
1070               AND freq != '0'
1071             ORDER BY pkgnum, edate DESC
1072           ) AS v1
1073           WHERE edate < $eperiod AND (edate < expire OR expire IS NULL)";
1074     my $rows;
1075     do {
1076       warn "[extend_projection] $sql\n" if $DEBUG;
1077       $rows = $dbh->do($sql) or die $dbh->errstr;
1078       warn "[extend_projection] $rows rows\n" if $DEBUG;
1079     } until $rows == 0;
1080   }
1081 }
1082
1083 =item _init_tower_pkg_cache
1084
1085 Internal method: creates a temporary table relating pkgnums to towernums.
1086 A (pkgnum, towernum) record indicates that this package once had a
1087 svc_broadband service which, as of its last insert or replace_new history
1088 record, had a sectornum associated with that towernum.
1089
1090 This is expensive, so it won't be done more than once an hour. Historical
1091 data about package churn shouldn't be changing in realtime anyway.
1092
1093 =cut
1094
1095 sub _init_tower_pkg_cache {
1096   my $self = shift;
1097   my $dbh = dbh;
1098
1099   my $current = $CACHE->get('tower_pkg_cache_update');
1100   return if $current;
1101
1102   # XXX or should this be in the schema?
1103   my $sql = "DROP TABLE IF EXISTS tower_pkg_cache";
1104   $dbh->do($sql) or die $dbh->errstr;
1105   $sql = "CREATE TABLE tower_pkg_cache (towernum int, pkgnum int)";
1106   $dbh->do($sql) or die $dbh->errstr;
1107
1108   # assumptions:
1109   # sectornums never get reused, or move from one tower to another
1110   # all service history is intact
1111   # svcnums never get reused (this would be bad)
1112   # pkgnums NEVER get reused (this would be extremely bad)
1113   $sql = "INSERT INTO tower_pkg_cache (
1114     SELECT COALESCE(towernum,0), pkgnum
1115     FROM ( SELECT DISTINCT pkgnum, svcnum FROM h_cust_svc ) AS pkgnum_svcnum
1116     LEFT JOIN (
1117       SELECT DISTINCT ON(svcnum) svcnum, sectornum
1118         FROM h_svc_broadband
1119         WHERE (history_action = 'replace_new'
1120                OR history_action = 'replace_old')
1121         ORDER BY svcnum ASC, history_date DESC
1122     ) AS svcnum_sectornum USING (svcnum)
1123     LEFT JOIN tower_sector USING (sectornum)
1124   )";
1125   $dbh->do($sql) or die $dbh->errstr;
1126
1127   $CACHE->set('tower_pkg_cache_update', 1, 3600);
1128
1129 };
1130
1131 =head1 BUGS
1132
1133 Documentation.
1134
1135 =head1 SEE ALSO
1136
1137 L<FS::Report::Table::Monthly>, reports in the web interface.
1138
1139 =cut
1140
1141 1;