FS/FS/Report/Table/Monthly.pm

   1 package FS::Report::Table::Monthly;
   2
   3 use strict;
   4 use vars qw( @ISA );
   5 use FS::UID qw(dbh);
   6 use FS::Report::Table;
   7 use Time::Local qw( timelocal );
   8
   9 @ISA = qw( FS::Report::Table );
  10
  11 =head1 NAME
  12
  13 FS::Report::Table::Monthly - Tables of report data, indexed monthly
  14
  15 =head1 SYNOPSIS
  16
  17   use FS::Report::Table::Monthly;
  18
  19   my $report = new FS::Report::Table::Monthly (
  20     'items' => [ 'invoiced', 'netsales', 'credits', 'receipts', ],
  21     'start_month' => 4,
  22     'start_year'  => 2000,
  23     'end_month'   => 4,
  24     'end_year'    => 2020,
  25     #opt
  26     'agentnum'    => 54
  27     'refnum'      => 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 PARAMETERS
  36
  37 =head2 TIME PERIOD
  38
  39 C<start_month>, C<start_year>, C<end_month>, and C<end_year> specify the date
  40 range to be included in the report.  The start and end months are included.
  41 Each month's values are summed from midnight on the first of the month to
  42 23:59:59 on the last day of the month.
  43
  44 =head2 REPORT ITEMS
  45
  46 =over 4
  47
  48 =item items: An arrayref of observables to calculate for each month.  See
  49 L<FS::Report::Table> for a list of observables and their parameters.
  50
  51 =item params: An arrayref, parallel to C<items>, of arrayrefs of parameters
  52 (in paired name/value form) to be passed to the observables.
  53
  54 =item cross_params: Cross-product parameters.  This must be an arrayref of
  55 arrayrefs of parameters (paired name/value form).  This creates an additional
  56 "axis" (orthogonal to the time and C<items> axes) in which the item is
  57 calculated once with each set of parameters in C<cross_params>.  These
  58 parameters are merged with those in C<params>.  Instead of being nested two
  59 levels, C<data> will be nested three levels, with the third level
  60 corresponding to this arrayref.
  61
  62 =back
  63
  64 =head2 FILTERING
  65
  66 =over 4
  67
  68 =item agentnum: Limit to customers with this agent.
  69
  70 =item refnum: Limit to customers with this advertising source.
  71
  72 =item remove_empty: Set this to a true value to hide rows that contain
  73 only zeroes.  The C<indices> array in the returned data will list the item
  74 indices that are actually present in the output so that you know what they
  75 are.  Ignored if C<cross_params> is in effect.
  76
  77 =back
  78
  79 =head2 PASS-THROUGH
  80
  81 C<item_labels>, C<colors>, and C<links> may be specified as arrayrefs
  82 parallel to C<items>.  Those values will be returned in C<data>, with any
  83 hidden rows (due to C<remove_empty>) filtered out, which is the only
  84 reason to do this.  Now that we have C<indices> it's probably better to
  85 use that.
  86
  87 =head1 RETURNED DATA
  88
  89 The C<data> method runs the report and returns a hashref of the following:
  90
  91 =over 4
  92
  93 =item label
  94
  95 Month labels, in MM/YYYY format.
  96
  97 =item speriod, eperiod
  98
  99 Absolute start and end times of each month, in unix time format.
 100
 101 =item items
 102
 103 The values passed in as C<items>, with any suppressed rows deleted.
 104
 105 =item indices
 106
 107 The indices of items in the input C<items> list that appear in the result
 108 set.  Useful for figuring out what they are when C<remove_empty> has deleted
 109 some items.
 110
 111 =item item_labels, colors, links - see PASS-THROUGH above
 112
 113 =item data
 114
 115 The actual results.  An arrayref corresponding to C<label> (the time axis),
 116 containing arrayrefs corresponding to C<items>, containing either numbers
 117 or, if C<cross_params> is given, arrayrefs corresponding to C<cross_params>.
 118
 119 =back
 120
 121 =cut
 122
 123 sub data {
 124   local $FS::UID::AutoCommit = 0;
 125   my $self = shift;
 126
 127   my $smonth  = $self->{'start_month'};
 128   my $syear   = $self->{'start_year'};
 129   my $emonth  = $self->{'end_month'};
 130   my $eyear   = $self->{'end_year'};
 131   # whether to extrapolate into the future
 132   my $projecting = $self->{'projection'};
 133
 134   # sanity checks
 135   if ( $eyear < $syear or
 136       ($eyear == $syear and $emonth < $smonth) ) {
 137     return { error => 'Start month must be before end month' };
 138   }
 139
 140   my $agentnum = $self->{'agentnum'};
 141   my $refnum = $self->{'refnum'};
 142
 143   if ( $projecting ) {
 144
 145     $self->init_projection;
 146
 147     my $thismonth = $smonth;
 148     my $thisyear  = $syear;
 149     while ( $thisyear < $eyear ||
 150       ( $thisyear == $eyear and $thismonth <= $emonth )
 151     ) {
 152       my $speriod = timelocal(0,0,0,1,$thismonth-1,$thisyear);
 153       $thismonth++;
 154       if ( $thismonth == 13 ) { $thisyear++; $thismonth = 1; }
 155       my $eperiod = timelocal(0,0,0,1,$thismonth-1,$thisyear);
 156
 157       $self->extend_projection($speriod, $eperiod);
 158     }
 159   }
 160
 161   my %data;
 162
 163   my $max_year  = $eyear;
 164   my $max_month = $emonth;
 165
 166   while ( $syear < $max_year
 167      || ( $syear == $max_year && $smonth < $max_month+1 ) ) {
 168
 169     push @{$data{label}}, "$smonth/$syear"; # sprintf?
 170
 171     my $speriod = timelocal(0,0,0,1,$smonth-1,$syear);
 172     push @{$data{speriod}}, $speriod;
 173     if ( ++$smonth == 13 ) { $syear++; $smonth=1; }
 174     my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear);
 175     push @{$data{eperiod}}, $eperiod;
 176
 177     my $col = 0;
 178     my @items = @{$self->{'items'}};
 179     my $i;
 180
 181     for ( $i = 0; $i < scalar(@items); $i++ ) {
 182       my $item = $items[$i];
 183       my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: ();
 184       push @param, 'project', $projecting;
 185       push @param, 'refnum' => $refnum if $refnum;
 186
 187       if ( $self->{'cross_params'} ) {
 188         my @xdata;
 189         foreach my $xparam (@{ $self->{'cross_params'} }) {
 190           # @$xparam is a list of additional params to merge into the list
 191           my $value = $self->$item($speriod, $eperiod, $agentnum,
 192                         @param,
 193                         @$xparam);
 194           push @xdata, $value;
 195         }
 196         push @{$data{data}->[$col++]}, \@xdata;
 197       } else {
 198         my $value = $self->$item($speriod, $eperiod, $agentnum, @param);
 199         push @{$data{data}->[$col++]}, $value;
 200       }
 201     }
 202   }
 203
 204   #these need to get generalized, sheesh
 205   $data{'items'}       = $self->{'items'};
 206   $data{'item_labels'} = $self->{'item_labels'} || $self->{'items'};
 207   $data{'colors'}      = $self->{'colors'};
 208   $data{'links'}       = $self->{'links'} || [];
 209
 210   if ( !$self->{'cross_params'} and $self->{'remove_empty'} ) {
 211
 212     my $col = 0;
 213     #these need to get generalized, sheesh
 214     #(though we now return a list of item indices that are present in the
 215     #output, so the front-end code could do this)
 216     my @newitems = ();
 217     my @newlabels = ();
 218     my @newdata = ();
 219     my @newcolors = ();
 220     my @newlinks = ();
 221     my @indices = ();
 222     foreach my $item ( @{$self->{'items'}} ) {
 223
 224       if ( grep { $_ != 0 } @{$data{'data'}->[$col]} ) {
 225         push @newitems,  $data{'items'}->[$col];
 226         push @newlabels, $data{'item_labels'}->[$col];
 227         push @newdata,   $data{'data'}->[$col];
 228         push @newcolors, $data{'colors'}->[$col];
 229         push @newlinks,  $data{'links'}->[$col];
 230         push @indices,   $col;
 231       }
 232
 233       $col++;
 234     }
 235
 236     $data{'items'}       = \@newitems;
 237     $data{'item_labels'} = \@newlabels;
 238     $data{'data'}        = \@newdata;
 239     $data{'colors'}      = \@newcolors;
 240     $data{'links'}       = \@newlinks;
 241     $data{'indices'}     = \@indices;
 242
 243   }
 244   # clean up after ourselves
 245   #dbh->rollback;
 246   # leave in until development is finished, for diagnostics
 247   dbh->commit;
 248
 249   \%data;
 250 }
 251
 252 =back
 253
 254 =head1 BUGS
 255
 256 =head1 SEE ALSO
 257
 258 =cut
 259
 260 1;
 261