File Coverage

blib/lib/Data/Tabular.pm

Criterion	Covered	Total	%
statement	71	80	88.7
branch	11	18	61.1
condition	4	7	57.1
subroutine	17	19	89.4
pod	10	10	100.0
total	113	134	84.3

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

use strict;
use warnings;

package Data::Tabular;

our $VERSION = '0.29';

use Carp qw (croak);

use Data::Tabular::Group;
use Data::Tabular::Table::Extra;
use Data::Tabular::Table::Data;
use Data::Tabular::Config::Output;
use Data::Tabular::Config::Extra;
use Data::Tabular::Extra;

sub new
{
    my $caller = shift;
    my $class = ref($caller) || $caller;
    my $self = bless { @_ }, $class;

    my $extra  = Data::Tabular::Config::Extra->new(
	headers => $self->{extra_headers},
	columns => $self->{extra},
	types => $self->{extra_types},
    );

    if (ref($caller)) {
        die q|Don't know how to copy object.|
	    unless $caller->isa(__PACKAGE__);
	$self = $caller->clone()
    }
    my $count = 0;
    if ($self->{headers}) {
        $self->{_all_headers} = [ (@{$self->{headers} || []}, @{$self->{extra_headers} || []}) ];
        for my $elm (@{$self->{_all_headers}}) {
	    $self->{_header_off}->{$elm} = $count++;
	}
    }
    $self->{data_table} =
	Data::Tabular::Table::Data->new(
	    data => bless({
		headers => $self->{headers},
		rows    => $self->{data},
		types   => $self->{types},
	    }, 'Data::Tabular::Data'),
	);
    $self->{extra_table} =
	 Data::Tabular::Table::Extra->new(
            table => $self->{data_table},
	    extra => $extra,
	);
    $self->{group_by} ||= {};
    if (my $group_by = $self->{group_by}) {
        if (ref $group_by eq 'HASH') {
	    $self->{grouped_table} = Data::Tabular::Group->new(
		table => $self->{extra_table},
		title => $self->{title} || 1,
		%$group_by
	    );
	} else {
	    die "group_by data must be a hash.";
	}
    } else {
die "FIXME";
	$self->{grouped_table} = $self->{extra_table};
    }
    $self;
}

sub headers
{
    my $self = shift;

    $self->{extra_table}->headers;
}

sub output
{
    my $self = shift;
    my $args = { %{$self->{output} || {}}, @_ };

    my $output = Data::Tabular::Config::Output->new(
        headers => [ @{$self->{headers}},
	    $self->{extra_headers} ? @{$self->{extra_headers}} : keys %{$self->{extra}} ],
	%$args,
    );
    $output;
}

sub grouped
{
    my $self = shift;

    $self->{grouped_table};
}

sub extra_table
{
    my $self = shift;

    $self->{extra_table};
}

sub data_table
{
    my $self = shift;

    $self->{data_table};
}

sub html
{
    my $self = shift;

    require Data::Tabular::Output::HTML;

    return Data::Tabular::Output::HTML->new(
        table => $self->grouped,
	output => $self->output,
	@_,
    );
}

sub xls
{
    my $self = shift;
    require Data::Tabular::Output::XLS;

    return Data::Tabular::Output::XLS->new(
	table => $self->grouped,
	output => $self->output,
	@_,
    );
}

sub txt
{
    my $self = shift;
    require Data::Tabular::Output::TXT;

    return Data::Tabular::Output::TXT->new(
	table => $self->grouped,
	output => $self->output,
	@_,
    );
}

sub csv
{
    my $self = shift;
    require Data::Tabular::Output::CSV;

    return Data::Tabular::Output::CSV->new(
	table => $self->grouped,
	output => $self->output,
	@_,
    );
}

1;
__END__