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     'params'      => [ [ 'paramsfor', 'item_one' ], [ 'item', 'two' ] ], # ...
  28     'remove_empty' => 1, #collapse empty rows, default 0
  29     'item_labels' => [ ], #useful with remove_empty
  30   );
  31
  32   my $data = $report->data;
  33
  34 =head1 METHODS
  35
  36 =over 4
  37
  38 =item data
  39
  40 Returns a hashref of data (!! describe)
  41
  42 =cut
  43
  44 sub data {
  45   local $FS::UID::AutoCommit = 0;
  46   my $self = shift;
  47
  48   my $smonth  = $self->{'start_month'};
  49   my $syear   = $self->{'start_year'};
  50   my $emonth  = $self->{'end_month'};
  51   my $eyear   = $self->{'end_year'};
  52   # how far to extrapolate into the future
  53   my $pmonth  = $self->{'project_month'};
  54   my $pyear   = $self->{'project_year'};
  55
  56   # sanity checks
  57   if ( $eyear < $syear or
  58       ($eyear == $syear and $emonth < $smonth) ) {
  59     return { error => 'Start month must be before end month' };
  60   }
  61
  62   my $agentnum = $self->{'agentnum'};
  63
  64   if ( $pyear > $eyear or
  65       ($pyear == $eyear and $pmonth > $emonth) ) {
  66
  67     # create the entire projection set first to avoid timing problems
  68
  69     $self->init_projection if $pmonth;
  70
  71     my $thisyear = $eyear;
  72     my $thismonth = $emonth;
  73     while ( $thisyear < $pyear ||
  74       ( $thisyear == $pyear and $thismonth <= $pmonth )
  75     ) {
  76       my $speriod = timelocal(0,0,0,1,$thismonth-1,$thisyear);
  77       $thismonth++;
  78       if ( $thismonth == 13 ) { $thisyear++; $thismonth = 1; }
  79       my $eperiod = timelocal(0,0,0,1,$thismonth-1,$thisyear);
  80
  81       $self->extend_projection($speriod, $eperiod);
  82     }
  83   }
  84
  85   my %data;
  86
  87   my $max_year = $pyear || $eyear;
  88   my $max_month = $pmonth || $emonth;
  89
  90   my $projecting = 0; # are we currently projecting?
  91
  92   while ( $syear < $max_year
  93      || ( $syear == $max_year && $smonth < $max_month+1 ) ) {
  94
  95     if ( $self->{'doublemonths'} ) {
  96       my($firstLabel,$secondLabel) = @{$self->{'doublemonths'}};
  97       push @{$data{label}}, "$smonth/$syear $firstLabel";
  98       push @{$data{label}}, "$smonth/$syear $secondLabel";
  99     }
 100     else {
 101       push @{$data{label}}, "$smonth/$syear";
 102     }
 103
 104     if ( $syear > $eyear || ( $syear == $eyear && $smonth >= $emonth + 1 ) ) {
 105       # start getting data from the projection
 106       $projecting = 1;
 107     }
 108
 109     my $speriod = timelocal(0,0,0,1,$smonth-1,$syear);
 110     push @{$data{speriod}}, $speriod;
 111     if ( ++$smonth == 13 ) { $syear++; $smonth=1; }
 112     my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear);
 113     push @{$data{eperiod}}, $eperiod;
 114
 115     my $col = 0;
 116     my @items = @{$self->{'items'}};
 117     my $i;
 118
 119     for ( $i = 0; $i < scalar(@items); $i++ ) {
 120       if ( $self->{'doublemonths'} ) {
 121         my $item = $items[$i];
 122         my @param = $self->{'params'} ? @{ $self->{'params'}[$i] }: ();
 123         push @param, 'project', $projecting;
 124         my $value = $self->$item($speriod, $eperiod, $agentnum, @param);
 125         push @{$data{data}->[$col]}, $value;
 126         $item = $items[$i+1];
 127         @param = $self->{'params'} ? @{ $self->{'params'}[++$i] }: ();
 128         push @param, 'project', $projecting;
 129         $value = $self->$item($speriod, $eperiod, $agentnum, @param);
 130         push @{$data{data}->[$col++]}, $value;
 131       }
 132       else {
 133         my $item = $items[$i];
 134         my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: ();
 135         push @param, 'project', $projecting;
 136         my $value = $self->$item($speriod, $eperiod, $agentnum, @param);
 137         push @{$data{data}->[$col++]}, $value;
 138       }
 139     }
 140
 141   }
 142
 143   #these need to get generalized, sheesh
 144   $data{'items'}       = $self->{'items'};
 145   $data{'item_labels'} = $self->{'item_labels'} || $self->{'items'};
 146   $data{'colors'}      = $self->{'colors'};
 147   $data{'links'}       = $self->{'links'} || [];
 148
 149   if ( $self->{'remove_empty'} ) {
 150
 151     my $col = 0;
 152     #these need to get generalized, sheesh
 153     #(though we now return a list of item indices that are present in the
 154     #output, so the front-end code could do this)
 155     my @newitems = ();
 156     my @newlabels = ();
 157     my @newdata = ();
 158     my @newcolors = ();
 159     my @newlinks = ();
 160     my @indices = ();
 161     foreach my $item ( @{$self->{'items'}} ) {
 162
 163       if ( grep { $_ != 0 } @{$data{'data'}->[$col]} ) {
 164         push @newitems,  $data{'items'}->[$col];
 165         push @newlabels, $data{'item_labels'}->[$col];
 166         push @newdata,   $data{'data'}->[$col];
 167         push @newcolors, $data{'colors'}->[$col];
 168         push @newlinks,  $data{'links'}->[$col];
 169         push @indices,   $col;
 170       }
 171
 172       $col++;
 173     }
 174
 175     $data{'items'}       = \@newitems;
 176     $data{'item_labels'} = \@newlabels;
 177     $data{'data'}        = \@newdata;
 178     $data{'colors'}      = \@newcolors;
 179     $data{'links'}       = \@newlinks;
 180     $data{'indices'}     = \@indices;
 181
 182   }
 183   # clean up after ourselves
 184   dbh->rollback;
 185   # may be useful for debugging
 186   #dbh->commit;
 187
 188   \%data;
 189 }
 190
 191 =back
 192
 193 =head1 BUGS
 194
 195 Documentation.
 196
 197 =head1 SEE ALSO
 198
 199 =cut
 200
 201 1;
 202