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     'cust_classnum' => [ 1,2,4 ],
  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 PARAMETERS
  37
  38 =head2 TIME PERIOD
  39
  40 C<start_month>, C<start_year>, C<end_month>, and C<end_year> specify the date
  41 range to be included in the report.  The start and end months are included.
  42 Each month's values are summed from midnight on the first of the month to
  43 23:59:59 on the last day of the month.
  44
  45 =head2 REPORT ITEMS
  46
  47 =over 4
  48
  49 =item items: An arrayref of observables to calculate for each month.  See
  50 L<FS::Report::Table> for a list of observables and their parameters.
  51
  52 =item params: An arrayref, parallel to C<items>, of arrayrefs of parameters
  53 (in paired name/value form) to be passed to the observables.
  54
  55 =item cross_params: Cross-product parameters.  This must be an arrayref of
  56 arrayrefs of parameters (paired name/value form).  This creates an additional
  57 "axis" (orthogonal to the time and C<items> axes) in which the item is
  58 calculated once with each set of parameters in C<cross_params>.  These
  59 parameters are merged with those in C<params>.  Instead of being nested two
  60 levels, C<data> will be nested three levels, with the third level
  61 corresponding to this arrayref.
  62
  63 =back
  64
  65 =head2 FILTERING
  66
  67 =over 4
  68
  69 =item agentnum: Limit to customers with this agent.
  70
  71 =item refnum: Limit to customers with this advertising source.
  72
  73 =item cust_classnum: Limit to customers with this classnum; can be an
  74 arrayref.
  75
  76 =item remove_empty: Set this to a true value to hide rows that contain
  77 only zeroes.  The C<indices> array in the returned data will list the item
  78 indices that are actually present in the output so that you know what they
  79 are.  Ignored if C<cross_params> is in effect.
  80
  81 =back
  82
  83 =head2 PASS-THROUGH
  84
  85 C<item_labels>, C<colors>, and C<links> may be specified as arrayrefs
  86 parallel to C<items>.  Those values will be returned in C<data>, with any
  87 hidden rows (due to C<remove_empty>) filtered out, which is the only
  88 reason to do this.  Now that we have C<indices> it's probably better to
  89 use that.
  90
  91 =item PROCESSING
  92
  93 =item normalize: Set this to an item index to have all other items expressed
  94 as a percentage of that one.  That item will then be omitted from the output.
  95 If the normalization item is zero in some period, all the values in that
  96 period will be undef.
  97
  98 =head1 RETURNED DATA
  99
 100 The C<data> method runs the report and returns a hashref of the following:
 101
 102 =over 4
 103
 104 =item label
 105
 106 Month labels, in MM/YYYY format.
 107
 108 =item speriod, eperiod
 109
 110 Absolute start and end times of each month, in unix time format.
 111
 112 =item items
 113
 114 The values passed in as C<items>, with any suppressed rows deleted.
 115
 116 =item indices
 117
 118 The indices of items in the input C<items> list that appear in the result
 119 set.  Useful for figuring out what they are when C<remove_empty> has deleted
 120 some items.
 121
 122 =item item_labels, colors, links - see PASS-THROUGH above
 123
 124 =item data
 125
 126 The actual results.  An arrayref corresponding to C<label> (the time axis),
 127 containing arrayrefs corresponding to C<items>, containing either numbers
 128 or, if C<cross_params> is given, arrayrefs corresponding to C<cross_params>.
 129
 130 =back
 131
 132 =cut
 133
 134 sub data {
 135   local $FS::UID::AutoCommit = 0;
 136   my $self = shift;
 137
 138   my $smonth  = $self->{'start_month'};
 139   my $syear   = $self->{'start_year'};
 140   my $emonth  = $self->{'end_month'};
 141   my $eyear   = $self->{'end_year'};
 142   # whether to extrapolate into the future
 143   my $projecting = $self->{'projection'};
 144
 145   # sanity checks
 146   if ( $eyear < $syear or
 147       ($eyear == $syear and $emonth < $smonth) ) {
 148     return { error => 'Start month must be before end month' };
 149   }
 150
 151   my $agentnum = $self->{'agentnum'};
 152   my $refnum = $self->{'refnum'};
 153   my $cust_classnum = $self->{'cust_classnum'} || [];
 154   $cust_classnum = [ $cust_classnum ] if !ref($cust_classnum);
 155
 156   if ( $projecting ) {
 157
 158     $self->init_projection;
 159
 160     my $thismonth = $smonth;
 161     my $thisyear  = $syear;
 162     while ( $thisyear < $eyear ||
 163       ( $thisyear == $eyear and $thismonth <= $emonth )
 164     ) {
 165       my $speriod = timelocal(0,0,0,1,$thismonth-1,$thisyear);
 166       $thismonth++;
 167       if ( $thismonth == 13 ) { $thisyear++; $thismonth = 1; }
 168       my $eperiod = timelocal(0,0,0,1,$thismonth-1,$thisyear);
 169
 170       $self->extend_projection($speriod, $eperiod);
 171     }
 172   }
 173
 174   my %data;
 175
 176   my $max_year  = $eyear;
 177   my $max_month = $emonth;
 178
 179   while ( $syear < $max_year
 180      || ( $syear == $max_year && $smonth < $max_month+1 ) ) {
 181
 182     push @{$data{label}}, "$smonth/$syear"; # sprintf?
 183
 184     my $speriod = timelocal(0,0,0,1,$smonth-1,$syear);
 185     if ( ++$smonth == 13 ) { $syear++; $smonth=1; }
 186     my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear);
 187     # 12-month mode: show results in a sliding window ending at $eperiod,
 188     # but starting 12 months before.
 189     if ( $self->{'12mo'}) {
 190       $speriod = timelocal(0,0,0,1,$smonth-1,$syear-1);
 191     }
 192
 193     push @{$data{speriod}}, $speriod;
 194     push @{$data{eperiod}}, $eperiod;
 195
 196     my $col = 0; # a "column" here is the data corresponding to an item
 197     my @items = @{$self->{'items'}};
 198     my $i;
 199
 200     for ( $i = 0; $i < scalar(@items); $i++ ) {
 201       my $item = $items[$i];
 202       my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: ();
 203       push @param, 'project', $projecting;
 204       push @param, 'refnum' => $refnum if $refnum;
 205       push @param, 'cust_classnum' => $cust_classnum if @$cust_classnum;
 206
 207       if ( $self->{'cross_params'} ) {
 208         my @xdata;
 209         foreach my $xparam (@{ $self->{'cross_params'} }) {
 210           # @$xparam is a list of additional params to merge into the list
 211           my $value = $self->$item($speriod, $eperiod, $agentnum,
 212                         @param,
 213                         @$xparam);
 214           push @xdata, $value;
 215         }
 216         push @{$data{data}->[$col++]}, \@xdata;
 217       } else {
 218         my $value = $self->$item($speriod, $eperiod, $agentnum, @param);
 219         push @{$data{data}->[$col++]}, $value;
 220       }
 221     }
 222   }
 223
 224   #these need to get generalized, sheesh
 225   $data{'items'}       = $self->{'items'};
 226   $data{'item_labels'} = $self->{'item_labels'} || $self->{'items'};
 227   $data{'colors'}      = $self->{'colors'};
 228   $data{'links'}       = $self->{'links'} || [];
 229
 230   if ( defined $self->{'normalize'} ) {
 231     my $norm_col = $self->{'normalize'};
 232     my $norm_data = $data{data}->[$norm_col];
 233
 234     my $row = 0;
 235     while ( exists $data{speriod}->[$row] ) {
 236       my $col = 0;
 237       while ( exists $data{items}->[$col ] ) {
 238         if ( $col != $norm_col ) {
 239           if ( $norm_data->[$row] == 0 ) {
 240             $data{data}->[$col][$row] = undef;
 241           } else {
 242             $data{data}->[$col][$row] =
 243               ( $data{data}->[$col][$row] * 100 / $norm_data->[$row] );
 244           }
 245         }
 246         $col++;
 247       }
 248       $row++;
 249     }
 250   }
 251
 252   if ( !$self->{'cross_params'} ) {
 253     # remove unnecessary rows
 254
 255     my $col = 0;
 256     #these need to get generalized, sheesh
 257     #(though we now return a list of item indices that are present in the
 258     #output, so the front-end code could do this)
 259     my @newitems = ();
 260     my @newlabels = ();
 261     my @newdata = ();
 262     my @newcolors = ();
 263     my @newlinks = ();
 264     my @indices = ();
 265     foreach my $item ( @{$self->{'items'}} ) {
 266
 267       # if remove_empty, then remove rows of zeroes
 268       my $is_nonzero = scalar( grep { $_ != 0 } @{ $data{'data'}->[$col] });
 269       next if ($self->{'remove_empty'} and $is_nonzero == 0);
 270       # if normalizing, strip out the norm column
 271       next if (defined($self->{'normalize'}) and $self->{'normalize'} == $col);
 272
 273       if ( grep { $_ != 0 } @{$data{'data'}->[$col]} ) {
 274         push @newitems,  $data{'items'}->[$col];
 275         push @newlabels, $data{'item_labels'}->[$col];
 276         push @newdata,   $data{'data'}->[$col];
 277         push @newcolors, $data{'colors'}->[$col];
 278         push @newlinks,  $data{'links'}->[$col];
 279         push @indices,   $col;
 280       }
 281     } continue {
 282       $col++;
 283     }
 284
 285     $data{'items'}       = \@newitems;
 286     $data{'item_labels'} = \@newlabels;
 287     $data{'data'}        = \@newdata;
 288     $data{'colors'}      = \@newcolors;
 289     $data{'links'}       = \@newlinks;
 290     $data{'indices'}     = \@indices;
 291
 292   }
 293
 294   # clean up after ourselves
 295   #dbh->rollback;
 296   # leave in until development is finished, for diagnostics
 297   dbh->commit;
 298
 299   \%data;
 300 }
 301
 302 =back
 303
 304 =head1 BUGS
 305
 306 =head1 SEE ALSO
 307
 308 =cut
 309
 310 1;
 311