FS/FS/Report/Table.pm

   1 package FS::Report::Table;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   5 use FS::Report;
   6 use Time::Local qw( timelocal );
   7 use FS::UID qw( dbh );
   8 use FS::Report::Table;
   9 use FS::CurrentUser;
  10
  11 $DEBUG = 0; # turning this on will trace all SQL statements, VERY noisy
  12 @ISA = qw( FS::Report );
  13
  14 =head1 NAME
  15
  16 FS::Report::Table - Tables of report data
  17
  18 =head1 SYNOPSIS
  19
  20 See the more specific report objects, currently only
  21 FS::Report::Table::Monthly and FS::Report::Table::Daily.
  22
  23 =head1 OBSERVABLES
  24
  25 The common interface for an observable named 'foo' is:
  26
  27 $report->foo($startdate, $enddate, $agentnum, %options)
  28
  29 This returns a scalar value for foo, over the period from
  30 $startdate to $enddate, limited to agent $agentnum, subject to
  31 options in %opt.
  32
  33 =over 4
  34
  35 =item invoiced: The total amount charged on all invoices.
  36
  37 =cut
  38
  39 sub invoiced { #invoiced
  40   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
  41
  42   $self->scalar_sql("
  43     SELECT SUM(charged)
  44       FROM cust_bill
  45         LEFT JOIN cust_main USING ( custnum )
  46       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum)
  47       . (%opt ? $self->for_custnum(%opt) : '')
  48   );
  49
  50 }
  51
  52 =item netsales: invoiced - netcredits
  53
  54 =cut
  55
  56 sub netsales { #net sales
  57   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
  58
  59     $self->invoiced($speriod,$eperiod,$agentnum,%opt)
  60   - $self->netcredits($speriod,$eperiod,$agentnum,%opt);
  61 }
  62
  63 =item cashflow: payments - refunds
  64
  65 =cut
  66
  67 sub cashflow {
  68   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
  69
  70     $self->payments($speriod, $eperiod, $agentnum, %opt)
  71   - $self->refunds( $speriod, $eperiod, $agentnum, %opt);
  72 }
  73
  74 =item netcashflow: payments - netrefunds
  75
  76 =cut
  77
  78 sub netcashflow {
  79   my( $self, $speriod, $eperiod, $agentnum ) = @_;
  80
  81     $self->receipts($speriod, $eperiod, $agentnum)
  82   - $self->netrefunds( $speriod, $eperiod, $agentnum);
  83 }
  84
  85 =item payments: The sum of payments received in the period.
  86
  87 =cut
  88
  89 sub payments {
  90   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
  91   $self->scalar_sql("
  92     SELECT SUM(paid)
  93       FROM cust_pay
  94         LEFT JOIN cust_main USING ( custnum )
  95       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum)
  96       . (%opt ? $self->for_custnum(%opt) : '')
  97   );
  98 }
  99
 100 =item credits: The sum of credits issued in the period.
 101
 102 =cut
 103
 104 sub credits {
 105   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 106   $self->scalar_sql("
 107     SELECT SUM(amount)
 108       FROM cust_credit
 109         LEFT JOIN cust_main USING ( custnum )
 110       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum)
 111   );
 112 }
 113
 114 =item refunds: The sum of refunds paid in the period.
 115
 116 =cut
 117
 118 sub refunds {
 119   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 120   $self->scalar_sql("
 121     SELECT SUM(refund)
 122       FROM cust_refund
 123         LEFT JOIN cust_main USING ( custnum )
 124       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum)
 125       . (%opt ? $self->for_custnum(%opt) : '')
 126   );
 127 }
 128
 129 =item netcredits: The sum of credit applications to invoices in the period.
 130
 131 =cut
 132
 133 sub netcredits {
 134   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 135   $self->scalar_sql("
 136     SELECT SUM(cust_credit_bill.amount)
 137       FROM cust_credit_bill
 138         LEFT JOIN cust_bill USING ( invnum  )
 139         LEFT JOIN cust_main USING ( custnum )
 140       WHERE ". $self->in_time_period_and_agent( $speriod,
 141                                                 $eperiod,
 142                                                 $agentnum,
 143                                                 'cust_bill._date'
 144                                               )
 145       . (%opt ? $self->for_custnum(%opt) : '')
 146   );
 147 }
 148
 149 =item receipts: The sum of payment applications to invoices in the period.
 150
 151 =cut
 152
 153 sub receipts { #net payments
 154   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 155   $self->scalar_sql("
 156     SELECT SUM(cust_bill_pay.amount)
 157       FROM cust_bill_pay
 158         LEFT JOIN cust_bill USING ( invnum  )
 159         LEFT JOIN cust_main USING ( custnum )
 160       WHERE ". $self->in_time_period_and_agent( $speriod,
 161                                                 $eperiod,
 162                                                 $agentnum,
 163                                                 'cust_bill._date'
 164                                               )
 165   );
 166 }
 167
 168 =item netrefunds: The sum of refund applications to credits in the period.
 169
 170 =cut
 171
 172 sub netrefunds {
 173   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 174   $self->scalar_sql("
 175     SELECT SUM(cust_credit_refund.amount)
 176       FROM cust_credit_refund
 177         LEFT JOIN cust_credit USING ( crednum  )
 178         LEFT JOIN cust_main   USING ( custnum )
 179       WHERE ". $self->in_time_period_and_agent( $speriod,
 180                                                 $eperiod,
 181                                                 $agentnum,
 182                                                 'cust_credit._date'
 183                                               )
 184   );
 185 }
 186
 187 #XXX docs
 188
 189 #these should be auto-generated or $AUTOLOADed or something
 190 sub invoiced_12mo {
 191   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 192   $speriod = $self->_subtract_11mo($speriod);
 193   $self->invoiced($speriod, $eperiod, $agentnum);
 194 }
 195
 196 sub netsales_12mo {
 197   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 198   $speriod = $self->_subtract_11mo($speriod);
 199   $self->netsales($speriod, $eperiod, $agentnum);
 200 }
 201
 202 sub receipts_12mo {
 203   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 204   $speriod = $self->_subtract_11mo($speriod);
 205   $self->receipts($speriod, $eperiod, $agentnum);
 206 }
 207
 208 sub payments_12mo {
 209   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 210   $speriod = $self->_subtract_11mo($speriod);
 211   $self->payments($speriod, $eperiod, $agentnum);
 212 }
 213
 214 sub credits_12mo {
 215   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 216   $speriod = $self->_subtract_11mo($speriod);
 217   $self->credits($speriod, $eperiod, $agentnum);
 218 }
 219
 220 sub netcredits_12mo {
 221   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 222   $speriod = $self->_subtract_11mo($speriod);
 223   $self->netcredits($speriod, $eperiod, $agentnum);
 224 }
 225
 226 sub cashflow_12mo {
 227   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 228   $speriod = $self->_subtract_11mo($speriod);
 229   $self->cashflow($speriod, $eperiod, $agentnum);
 230 }
 231
 232 sub netcashflow_12mo {
 233   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 234   $speriod = $self->_subtract_11mo($speriod);
 235   $self->cashflow($speriod, $eperiod, $agentnum);
 236 }
 237
 238 sub refunds_12mo {
 239   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 240   $speriod = $self->_subtract_11mo($speriod);
 241   $self->refunds($speriod, $eperiod, $agentnum);
 242 }
 243
 244 sub netrefunds_12mo {
 245   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 246   $speriod = $self->_subtract_11mo($speriod);
 247   $self->netrefunds($speriod, $eperiod, $agentnum);
 248 }
 249
 250
 251 #not being too bad with the false laziness
 252 sub _subtract_11mo {
 253   my($self, $time) = @_;
 254   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
 255   $mon -= 11;
 256   if ( $mon < 0 ) { $mon+=12; $year--; }
 257   timelocal($sec,$min,$hour,$mday,$mon,$year);
 258 }
 259
 260 =item cust_pkg_setup_cost: The total setup costs of packages setup in the period
 261
 262 'classnum': limit to this package class.
 263
 264 =cut
 265
 266 sub cust_pkg_setup_cost {
 267   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 268   my $where = '';
 269   my $comparison = '';
 270   if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
 271     if ( $1 == 0 ) {
 272       $comparison = 'IS NULL';
 273     }
 274     else {
 275       $comparison = "= $1";
 276     }
 277     $where = "AND part_pkg.classnum $comparison";
 278   }
 279   $agentnum ||= $opt{'agentnum'};
 280
 281   my $total_sql = " SELECT SUM(part_pkg.setup_cost) ";
 282   $total_sql .= " FROM cust_pkg
 283              LEFT JOIN cust_main USING ( custnum )
 284              LEFT JOIN part_pkg  USING ( pkgpart )
 285                   WHERE pkgnum != 0
 286                   $where
 287                   AND ".$self->in_time_period_and_agent(
 288                     $speriod, $eperiod, $agentnum, 'cust_pkg.setup');
 289   return $self->scalar_sql($total_sql);
 290 }
 291
 292 =item cust_pkg_recur_cust: the total recur costs of packages in the period
 293
 294 'classnum': limit to this package class.
 295
 296 =cut
 297
 298 sub cust_pkg_recur_cost {
 299   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 300   my $where = '';
 301   my $comparison = '';
 302   if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
 303     if ( $1 == 0 ) {
 304       $comparison = 'IS NULL';
 305     }
 306     else {
 307       $comparison = "= $1";
 308     }
 309     $where = " AND part_pkg.classnum $comparison";
 310   }
 311   $agentnum ||= $opt{'agentnum'};
 312   # duplication of in_time_period_and_agent
 313   # because we do it a little differently here
 314   $where .= " AND cust_main.agentnum = $agentnum" if $agentnum;
 315   $where .= " AND ".
 316           $FS::CurrentUser::CurrentUser->agentnums_sql('table' => 'cust_main');
 317
 318   my $total_sql = " SELECT SUM(part_pkg.recur_cost) ";
 319   $total_sql .= " FROM cust_pkg
 320              LEFT JOIN cust_main USING ( custnum )
 321              LEFT JOIN part_pkg  USING ( pkgpart )
 322                   WHERE pkgnum != 0
 323                   $where
 324                   AND cust_pkg.setup < $eperiod
 325                   AND (cust_pkg.cancel > $speriod OR cust_pkg.cancel IS NULL)
 326                   ";
 327   return $self->scalar_sql($total_sql);
 328 }
 329
 330 =item cust_bill_pkg: the total package charges on invoice line items.
 331
 332 'charges': limit the type of charges included (setup, recur, usage).
 333 Should be a string containing one or more of 'S', 'R', or 'U'; if
 334 unspecified, defaults to all three.
 335
 336 'classnum': limit to this package class.
 337
 338 'use_override': for line items generated by an add-on package, use the class
 339 of the add-on rather than the base package.
 340
 341 'freq': limit to packages with this frequency.  Currently uses the part_pkg
 342 frequency, so term discounted packages may give odd results.
 343
 344 'distribute': for non-monthly recurring charges, ignore the invoice
 345 date.  Instead, consider the line item's starting/ending dates.  Determine
 346 the fraction of the line item duration that falls within the specified
 347 interval and return that fraction of the recurring charges.  This is
 348 somewhat experimental.
 349
 350 =cut
 351
 352 sub cust_bill_pkg {
 353   my $self = shift;
 354   my( $speriod, $eperiod, $agentnum, %opt ) = @_;
 355
 356   my %charges = map {$_=>1} split('', $opt{'charges'} || 'SRU');
 357
 358   my $sum = 0;
 359   $sum += $self->cust_bill_pkg_setup(@_) if $charges{S};
 360   $sum += $self->cust_bill_pkg_recur(@_) if $charges{R};
 361   $sum += $self->cust_bill_pkg_detail(@_) if $charges{U};
 362   $sum;
 363 }
 364
 365 my $cust_bill_pkg_from =
 366   ' cust_bill_pkg
 367     LEFT JOIN cust_bill USING ( invnum )
 368     LEFT JOIN cust_main USING ( custnum )
 369     LEFT JOIN cust_pkg USING ( pkgnum )
 370     LEFT JOIN part_pkg USING ( pkgpart )
 371     LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart';
 372
 373 sub cust_bill_pkg_setup {
 374   my $self = shift;
 375   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 376
 377   $agentnum ||= $opt{'agentnum'};
 378
 379   my @where = (
 380     'pkgnum != 0',
 381     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 382     $self->in_time_period_and_agent($speriod, $eperiod, $agentnum),
 383   );
 384
 385   my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0)
 386   FROM $cust_bill_pkg_from
 387   WHERE " . join(' AND ', grep $_, @where);
 388
 389   $self->scalar_sql($total_sql);
 390 }
 391
 392 sub cust_bill_pkg_recur {
 393   my $self = shift;
 394   my ($speriod, $eperiod, $agentnum, %opt) = @_;
 395
 396   $agentnum ||= $opt{'agentnum'};
 397
 398   my @where = (
 399     'pkgnum != 0',
 400     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 401   );
 402
 403   # subtract all usage from the line item regardless of date
 404   my $item_usage = '( SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
 405     FROM cust_bill_pkg_detail
 406     WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum )';
 407   my $recur_fraction = '';
 408
 409   if ( $opt{'distribute'} ) {
 410     push @where, "cust_main.agentnum = $agentnum" if $agentnum;
 411     push @where,
 412       "cust_bill_pkg.sdate < $eperiod",
 413       "cust_bill_pkg.edate > $speriod",
 414     ;
 415     # the fraction of edate - sdate that's within [speriod, eperiod]
 416     $recur_fraction = " *
 417       CAST(LEAST($eperiod, cust_bill_pkg.edate) -
 418        GREATEST($speriod, cust_bill_pkg.sdate) AS DECIMAL) /
 419       (cust_bill_pkg.edate - cust_bill_pkg.sdate)";
 420   }
 421   else {
 422     push @where,
 423       $self->in_time_period_and_agent($speriod, $eperiod, $agentnum);
 424   }
 425
 426   my $total_sql = "SELECT COALESCE(SUM(
 427   (cust_bill_pkg.recur - $item_usage) $recur_fraction),0)
 428   FROM $cust_bill_pkg_from
 429   WHERE ".join(' AND ', grep $_, @where);
 430
 431   $self->scalar_sql($total_sql);
 432 }
 433
 434 =item cust_bill_pkg_detail: the total usage charges in detail lines.
 435
 436 Arguments as for C<cust_bill_pkg>, plus:
 437
 438 'usageclass': limit to this usage class number.
 439
 440 =cut
 441
 442 sub cust_bill_pkg_detail {
 443   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 444
 445   my @where = ( "cust_bill_pkg.pkgnum != 0" );
 446
 447   $agentnum ||= $opt{'agentnum'};
 448
 449   push @where,
 450     $self->with_classnum($opt{'classnum'}, $opt{'use_override'}),
 451     $self->with_usageclass($opt{'usageclass'}),
 452     ;
 453
 454   if ( $opt{'distribute'} ) {
 455     # then limit according to the usage time, not the billing date
 456     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 457       'cust_bill_pkg_detail.startdate'
 458     );
 459   }
 460   else {
 461     push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum,
 462       'cust_bill._date'
 463     );
 464   }
 465
 466   my $total_sql = " SELECT SUM(amount) ";
 467
 468   $total_sql .=
 469     " / CASE COUNT(cust_pkg.*) WHEN 0 THEN 1 ELSE COUNT(cust_pkg.*) END "
 470       if $opt{average_per_cust_pkg};
 471
 472   $total_sql .=
 473     " FROM cust_bill_pkg_detail
 474         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 475         LEFT JOIN cust_bill ON cust_bill_pkg.invnum = cust_bill.invnum
 476         LEFT JOIN cust_main USING ( custnum )
 477         LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum
 478         LEFT JOIN part_pkg USING ( pkgpart )
 479         LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 480       WHERE ".join( ' AND ', grep $_, @where );
 481
 482   $self->scalar_sql($total_sql);
 483
 484 }
 485
 486 sub cust_bill_pkg_discount {
 487   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 488
 489   #my $where = '';
 490   #my $comparison = '';
 491   #if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
 492   #  if ( $1 == 0 ) {
 493   #    $comparison = "IS NULL";
 494   #  } else {
 495   #    $comparison = "= $1";
 496   #  }
 497   #
 498   #  if ( $opt{'use_override'} ) {
 499   #    $where = "(
 500   #      part_pkg.classnum $comparison AND pkgpart_override IS NULL OR
 501   #      override.classnum $comparison AND pkgpart_override IS NOT NULL
 502   #    )";
 503   #  } else {
 504   #    $where = "part_pkg.classnum $comparison";
 505   #  }
 506   #}
 507
 508   $agentnum ||= $opt{'agentnum'};
 509
 510   my $total_sql =
 511     " SELECT COALESCE( SUM( cust_bill_pkg_discount.amount ), 0 ) ";
 512
 513   #$total_sql .=
 514   #  " / CASE COUNT(cust_pkg.*) WHEN 0 THEN 1 ELSE COUNT(cust_pkg.*) END "
 515   #    if $opt{average_per_cust_pkg};
 516
 517   $total_sql .=
 518     " FROM cust_bill_pkg_discount
 519         LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 520         LEFT JOIN cust_bill USING ( invnum )
 521         LEFT JOIN cust_main USING ( custnum )
 522       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum);
 523   #      LEFT JOIN cust_pkg_discount USING ( pkgdiscountnum )
 524   #      LEFT JOIN discount USING ( discountnum )
 525   #      LEFT JOIN cust_pkg USING ( pkgnum )
 526   #      LEFT JOIN part_pkg USING ( pkgpart )
 527   #      LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
 528
 529   return $self->scalar_sql($total_sql);
 530
 531 }
 532
 533 sub setup_pkg  { shift->pkg_field( @_, 'setup' ); }
 534 sub susp_pkg   { shift->pkg_field( @_, 'susp'  ); }
 535 sub cancel_pkg { shift->pkg_field( @_, 'cancel'); }
 536
 537 sub pkg_field {
 538   my( $self, $speriod, $eperiod, $agentnum, $field ) = @_;
 539   $self->scalar_sql("
 540     SELECT COUNT(*) FROM cust_pkg
 541         LEFT JOIN cust_main USING ( custnum )
 542       WHERE ". $self->in_time_period_and_agent( $speriod,
 543                                                 $eperiod,
 544                                                 $agentnum,
 545                                                 "cust_pkg.$field",
 546                                               )
 547   );
 548
 549 }
 550
 551 #this is going to be harder..
 552 #sub unsusp_pkg {
 553 #  my( $self, $speriod, $eperiod, $agentnum ) = @_;
 554 #  $self->scalar_sql("
 555 #    SELECT COUNT(*) FROM h_cust_pkg
 556 #      WHERE
 557 #
 558 #}
 559
 560 sub in_time_period_and_agent {
 561   my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4);
 562   my $col = @_ ? shift() : '_date';
 563
 564   my $sql = "$col >= $speriod AND $col < $eperiod";
 565
 566   #agent selection
 567   $sql .= " AND cust_main.agentnum = $agentnum"
 568     if $agentnum;
 569
 570   #agent virtualization
 571   $sql .= ' AND '.
 572           $FS::CurrentUser::CurrentUser->agentnums_sql( 'table'=>'cust_main' );
 573
 574   $sql;
 575 }
 576
 577 sub for_custnum {
 578     my ( $self, %opt ) = @_;
 579     return '' unless $opt{'custnum'};
 580     $opt{'custnum'} =~ /^\d+$/ ? " and custnum = $opt{custnum} " : '';
 581 }
 582
 583 sub with_classnum {
 584   my $self = shift;
 585   my ($classnum, $use_override) = @_;
 586   return '' unless $classnum =~ /^\d+$/;
 587   my $comparison;
 588   if ( $classnum == 0 ) {
 589     $comparison = 'IS NULL';
 590   }
 591   else {
 592     $comparison = "= $classnum";
 593   }
 594   if ( $use_override ) {
 595     return "(
 596       part_pkg.classnum $comparison AND pkgpart_override IS NULL OR
 597       override.classnum $comparison AND pkgpart_override IS NOT NULL
 598     )";
 599   }
 600   else {
 601     return "part_pkg.classnum $comparison";
 602   }
 603 }
 604
 605 sub with_usageclass {
 606   my $self = shift;
 607   my ($classnum, $use_override) = @_;
 608   return '' unless $classnum =~ /^\d+$/;
 609   my $comparison;
 610   if ( $classnum == 0 ) {
 611     $comparison = 'IS NULL';
 612   }
 613   else {
 614     $comparison = "= $classnum";
 615   }
 616   return "cust_bill_pkg_detail.classnum $comparison";
 617 }
 618
 619 sub scalar_sql {
 620   my( $self, $sql ) = ( shift, shift );
 621   my $sth = dbh->prepare($sql) or die dbh->errstr;
 622   warn "FS::Report::Table\n$sql\n" if $DEBUG;
 623   $sth->execute
 624     or die "Unexpected error executing statement $sql: ". $sth->errstr;
 625   $sth->fetchrow_arrayref->[0] || 0;
 626 }
 627
 628 =back
 629
 630 =head1 BUGS
 631
 632 Documentation.
 633
 634 =head1 SEE ALSO
 635
 636 L<FS::Report::Table::Monthly>, reports in the web interface.
 637
 638 =cut
 639
 640 1;