File Coverage

blib/lib/HTML/TableContent/Table.pm

Criterion	Covered	Total	%
statement	170	231	73.5
branch	35	52	67.3
condition			n/a
subroutine	42	47	89.3
pod	31	33	93.9
total	278	363	76.5

package HTML::TableContent::Table;

use Moo;

use HTML::TableContent::Table::Caption;
use HTML::TableContent::Table::Header;
use HTML::TableContent::Table::Row;

our $VERSION = '1.00';

extends 'HTML::TableContent::Element';

has caption => ( is => 'rw', lazy => 1 );

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

has '+html_tag' => (
    default => 'table',
);

my @html5 = qw/html5 thead tbody vertical/;
for (@html5) {
    has $_ => (
        is => 'rw',
        lazy => 1,
        builder => 1,
    );
}

sub _build_html5 {
    return defined $_[0]->attributes->{html5}
        ? delete $_[0]->attributes->{html5}
        : undef;
}

sub _build_thead {
    return defined $_[0]->attributes->{thead}
        ? delete $_[0]->attributes->{thead}
        : undef;
}

sub _build_tbody {
    return defined $_[0]->attributes->{tbody}
        ? delete $_[0]->attributes->{tbody}
        : undef;
}

sub _build_vertical {
    return defined $_[0]->attributes->{vertical}
        ? delete $_[0]->attributes->{vertical}
        : undef;
}

around raw => sub {
    my ( $orig, $self ) = ( shift, shift );

    my $table = $self->$orig(@_);

    if ( defined $self->caption ) { $table->{caption} = $self->caption->text }

    my @headers =  map { $_->raw } $self->all_headers;
    $table->{headers} = \@headers;

    my @rows =  map { $_->raw} $self->all_rows;
    $table->{rows} = \@rows;

    return $table;
};

sub aoa {
    my $aoa = [ ];

    my @headers = map { $_->data->[0] } $_[0]->all_headers;
    if ( scalar @headers > 0 ) {
        push @{ $aoa }, \@headers;
    }

    for ( $_[0]->all_rows ) {
       my @row = $_->array;
       push @{ $aoa }, \@row;
    }

    return $aoa;
};

sub aoh {
    my $aoh = [ ];
    for ($_[0]->all_rows) {
        my $hash = $_->hash;
        push @{ $aoh }, $hash;
    }
    return $aoh;
};

sub add_caption {
    my $caption = HTML::TableContent::Table::Caption->new($_[1]);
    $_[0]->caption($caption);
    return $caption;
}

sub has_caption { return $_[0]->caption ? 1 : 0 };

sub all_rows { return @{ $_[0]->rows }; }

sub add_row {
    my $row = HTML::TableContent::Table::Row->new($_[1]);
    push @{ $_[0]->rows }, $row;
    return $row;
}

sub row_count { return scalar @{ $_[0]->rows }; }

sub get_row { return $_[0]->rows->[ $_[1] ]; }

sub get_first_row { return $_[0]->get_row(0); }

sub get_last_row { return $_[0]->get_row( $_[0]->row_count - 1 ); }

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

sub clear_first_row { return shift @{ $_[0]->rows }; }

sub clear_last_row { return $_[0]->clear_row($_[0]->row_count - 1); }

sub all_headers { return @{ $_[0]->headers }; }

sub add_header {
    my $header = HTML::TableContent::Table::Header->new($_[1]);
    push @{ $_[0]->headers }, $header;
    return $header;
}

sub header_count { return scalar @{ $_[0]->headers }; }

sub get_header { return $_[0]->headers->[ $_[1] ]; }

sub get_first_header { return $_[0]->get_header(0); }

sub get_last_header { return $_[0]->get_header($_[0]->header_count - 1); }

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

sub clear_first_header { return shift @{ $_[0]->headers } }

sub clear_last_header { return $_[0]->clear_header( $_[0]->header_count - 1 ); }

sub _render_element {
   return defined $_[0]->vertical ? $_[0]->_render_vertical_table : $_[0]->_render_horizontal_table;
}

sub _render_vertical_table {
    my $args = $_[0]->attributes;

    my @table_rows = ( );

    if ( $_[0]->has_caption ) {
        push @table_rows, $_[0]->caption->render;
    }

    for my $header ($_[0]->all_headers) {
        my @row = ( );
        push @row, $header->render;
        for ($header->all_cells) {
            push @row, $_->render;
        }
        push @table_rows, sprintf '
    }

    my $table = join '', @table_rows;

    return $table;
}

sub _render_horizontal_table {
    my $args = $_[0]->attributes;

    my @table_rows = ( );

    if ( $_[0]->has_caption ) {
        push @table_rows, $_[0]->caption->render;
    }

    if ( $_[0]->header_count ) {
        my @headers = map { $_->render } $_[0]->all_headers;
        my $headers = sprintf '%s' x @headers, @headers;
        my $header_row = sprintf '
        if ( $_[0]->html5 ) {
            my $attr = $_[0]->_generate_element_attr('thead');
            $header_row = sprintf '
        }
        push @table_rows, $header_row;
    }

    if ($_[0]->row_count) {
        my @rows = map { $_->render } $_[0]->all_rows;
        my $row = sprintf '%s' x @rows, @rows;
        if ( $_[0]->html5 ) {
            my $attr = $_[0]->_generate_element_attr('tbody');
            $row = sprintf '
        }
        push @table_rows, $row;
    }

    my $table = sprintf '%s' x @table_rows, @table_rows;
    return $table;
}

