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