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     push @{$data{speriod}}, $speriod;
 186     if ( ++$smonth == 13 ) { $syear++; $smonth=1; }
 187     my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear);
 188     push @{$data{eperiod}}, $eperiod;
 189
 190     my $col = 0; # a "column" here is the data corresponding to an item
 191     my @items = @{$self->{'items'}};
 192     my $i;
 193
 194     for ( $i = 0; $i < scalar(@items); $i++ ) {
 195       my $item = $items[$i];
 196       my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: ();
 197       push @param, 'project', $projecting;
 198       push @param, 'refnum' => $refnum if $refnum;
 199       push @param, 'cust_classnum' => $cust_classnum if @$cust_classnum;
 200
 201       if ( $self->{'cross_params'} ) {
 202         my @xdata;
 203         foreach my $xparam (@{ $self->{'cross_params'} }) {
 204           # @$xparam is a list of additional params to merge into the list
 205           my $value = $self->$item($speriod, $eperiod, $agentnum,
 206                         @param,
 207                         @$xparam);
 208           push @xdata, $value;
 209         }
 210         push @{$data{data}->[$col++]}, \@xdata;
 211       } else {
 212         my $value = $self->$item($speriod, $eperiod, $agentnum, @param);
 213         push @{$data{data}->[$col++]}, $value;
 214       }
 215     }
 216   }
 217
 218   #these need to get generalized, sheesh
 219   $data{'items'}       = $self->{'items'};
 220   $data{'item_labels'} = $self->{'item_labels'} || $self->{'items'};
 221   $data{'colors'}      = $self->{'colors'};
 222   $data{'links'}       = $self->{'links'} || [];
 223
 224   if ( defined $self->{'normalize'} ) {
 225     my $norm_col = $self->{'normalize'};
 226     my $norm_data = $data{data}->[$norm_col];
 227
 228     my $row = 0;
 229     while ( exists $data{speriod}->[$row] ) {
 230       my $col = 0;
 231       while ( exists $data{items}->[$col ] ) {
 232         if ( $col != $norm_col ) {
 233           if ( $norm_data->[$row] == 0 ) {
 234             $data{data}->[$col][$row] = undef;
 235           } else {
 236             $data{data}->[$col][$row] =
 237               ( $data{data}->[$col][$row] * 100 / $norm_data->[$row] );
 238           }
 239         }
 240         $col++;
 241       }
 242       $row++;
 243     }
 244   }
 245
 246   if ( !$self->{'cross_params'} ) {
 247     # remove unnecessary rows
 248
 249     my $col = 0;
 250     #these need to get generalized, sheesh
 251     #(though we now return a list of item indices that are present in the
 252     #output, so the front-end code could do this)
 253     my @newitems = ();
 254     my @newlabels = ();
 255     my @newdata = ();
 256     my @newcolors = ();
 257     my @newlinks = ();
 258     my @indices = ();
 259     foreach my $item ( @{$self->{'items'}} ) {
 260
 261       # if remove_empty, then remove rows of zeroes
 262       my $is_nonzero = scalar( grep { $_ != 0 } @{ $data{'data'}->[$col] });
 263       next if ($self->{'remove_empty'} and $is_nonzero == 0);
 264       # if normalizing, strip out the norm column
 265       next if (defined($self->{'normalize'}) and $self->{'normalize'} == $col);
 266
 267       if ( grep { $_ != 0 } @{$data{'data'}->[$col]} ) {
 268         push @newitems,  $data{'items'}->[$col];
 269         push @newlabels, $data{'item_labels'}->[$col];
 270         push @newdata,   $data{'data'}->[$col];
 271         push @newcolors, $data{'colors'}->[$col];
 272         push @newlinks,  $data{'links'}->[$col];
 273         push @indices,   $col;
 274       }
 275     } continue {
 276       $col++;
 277     }
 278
 279     $data{'items'}       = \@newitems;
 280     $data{'item_labels'} = \@newlabels;
 281     $data{'data'}        = \@newdata;
 282     $data{'colors'}      = \@newcolors;
 283     $data{'links'}       = \@newlinks;
 284     $data{'indices'}     = \@indices;
 285
 286   }
 287
 288   # clean up after ourselves
 289   #dbh->rollback;
 290   # leave in until development is finished, for diagnostics
 291   dbh->commit;
 292
 293   \%data;
 294 }
 295
 296 =back
 297
 298 =head1 BUGS
 299
 300 =head1 SEE ALSO
 301
 302 =cut
 303
 304 1;
 305