sub _generate_element_attr {
    my ($self, $element) = @_;
    my $attr = '';
    if ( my $attributes = $self->$element ) {
        for ( keys %{ $attributes } ) {
            $attr .= sprintf '%s="%s" ', $_, $attributes->{$_};
        }
    }
    return $attr;
}

sub headers_spec {
    my $headers = {};
    map { $headers->{ $_->lc_text }++ } $_[0]->all_headers;
    return $headers;
}

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

    my $headers_spec = $self->headers_spec;
    for (@headers) { return 1 if $headers_spec->{ lc $_ } }
    return 0;
}

sub get_col {
    my %args = ( header => $_[1] );
    return $_[0]->get_header_column(%args);
}

sub get_col_text {
    my %args = ( header => $_[1] );
    return $_[0]->get_header_column_text(%args);
}

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

    my @cells  = ();
    my $column = $args{header};
    foreach my $header ( $self->all_headers ) {
        if ( $header->lc_text =~ m{$column}ixms ) {
            for ( $header->all_cells ) {
                push @cells, $_;
            }
        }
    }

    if ( defined $args{dedupe} ) {
        @cells = $self->_dedupe_object_array_not_losing_order(@cells);
    }

    return \@cells;
}

sub parse_to_column {
    my ($self, $cell) = @_;

    my $row = $self->get_last_row;

    my $header;
    if ( my $row_header = $row->header ) {
        $header = $row_header;
    }
    else {
        my $cell_index = $row->cell_count;
        $header = $self->headers->[$cell_index - 1];
    }

    return unless $header;

    $cell->header($header);
    push @{ $header->cells }, $cell;

    return 1;
}

sub get_header_column_text {
    my ( $self, %args ) = @_;
    my $cells = $self->get_header_column(%args);
    my @cell_text = map { $_->text } @{$cells};
    return \@cell_text;
}

sub has_nested_table_column {
    my $self = shift;
    for my $header ( $self->all_headers ) {
        for ( $header->all_cells ) {
            return 1 if $_->has_nested;
        }
    }
    return 0;
}

sub nested_column_headers {
    my $self = shift;

    my $columns = {};
    for my $header ( $self->all_headers ) {
        my $cell = $header->get_first_cell;
        if ( $cell->has_nested ) {
            $columns->{ $header->lc_text }++;
        }
    }
    return $columns;
}

sub _dedupe_object_array_not_losing_order {
    my ( $self, @items ) = @_;

    # someone could probably do this in one line :)
    my %args;
    my @new_items = ();
    foreach my $item (@items) {
        if ( !defined $args{ $item->text } ) {
            $args{ $item->text }++;
            push @new_items, $item;
        }
    }

    return @new_items;
}

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

    my $headers = [];
    foreach my $header ( $self->all_headers ) {
        for (@headers) {
            if ( $header->lc_text =~ m/$_/ims ) {
                push @{$headers}, $header;
            }
        }
    }

    $self->headers($headers);

    foreach my $row ( $self->all_rows ) {
        $row->_filter_headers($headers);
    }

    return 1;
}

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

    my @remove_cell;
    for my $index (0 .. $self->header_count - 1) {
        for (@headers) {
            if ( $self->headers->[$index]->lc_text =~ m/$_/ims ){
                $self->clear_header($index);
                push @remove_cell, $index;
            }
        }
    }

    foreach my $row ($self->all_rows ) {
        for (@remove_cell) {
            $row->clear_cell($_);
         }
    }

    return 1;
}

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

    if ( my $order = $options->{order}) {
        my $headers = [ ];
        foreach my $header (@{ $order }) {
            push @{ $headers }, map { $_ } grep { $_->text =~ m/$header/ixms } $self->all_headers;
        }
        $self->headers($headers);

        foreach my $row ( $self->all_rows ) {
            my $cells = [ ];
            foreach my $header (@{ $order }) {
                push @{ $cells }, grep { $_->header->text =~ m/$header/ixms } $row->all_cells;
            }
            $row->cells($cells);
        }
    }

    if ( my $order = $options->{order_template}) {
        my $headers = [ ];
        foreach my $header (@{ $order }) {
            push @{ $headers }, map { $_ } grep { $_->template_attr =~ m/$header/ixms } $self->all_headers;
        }
        $self->headers($headers);

        foreach my $row ( $self->all_rows ) {
            my $cells = [ ];
            foreach my $header (@{ $order }) {
                push @{ $cells }, grep { $_->header->text =~ m/$header/ixms } $row->all_cells;
            }
            $row->cells($cells);
        }
    }


    return $self;
}


__PACKAGE__->meta->make_immutable;

1;

__END__