X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FReport%2FTable%2FMonthly.pm;h=802d883121a99ea227323fd536a0898983969276;hb=665109510114cf56e5ebd8eda0bef24b12ca41a2;hp=9ef108c447110f35848335bb1658a338b0018834;hpb=02ffd747f8cbc05815c0d96f437c507cfac04ba6;p=freeside.git diff --git a/FS/FS/Report/Table/Monthly.pm b/FS/FS/Report/Table/Monthly.pm index 9ef108c44..802d88312 100644 --- a/FS/FS/Report/Table/Monthly.pm +++ b/FS/FS/Report/Table/Monthly.pm @@ -1,15 +1,13 @@ package FS::Report::Table::Monthly; use strict; -use vars qw( @ISA $expenses_kludge ); -use Time::Local; -use FS::UID qw( dbh ); +use vars qw( @ISA ); +use FS::UID qw(dbh); use FS::Report::Table; +use Time::Local qw( timelocal ); @ISA = qw( FS::Report::Table ); -$expenses_kludge = 0; - =head1 NAME FS::Report::Table::Monthly - Tables of report data, indexed monthly @@ -24,6 +22,11 @@ FS::Report::Table::Monthly - Tables of report data, indexed monthly 'start_year' => 2000, 'end_month' => 4, 'end_year' => 2020, + #opt + 'agentnum' => 54 + 'params' => [ [ 'paramsfor', 'item_one' ], [ 'item', 'two' ] ], # ... + 'remove_empty' => 1, #collapse empty rows, default 0 + 'item_labels' => [ ], #useful with remove_empty ); my $data = $report->data; @@ -39,181 +42,150 @@ Returns a hashref of data (!! describe) =cut sub data { + local $FS::UID::AutoCommit = 0; my $self = shift; - my $smonth = $self->{'start_month'}; - my $syear = $self->{'start_year'}; - my $emonth = $self->{'end_month'}; - my $eyear = $self->{'end_year'}; + my $smonth = $self->{'start_month'}; + my $syear = $self->{'start_year'}; + my $emonth = $self->{'end_month'}; + my $eyear = $self->{'end_year'}; + # how far to extrapolate into the future + my $pmonth = $self->{'project_month'}; + my $pyear = $self->{'project_year'}; + + # sanity checks + if ( $eyear < $syear or + ($eyear == $syear and $emonth < $smonth) ) { + return { error => 'Start month must be before end month' }; + } + my $agentnum = $self->{'agentnum'}; - my %data; + if ( $pyear > $eyear or + ($pyear == $eyear and $pmonth > $emonth) ) { - while ( $syear < $eyear || ( $syear == $eyear && $smonth < $emonth+1 ) ) { + # create the entire projection set first to avoid timing problems - push @{$data{label}}, "$smonth/$syear"; + $self->init_projection if $pmonth; - my $speriod = timelocal(0,0,0,1,$smonth-1,$syear); - push @{$data{speriod}}, $speriod; - if ( ++$smonth == 13 ) { $syear++; $smonth=1; } - my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear); - push @{$data{eperiod}}, $eperiod; - - foreach my $item ( @{$self->{'items'}} ) { - push @{$data{$item}}, $self->$item($speriod, $eperiod, $agentnum); - } + my $thisyear = $eyear; + my $thismonth = $emonth; + while ( $thisyear < $pyear || + ( $thisyear == $pyear and $thismonth <= $pmonth ) + ) { + my $speriod = timelocal(0,0,0,1,$thismonth-1,$thisyear); + $thismonth++; + if ( $thismonth == 13 ) { $thisyear++; $thismonth = 1; } + my $eperiod = timelocal(0,0,0,1,$thismonth-1,$thisyear); + $self->extend_projection($speriod, $eperiod); + } } - \%data; + my %data; -} + my $max_year = $pyear || $eyear; + my $max_month = $pmonth || $emonth; -sub invoiced { #invoiced - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $self->scalar_sql(" - SELECT SUM(charged) - FROM cust_bill - LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum) - ); -} + my $projecting = 0; # are we currently projecting? -sub netsales { #net sales - my( $self, $speriod, $eperiod, $agentnum ) = @_; + while ( $syear < $max_year + || ( $syear == $max_year && $smonth < $max_month+1 ) ) { - my $credited = $self->scalar_sql(" - SELECT SUM(cust_credit_bill.amount) - FROM cust_credit_bill - LEFT JOIN cust_bill USING ( invnum ) - LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, 'cust_bill') - ); + if ( $self->{'doublemonths'} ) { + my($firstLabel,$secondLabel) = @{$self->{'doublemonths'}}; + push @{$data{label}}, "$smonth/$syear $firstLabel"; + push @{$data{label}}, "$smonth/$syear $secondLabel"; + } + else { + push @{$data{label}}, "$smonth/$syear"; + } - #horrible local kludge - my $expenses = !$expenses_kludge ? 0 : $self->scalar_sql(" - SELECT SUM(cust_bill_pkg.setup) - FROM cust_bill_pkg - LEFT JOIN cust_bill USING ( invnum ) - LEFT JOIN cust_main USING ( custnum ) - LEFT JOIN cust_pkg USING ( pkgnum ) - LEFT JOIN part_pkg USING ( pkgpart ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, 'cust_bill'). " - AND LOWER(part_pkg.pkg) LIKE 'expense _%' - "); - - $self->invoiced($speriod,$eperiod,$agentnum) - $credited - $expenses; -} + if ( $syear > $eyear || ( $syear == $eyear && $smonth >= $emonth + 1 ) ) { + # start getting data from the projection + $projecting = 1; + } -#deferred revenue + my $speriod = timelocal(0,0,0,1,$smonth-1,$syear); + push @{$data{speriod}}, $speriod; + if ( ++$smonth == 13 ) { $syear++; $smonth=1; } + my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear); + push @{$data{eperiod}}, $eperiod; -sub receipts { #cashflow - my( $self, $speriod, $eperiod, $agentnum ) = @_; + my $col = 0; + my @items = @{$self->{'items'}}; + my $i; + + for ( $i = 0; $i < scalar(@items); $i++ ) { + if ( $self->{'doublemonths'} ) { + my $item = $items[$i]; + my @param = $self->{'params'} ? @{ $self->{'params'}[$i] }: (); + push @param, 'project', $projecting; + my $value = $self->$item($speriod, $eperiod, $agentnum, @param); + push @{$data{data}->[$col]}, $value; + $item = $items[$i+1]; + @param = $self->{'params'} ? @{ $self->{'params'}[++$i] }: (); + push @param, 'project', $projecting; + $value = $self->$item($speriod, $eperiod, $agentnum, @param); + push @{$data{data}->[$col++]}, $value; + } + else { + my $item = $items[$i]; + my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: (); + push @param, 'project', $projecting; + my $value = $self->$item($speriod, $eperiod, $agentnum, @param); + push @{$data{data}->[$col++]}, $value; + } + } - my $refunded = $self->scalar_sql(" - SELECT SUM(refund) - FROM cust_refund - LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum) - ); + } - #horrible local kludge that doesn't even really work right - my $expenses = !$expenses_kludge ? 0 : $self->scalar_sql(" - SELECT SUM(cust_bill_pay.amount) - FROM cust_bill_pay - LEFT JOIN cust_bill USING ( invnum ) - LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, 'cust_bill_pay'). " - AND 0 < ( SELECT COUNT(*) from cust_bill_pkg, cust_pkg, part_pkg - WHERE cust_bill.invnum = cust_bill_pkg.invnum - AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum - AND cust_pkg.pkgpart = part_pkg.pkgpart - AND LOWER(part_pkg.pkg) LIKE 'expense _%' - ) - "); - # my $expenses_sql2 = "SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay, cust_bill_pkg, cust_bill, cust_pkg, part_pkg WHERE cust_bill_pay.invnum = cust_bill.invnum AND cust_bill.invnum = cust_bill_pkg.invnum AND cust_bill_pay._date >= $speriod AND cust_bill_pay._date < $eperiod AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum AND cust_pkg.pkgpart = part_pkg.pkgpart AND LOWER(part_pkg.pkg) LIKE 'expense _%'"; - - $self->payments($speriod, $eperiod, $agentnum) - $refunded - $expenses; -} + #these need to get generalized, sheesh + $data{'items'} = $self->{'items'}; + $data{'item_labels'} = $self->{'item_labels'} || $self->{'items'}; + $data{'colors'} = $self->{'colors'}; + $data{'links'} = $self->{'links'} || []; + + if ( $self->{'remove_empty'} ) { + + my $col = 0; + #these need to get generalized, sheesh + #(though we now return a list of item indices that are present in the + #output, so the front-end code could do this) + my @newitems = (); + my @newlabels = (); + my @newdata = (); + my @newcolors = (); + my @newlinks = (); + my @indices = (); + foreach my $item ( @{$self->{'items'}} ) { -sub payments { - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $self->scalar_sql(" - SELECT SUM(paid) - FROM cust_pay - LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum) - ); -} + if ( grep { $_ != 0 } @{$data{'data'}->[$col]} ) { + push @newitems, $data{'items'}->[$col]; + push @newlabels, $data{'item_labels'}->[$col]; + push @newdata, $data{'data'}->[$col]; + push @newcolors, $data{'colors'}->[$col]; + push @newlinks, $data{'links'}->[$col]; + push @indices, $col; + } -sub credits { - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $self->scalar_sql(" - SELECT SUM(amount) - FROM cust_credit - LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum) - ); -} + $col++; + } -# NEEDS TO BE AGENTNUM-capable -sub canceled { #active - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $self->scalar_sql(" - SELECT COUNT(*) - FROM cust_pkg - LEFT JOIN cust_main USING ( custnum ) - WHERE 0 = ( SELECT COUNT(*) - FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - ) - AND cust_pkg.cancel > $speriod AND cust_pkg.cancel < $eperiod - "); -} - -# NEEDS TO BE AGENTNUM-capable -sub newaccount { #newaccount - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $self->scalar_sql(" - SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) - AND cust_pkg.setup > $speriod AND cust_pkg.setup < $eperiod - "); -} - -# NEEDS TO BE AGENTNUM-capable -sub suspended { #suspended - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $self->scalar_sql(" - SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - AND 0 = ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) - ) - AND cust_pkg.susp > $speriod AND cust_pkg.susp < $eperiod - "); -} + $data{'items'} = \@newitems; + $data{'item_labels'} = \@newlabels; + $data{'data'} = \@newdata; + $data{'colors'} = \@newcolors; + $data{'links'} = \@newlinks; + $data{'indices'} = \@indices; -sub in_time_period_and_agent { - my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4); - my $table = @_ ? shift().'.' : ''; - my $sql = "${table}_date >= $speriod AND ${table}_date < $eperiod"; - $sql .= " AND agentnum = $agentnum" - if $agentnum; - $sql; -} + } + # clean up after ourselves + dbh->rollback; + # may be useful for debugging + #dbh->commit; -sub scalar_sql { - my( $self, $sql ) = ( shift, shift ); - my $sth = dbh->prepare($sql) or die dbh->errstr; - $sth->execute - or die "Unexpected error executing statement $sql: ". $sth->errstr; - $sth->fetchrow_arrayref->[0] || 0; + \%data; } =back