FS/FS/Report/Table/Monthly.pm

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