FS/FS/Report/Table/Monthly.pm

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