FS/FS/Report/Table/Monthly.pm

   1 package FS::Report::Table::Monthly;
   2
   3 use strict;
   4 use vars qw( @ISA $expenses_kludge );
   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
  12 $expenses_kludge = 0;
  13
  14 =head1 NAME
  15
  16 FS::Report::Table::Monthly - Tables of report data, indexed monthly
  17
  18 =head1 SYNOPSIS
  19
  20   use FS::Report::Table::Monthly;
  21
  22   my $report = new FS::Report::Table::Monthly (
  23     'items' => [ 'invoiced', 'netsales', 'credits', 'receipts', ],
  24     'start_month' => 4,
  25     'start_year'  => 2000,
  26     'end_month'   => 4,
  27     'end_year'    => 2020,
  28     #opt
  29     'agentnum'    => 54
  30     'params'      => [ [ 'paramsfor', 'item_one' ], [ 'item', 'two' ] ], # ...
  31     'remove_empty' => 1, #collapse empty rows, default 0
  32     'item_labels' => [ ], #useful with remove_empty
  33   );
  34
  35   my $data = $report->data;
  36
  37 =head1 METHODS
  38
  39 =over 4
  40
  41 =item data
  42
  43 Returns a hashref of data (!! describe)
  44
  45 =cut
  46
  47 sub data {
  48   my $self = shift;
  49
  50   #use Data::Dumper;
  51   #warn Dumper($self);
  52
  53   my $smonth = $self->{'start_month'};
  54   my $syear = $self->{'start_year'};
  55   my $emonth = $self->{'end_month'};
  56   my $eyear = $self->{'end_year'};
  57   my $agentnum = $self->{'agentnum'};
  58
  59   my %data;
  60
  61   while ( $syear < $eyear || ( $syear == $eyear && $smonth < $emonth+1 ) ) {
  62
  63     push @{$data{label}}, "$smonth/$syear";
  64
  65     my $speriod = timelocal(0,0,0,1,$smonth-1,$syear);
  66     push @{$data{speriod}}, $speriod;
  67     if ( ++$smonth == 13 ) { $syear++; $smonth=1; }
  68     my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear);
  69     push @{$data{eperiod}}, $eperiod;
  70
  71     my $col = 0;
  72     my @row = ();
  73     foreach my $item ( @{$self->{'items'}} ) {
  74       my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: ();
  75       my $value = $self->$item($speriod, $eperiod, $agentnum, @param);
  76       #push @{$data{$item}}, $value;
  77       push @{$data{data}->[$col++]}, $value;
  78     }
  79
  80   }
  81
  82   #these need to get generalized, sheesh
  83   $data{'items'}       = $self->{'items'};
  84   $data{'item_labels'} = $self->{'item_labels'} || $self->{'items'};
  85   $data{'colors'}      = $self->{'colors'};
  86   $data{'links'}       = $self->{'links'} || [];
  87
  88   #use Data::Dumper;
  89   #warn Dumper(\%data);
  90
  91   if ( $self->{'remove_empty'} ) {
  92
  93     #warn "removing empty rows\n";
  94
  95     my $col = 0;
  96     #these need to get generalized, sheesh
  97     my @newitems = ();
  98     my @newlabels = ();
  99     my @newdata = ();
 100     my @newcolors = ();
 101     my @newlinks = ();
 102     foreach my $item ( @{$self->{'items'}} ) {
 103
 104       if ( grep { $_ != 0 } @{$data{'data'}->[$col]} ) {
 105         push @newitems,  $data{'items'}->[$col];
 106         push @newlabels, $data{'item_labels'}->[$col];
 107         push @newdata,   $data{'data'}->[$col];
 108         push @newcolors, $data{'colors'}->[$col];
 109         push @newlinks,  $data{'links'}->[$col];
 110       }
 111
 112       $col++;
 113     }
 114
 115     $data{'items'}       = \@newitems;
 116     $data{'item_labels'} = \@newlabels;
 117     $data{'data'}        = \@newdata;
 118     $data{'colors'}      = \@newcolors;
 119     $data{'links'}       = \@newlinks;
 120
 121   }
 122
 123   #use Data::Dumper;
 124   #warn Dumper(\%data);
 125
 126   \%data;
 127
 128 }
 129
 130 sub invoiced { #invoiced
 131   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 132
 133   $self->scalar_sql("
 134     SELECT SUM(charged)
 135       FROM cust_bill
 136         LEFT JOIN cust_main USING ( custnum )
 137       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum)
 138   );
 139
 140 }
 141
 142 sub netsales { #net sales
 143   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 144
 145   my $credited = $self->scalar_sql("
 146     SELECT SUM(cust_credit_bill.amount)
 147       FROM cust_credit_bill
 148         LEFT JOIN cust_bill USING ( invnum  )
 149         LEFT JOIN cust_main USING ( custnum )
 150     WHERE ".  $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, 'cust_bill')
 151   );
 152
 153   #horrible local kludge
 154   my $expenses = !$expenses_kludge ? 0 : $self->scalar_sql("
 155     SELECT SUM(cust_bill_pkg.setup)
 156       FROM cust_bill_pkg
 157         LEFT JOIN cust_bill USING ( invnum  )
 158         LEFT JOIN cust_main USING ( custnum )
 159         LEFT JOIN cust_pkg  USING ( pkgnum  )
 160         LEFT JOIN part_pkg  USING ( pkgpart )
 161       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, 'cust_bill'). "
 162         AND LOWER(part_pkg.pkg) LIKE 'expense _%'
 163   ");
 164
 165   $self->invoiced($speriod,$eperiod,$agentnum) - $credited - $expenses;
 166 }
 167
 168 #deferred revenue
 169
 170 sub receipts { #cashflow
 171   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 172
 173   my $refunded = $self->scalar_sql("
 174     SELECT SUM(refund)
 175       FROM cust_refund
 176         LEFT JOIN cust_main USING ( custnum )
 177       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum)
 178   );
 179
 180   #horrible local kludge that doesn't even really work right
 181   my $expenses = !$expenses_kludge ? 0 : $self->scalar_sql("
 182     SELECT SUM(cust_bill_pay.amount)
 183       FROM cust_bill_pay
 184         LEFT JOIN cust_bill USING ( invnum  )
 185         LEFT JOIN cust_main USING ( custnum )
 186     WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, 'cust_bill_pay'). "
 187     AND 0 < ( SELECT COUNT(*) from cust_bill_pkg, cust_pkg, part_pkg
 188               WHERE cust_bill.invnum = cust_bill_pkg.invnum
 189               AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum
 190               AND cust_pkg.pkgpart = part_pkg.pkgpart
 191               AND LOWER(part_pkg.pkg) LIKE 'expense _%'
 192             )
 193   ");
 194   #    my $expenses_sql2 = "SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay, cust_bill_pkg, cust_bill, cust_pkg, part_pkg WHERE cust_bill_pay.invnum = cust_bill.invnum AND cust_bill.invnum = cust_bill_pkg.invnum AND cust_bill_pay._date >= $speriod AND cust_bill_pay._date < $eperiod AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum AND cust_pkg.pkgpart = part_pkg.pkgpart AND LOWER(part_pkg.pkg) LIKE 'expense _%'";
 195
 196   $self->payments($speriod, $eperiod, $agentnum) - $refunded - $expenses;
 197 }
 198
 199 sub payments {
 200   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 201   $self->scalar_sql("
 202     SELECT SUM(paid)
 203       FROM cust_pay
 204         LEFT JOIN cust_main USING ( custnum )
 205       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum)
 206   );
 207 }
 208
 209 sub credits {
 210   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 211   $self->scalar_sql("
 212     SELECT SUM(amount)
 213       FROM cust_credit
 214         LEFT JOIN cust_main USING ( custnum )
 215       WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum)
 216   );
 217 }
 218
 219 #these should be auto-generated or $AUTOLOADed or something
 220 sub invoiced_12mo {
 221   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 222   $speriod = $self->_subtract_11mo($speriod);
 223   $self->invoiced($speriod, $eperiod, $agentnum);
 224 }
 225
 226 sub netsales_12mo {
 227   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 228   $speriod = $self->_subtract_11mo($speriod);
 229   $self->netsales($speriod, $eperiod, $agentnum);
 230 }
 231
 232 sub receipts_12mo {
 233   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 234   $speriod = $self->_subtract_11mo($speriod);
 235   $self->receipts($speriod, $eperiod, $agentnum);
 236 }
 237
 238 sub payments_12mo {
 239   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 240   $speriod = $self->_subtract_11mo($speriod);
 241   $self->payments($speriod, $eperiod, $agentnum);
 242 }
 243
 244 sub credits_12mo {
 245   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 246   $speriod = $self->_subtract_11mo($speriod);
 247   $self->credits($speriod, $eperiod, $agentnum);
 248 }
 249
 250 #not being too bad with the false laziness
 251 use Time::Local qw(timelocal);
 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 sub cust_bill_pkg {
 261   my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
 262
 263   my $where = '';
 264   if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
 265     if ( $1 == 0 ) {
 266       $where = "classnum IS NULL";
 267     } else {
 268       $where = "classnum = $1";
 269     }
 270   }
 271
 272   $agentnum ||= $opt{'agentnum'};
 273
 274   $self->scalar_sql("
 275     SELECT SUM(cust_bill_pkg.setup + cust_bill_pkg.recur)
 276       FROM cust_bill_pkg
 277         LEFT JOIN cust_bill USING ( invnum )
 278         LEFT JOIN cust_main USING ( custnum )
 279         LEFT JOIN cust_pkg USING ( pkgnum )
 280         LEFT JOIN part_pkg USING ( pkgpart )
 281       WHERE pkgnum != 0
 282         AND $where
 283         AND ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum)
 284   );
 285
 286 }
 287
 288 # NEEDS TO BE AGENTNUM-capable
 289 sub canceled { #active
 290   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 291   $self->scalar_sql("
 292     SELECT COUNT(*)
 293       FROM cust_pkg
 294         LEFT JOIN cust_main USING ( custnum )
 295       WHERE 0 = ( SELECT COUNT(*)
 296                     FROM cust_pkg
 297                     WHERE cust_pkg.custnum = cust_main.custnum
 298                       AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
 299                 )
 300         AND cust_pkg.cancel > $speriod AND cust_pkg.cancel < $eperiod
 301   ");
 302 }
 303
 304 # NEEDS TO BE AGENTNUM-capable
 305 sub newaccount { #newaccount
 306   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 307   $self->scalar_sql("
 308      SELECT COUNT(*) FROM cust_pkg
 309      WHERE cust_pkg.custnum = cust_main.custnum
 310      AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
 311      AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
 312      AND cust_pkg.setup > $speriod AND cust_pkg.setup < $eperiod
 313   ");
 314 }
 315
 316 # NEEDS TO BE AGENTNUM-capable
 317 sub suspended { #suspended
 318   my( $self, $speriod, $eperiod, $agentnum ) = @_;
 319   $self->scalar_sql("
 320      SELECT COUNT(*) FROM cust_pkg
 321      WHERE cust_pkg.custnum = cust_main.custnum
 322      AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
 323      AND 0 = ( SELECT COUNT(*) FROM cust_pkg
 324                WHERE cust_pkg.custnum = cust_main.custnum
 325                AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
 326              )
 327      AND cust_pkg.susp > $speriod AND cust_pkg.susp < $eperiod
 328   ");
 329 }
 330
 331 sub in_time_period_and_agent {
 332   my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4);
 333   my $table = @_ ? shift().'.' : '';
 334
 335   my $sql = "${table}_date >= $speriod AND ${table}_date < $eperiod";
 336
 337   #agent selection
 338   $sql .= " AND agentnum = $agentnum"
 339     if $agentnum;
 340
 341   #agent virtualization
 342   $sql .= ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
 343
 344   $sql;
 345 }
 346
 347 sub scalar_sql {
 348   my( $self, $sql ) = ( shift, shift );
 349   my $sth = dbh->prepare($sql) or die dbh->errstr;
 350   $sth->execute
 351     or die "Unexpected error executing statement $sql: ". $sth->errstr;
 352   $sth->fetchrow_arrayref->[0] || 0;
 353 }
 354
 355 =back
 356
 357 =head1 BUGS
 358
 359 Documentation.
 360
 361 =head1 SEE ALSO
 362
 363 =cut
 364
 365 1;
 366