File Coverage

blib/lib/HTML/TableContent.pm

Criterion	Covered	Total	%
statement	147	158	93.0
branch	23	28	82.1
condition	3	5	60.0
subroutine	23	25	92.0
pod	18	18	100.0
total	214	234	91.4

package HTML::TableContent;

use Carp qw/croak carp/;
use Moo;

use HTML::TableContent::Parser;
use HTML::TableContent::Table;

our $VERSION = '1.00';

has parser => (
    is      => 'rw',
    lazy => 1,
    default => sub { return HTML::TableContent::Parser->new() },
);

has tables => (
    is      => 'rw',
    lazy    => 1,
    default => sub { [] },
);

sub all_tables { return @{ $_[0]->tables }; }

sub add_table {
    my $table = HTML::TableContent::Table->new($_[1]);
    push @{ $_[0]->tables }, $table;
    return $table;
}

sub add_caption_selectors { return push (@{ $_[0]->parser->caption_selectors }, @{ $_[1] }); }

sub get_table { return $_[0]->tables->[ $_[1] ]; }

sub get_first_table { return $_[0]->get_table(0); }

sub get_last_table { return $_[0]->get_table($_[0]->table_count - 1); }

sub clear_table { return splice @{ $_[0]->tables }, $_[1], 1; }

sub clear_first_table { return shift @{ $_[0]->tables }; }

sub clear_last_table { return $_[0]->clear_table( $_[0]->table_count - 1 ); }

sub table_count { return scalar @{ $_[0]->tables }; }

sub filter_tables {
    my ( $self, %args ) = @_;

    my $tables = [];

    my @headers = ();
    if ( defined $args{headers} ) {
        push @headers, @{ $args{headers} };
    }
    elsif ( defined $args{header} ) {
        push @headers, $args{header};
    }

    foreach my $table ( $self->all_tables ) {
        if ( $table->header_exists(@headers) ) {
            $table->_filter_headers(@headers);
            push @{$tables}, $table;
        }
    }

    if ( $args{flex} && !scalar @{$tables} ) {
        carp 'none of the passed headers exist in any of the tables aborting filter - %s',
          join q{ }, @headers;
        return;
    }

    return $self->tables($tables);
}

sub headers_spec {
    my $self = shift;

    my $headers = {};
    for my $table ( $self->all_tables ) {
        for ( $table->all_headers ) { $headers->{ $_->lc_text }++ }
    }

    return $headers;
}

sub headers_exist {
    my ( $self, @headers ) = @_;

    my $header_spec = $self->headers_spec;

    for (@headers) { return 1 if $header_spec->{ lc $_ } }

    return 0;
}

sub raw {
    my $self = shift;

    my @tables = map { $_->raw } $self->all_tables;
    return \@tables;
}

sub render {
    my $self = shift;

    my @tables = map { $_->render } $self->all_tables;
    my $html = sprintf '%s' x @tables, @tables;
    return $html;
}

sub parse {
    my ( $self, $data ) = @_;

    $data =~ s/\<\!--|--\!\>//g;
    $self->parser->clear_current_tables;
    my $current_tables = $self->parser->parse($data);
    push @{ $self->tables }, @{$current_tables};
    return $current_tables;
}

sub parse_file {
    my ( $self, $file ) = @_;

    $self->parser->clear_current_tables;
    my $current_tables = $self->parser->parse_file($file);
    push @{ $self->tables }, @{$current_tables};
    return $current_tables;
}

sub create_table {
    my ($self, $options) = @_;

    my $table_options = delete $options->{table} || { };

    my $table = $self->add_table($table_options);

    if ( exists $options->{aoa} ) {
        $table = $self->_create_from_aoa($table, $options);
    }
    elsif ( exists $options->{aoh} ) {
       $table = $self->_create_from_aoh($table, $options);
    }
    else {
        croak 'create_tables currently requires an array of arrays or an array of hashes representing the data.';
     }

    return $table;
}

sub _create_from_aoh {
    my ($self, $table, $options) = @_;

    my $aoh = $options->{aoh};
    my @headers = keys %{ $aoh->[0] };

    if (my $order = $options->{order}){
        my @heads = ( );
        foreach my $header (@{ $order }) {
            push @heads, grep { $_ =~ m/$header/ixms } @headers;
        }
        @headers = @heads;
    }

    unless ( defined $options->{no_headers} ) {
        for (@headers) {
            my $header_options = $self->_create_options('header', $options);
            $header_options->{text} = $_;
            $table->add_header($header_options);
        }
        @headers = $table->all_headers;
    }

    foreach my $hash ( @{ $aoh } ) {
        $options->{cells} =  $options->{rows}->[0]->{cells};
        my $row_options = $self->_create_options('row', $options);
        my $row = $table->add_row($row_options);
        for (@headers) {
            my $text = defined $options->{no_headers} ? $_ : $_->text;
            my $cell_options = $self->_create_options('cell', $options);
            $cell_options->{text} = $hash->{$text};
            my $cell = $row->add_cell($cell_options);
            unless ( defined $options->{no_headers} ) {
                $cell->header($_);
                push @{ $_->cells }, $cell;
            }
        }
    }

    return $table;
}

sub _create_from_aoa {
    my ($self, $table, $options) = @_;

    my @aoa = @{ $options->{aoa}};

    unless ( defined $options->{no_headers} ) {
        my $headers = shift @aoa;

        foreach my $header ( @{ $headers }) {
            my $header_options = $self->_create_options('header', $options);

            $header_options->{text} = $header;
            $table->add_header($header_options);
        }
    }

    for my $array ( @aoa ) {
        $options->{cells} = $options->{rows}->[0]->{cells};
        my $row_options = $self->_create_options('row', $options);
        my $row = $table->add_row($row_options);

        for my $text ( @{ $array } ) {
            my $cell_options = $self->_create_options('cell', $options);

            $cell_options->{text} = $text;

            my $cell = $row->add_cell($cell_options);
            $table->parse_to_column($cell);
        }
    }

    return $table;
}

sub _create_options {
    my ($self, $element, $options) = @_;

    my $element_options = { };

    if ( my $base = $options->{$element} ) {
        for ( keys %{ $base } ) {
            $element_options->{$_} = $base->{$_};
        }
    }

    my $elements = $element . 's';

    if ( my $custom = $options->{$elements} ) {
        my $first = shift @{ $options->{$elements} };
        for ( keys %{ $first } ) {
            $element_options->{$_} = $first->{$_};
        }
    }

    return $element_options;
}

__PACKAGE__->meta->make_immutable;

1;

__END__