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   # whether to extrapolate into the future
  53   my $projecting = $self->{'projection'};
  54
  55   # sanity checks
  56   if ( $eyear < $syear or
  57       ($eyear == $syear and $emonth < $smonth) ) {
  58     return { error => 'Start month must be before end month' };
  59   }
  60
  61   my $agentnum = $self->{'agentnum'};
  62
  63   if ( $projecting ) {
  64
  65     $self->init_projection;
  66
  67     my $thismonth = $smonth;
  68     my $thisyear  = $syear;
  69     while ( $thisyear < $eyear ||
  70       ( $thisyear == $eyear and $thismonth <= $emonth )
  71     ) {
  72       my $speriod = timelocal(0,0,0,1,$thismonth-1,$thisyear);
  73       $thismonth++;
  74       if ( $thismonth == 13 ) { $thisyear++; $thismonth = 1; }
  75       my $eperiod = timelocal(0,0,0,1,$thismonth-1,$thisyear);
  76
  77       $self->extend_projection($speriod, $eperiod);
  78     }
  79   }
  80
  81   my %data;
  82
  83   my $max_year  = $eyear;
  84   my $max_month = $emonth;
  85
  86   while ( $syear < $max_year
  87      || ( $syear == $max_year && $smonth < $max_month+1 ) ) {
  88
  89     if ( $self->{'doublemonths'} ) {
  90       my($firstLabel,$secondLabel) = @{$self->{'doublemonths'}};
  91       push @{$data{label}}, "$smonth/$syear $firstLabel";
  92       push @{$data{label}}, "$smonth/$syear $secondLabel";
  93     }
  94     else {
  95       push @{$data{label}}, "$smonth/$syear";
  96     }
  97
  98     my $speriod = timelocal(0,0,0,1,$smonth-1,$syear);
  99     push @{$data{speriod}}, $speriod;
 100     if ( ++$smonth == 13 ) { $syear++; $smonth=1; }
 101     my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear);
 102     push @{$data{eperiod}}, $eperiod;
 103
 104     my $col = 0;
 105     my @items = @{$self->{'items'}};
 106     my $i;
 107
 108     for ( $i = 0; $i < scalar(@items); $i++ ) {
 109       if ( $self->{'doublemonths'} ) {
 110         my $item = $items[$i];
 111         my @param = $self->{'params'} ? @{ $self->{'params'}[$i] }: ();
 112         push @param, 'project', $projecting;
 113         my $value = $self->$item($speriod, $eperiod, $agentnum, @param);
 114         push @{$data{data}->[$col]}, $value;
 115         $item = $items[$i+1];
 116         @param = $self->{'params'} ? @{ $self->{'params'}[++$i] }: ();
 117         push @param, 'project', $projecting;
 118         $value = $self->$item($speriod, $eperiod, $agentnum, @param);
 119         push @{$data{data}->[$col++]}, $value;
 120       }
 121       else {
 122         my $item = $items[$i];
 123         my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: ();
 124         push @param, 'project', $projecting;
 125         my $value = $self->$item($speriod, $eperiod, $agentnum, @param);
 126         push @{$data{data}->[$col++]}, $value;
 127       }
 128     }
 129
 130   }
 131
 132   #these need to get generalized, sheesh
 133   $data{'items'}       = $self->{'items'};
 134   $data{'item_labels'} = $self->{'item_labels'} || $self->{'items'};
 135   $data{'colors'}      = $self->{'colors'};
 136   $data{'links'}       = $self->{'links'} || [];
 137
 138   if ( $self->{'remove_empty'} ) {
 139
 140     my $col = 0;
 141     #these need to get generalized, sheesh
 142     #(though we now return a list of item indices that are present in the
 143     #output, so the front-end code could do this)
 144     my @newitems = ();
 145     my @newlabels = ();
 146     my @newdata = ();
 147     my @newcolors = ();
 148     my @newlinks = ();
 149     my @indices = ();
 150     foreach my $item ( @{$self->{'items'}} ) {
 151
 152       if ( grep { $_ != 0 } @{$data{'data'}->[$col]} ) {
 153         push @newitems,  $data{'items'}->[$col];
 154         push @newlabels, $data{'item_labels'}->[$col];
 155         push @newdata,   $data{'data'}->[$col];
 156         push @newcolors, $data{'colors'}->[$col];
 157         push @newlinks,  $data{'links'}->[$col];
 158         push @indices,   $col;
 159       }
 160
 161       $col++;
 162     }
 163
 164     $data{'items'}       = \@newitems;
 165     $data{'item_labels'} = \@newlabels;
 166     $data{'data'}        = \@newdata;
 167     $data{'colors'}      = \@newcolors;
 168     $data{'links'}       = \@newlinks;
 169     $data{'indices'}     = \@indices;
 170
 171   }
 172   # clean up after ourselves
 173   #dbh->rollback;
 174   # leave in until development is finished, for diagnostics
 175   dbh->commit;
 176
 177   \%data;
 178 }
 179
 180 =back
 181
 182 =head1 BUGS
 183
 184 Documentation.
 185
 186 =head1 SEE ALSO
 187
 188 =cut
 189
 190 1;
 191