view release on metacpan or  search on metacpan

lib/Data/Tabular/Table/Group.pm  view on Meta::CPAN

# Copyright (C) 2003-2007, G. Allen Morris III, all rights reserved

use strict;

package
    Data::Tabular::Table::Group;

use base 'Data::Tabular::Table';

use Data::Tabular::Group::Interface;

sub new
{
    my $class = shift;
    bless { @_ }, $class;
}

sub _row_count
{
    my $self = shift;

    die;
}

sub sum_list
{
    my $self = shift;
    $self->group->sum_list;
}

sub column_sum
{
    my $self = shift;
    my $column_name = shift;
    my $ret;
    if ($ret = $self->{memo}->{$column_name}) {
        return $ret;
    }
    my $formula = '=SUM(';
    my $sum = 0;
    my @rows;
    for my $row ($self->raw_rows) {
        push(@rows, $row->id());
	my $next = $row->get($column_name);
	if (UNIVERSAL::isa($next, 'Data::Tabular::Formula')) {
die;
	    $next = $next->{html};
	}
	$sum += $next;
    }
    require Data::Tabular::Type::Formula;

    $ret = Data::Tabular::Type::Formula->new(
        data => $sum,
	type => 'sum',
	column => $column_name,
	rows => \@rows,
    );

    $self->{memo}->{$column_name} = $ret;
    $ret;
}

sub column_average
{
    my $self = shift;
    my $column_name = shift;
    my $ret;
    if ($ret = $self->{memoa}->{$column_name}) {
        return $ret;
    }
    my $formula = '=SUM(';
    my $sum = 0;
    my @rows;
    my $count = 0;
    for my $row ($self->raw_rows) {
        push(@rows, $row->id());
	my $next = $row->get($column_name);
	if (UNIVERSAL::isa($next, 'Data::Tabular::Formula')) {
die;
	    $next = $next->{html};
	}
	$sum += $next;
	$count++;
    }
    require Data::Tabular::Type::Formula;

    $ret = Data::Tabular::Type::Formula->new(
        data => $sum / $count,
	count => $count,
	type => 'avg',
	column => $column_name,
	rows => \@rows,
    );

    $self->{memoa}->{$column_name} = $ret;
    $ret;
}

sub group
{
    my $self = shift;
    $self->{group};
}

sub headers
{
    my $self = shift;
    $self->group->headers;
}

sub all_headers
{
    my $self = shift;

    $self->group->headers;
}

sub raw_rows
{
    my $self = shift;
    my @ret = ();

    for my $value (@{$self->{data}}) {
	next unless $value;
	if ($value->isa(__PACKAGE__)) {
	    push(@ret, $value->raw_rows);
	} else {
	    push(@ret, $value);
	}
    }
    @ret;