File Coverage

blib/lib/HTML/TableContent/Parser.pm

Criterion	Covered	Total	%
statement	110	117	94.0
branch	44	44	100.0
condition	5	6	83.3
subroutine	20	23	86.9
pod	7	13	53.8
total	186	203	91.6

package HTML::TableContent::Parser;

use Moo;

our $VERSION = '1.00';

extends 'HTML::Parser';

use HTML::TableContent::Table;

has [qw(current_tables nested caption_selectors)] => (
    is      => 'rw',
    lazy    => 1,
    clearer => 1,
    default => sub { [] },
);

has [qw(current_table current_element selected)] => (
    is      => 'rw',
    lazy    => 1,
    clearer => 1,
);

has options => (
    is      => 'ro',
    lazy    => 1,
    builder => 1,
);

sub has_caption_selector { return scalar @{ $_[0]->caption_selectors } ? 1 : 0 }

sub count_nested { return scalar @{ $_[0]->nested }; }

sub has_nested { return $_[0]->count_nested ? 1 : 0; }

sub get_last_nested { return $_[0]->nested->[ $_[0]->count_nested - 1 ]; }

sub clear_last_nested {
    return delete $_[0]->nested->[ $_[0]->count_nested - 1 ];
}

sub all_current_tables { return @{ $_[0]->current_tables }; }

sub count_current_tables { return scalar @{ $_[0]->current_tables }; }

sub current_or_nested {
    return $_[0]->has_nested ? $_[0]->get_last_nested : $_[0]->current_table;
}

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

    $self->SUPER::parse($data);

    return $self->current_tables;
}

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

    $self->SUPER::parse_file($file);

    return $self->current_tables;
}

sub start {
    my ( $self, $tag, $attr, $attrseq, $origtext ) = @_;

    if ($self->current_element && $attr->{href}) {
        push @{ $self->current_element->links }, $attr->{href};
    }

    $tag = lc $tag;
    if ( my $option = $self->options->{$tag} ) {
        my $table = $self->current_or_nested;
        my $action = $option->{add};
        my $element = $self->$action($attr, $table);
        return $self->current_element($element);
    }

    if ( $self->has_caption_selector ) {
        foreach my $selector ( @{ $self->caption_selectors }) {
            if ( $selector eq $tag ) {
                return $self->selected($attr);
            }

            for my $field (qw/id class/) {
                my $val = $attr->{$field};
                next unless $val;

                if ( $val =~ m/$selector/ixms) {
                    return $self->selected($attr);
                }
            }
        }
    }

    return;
}

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

    if ( my $elem = $self->current_element ) {
        if ( $text =~ m{\S+}xms ) {
            $text =~ s{^\s+|\s+$}{}g;
            push @{ $elem->data }, $text;
        }
    }
    if ( my $selected = $self->selected) {
        if ( $text =~ m{\S+}xms ) {
            $selected->{text} = $text;
            $self->selected($selected);
        }
    }

    return;
}

sub end {
    my ( $self, $tag, $origtext ) = @_;

    $tag = lc $tag;

    if ( my $option = $self->options->{$tag} ) {
        my $table = $self->current_or_nested;
        if ( my $action = $option->{close} ) {
            my $element = $self->$action($table);
        }
    }

    return;
}

sub _build_options {
    return {
        table => {
            add => '_add_table',
            close => '_close_table',
        },
        th => {
            add => '_add_header',
        },
        tr => {
            add => '_add_row',
            close => '_close_row',
        },
        td => {
            add => '_add_cell',
        },
        caption => {
            add => '_add_caption'
        }
    };
}

sub _add_header {
    my ($self, $attr, $table) = @_;

    my $header = $table->add_header($attr);
    $table->get_last_row->header($header);
    return $header;
}

sub _add_row {
    my ($self, $attr, $table) = @_;

    my $row = $table->add_row($attr);
    return $row;
}

sub _add_cell {
    my ($self, $attr, $table) = @_;

    my $cell = $table->get_last_row->add_cell($attr);
    $table->parse_to_column($cell);
    return $cell;
}

sub _add_caption {
    my ($self, $attr, $table) = @_;

    my $caption = $table->add_caption($attr);
    return $caption;
}

sub _add_table {
    my ($self, $attr, $table) = @_;

    my $element = HTML::TableContent::Table->new($attr);

    if ( defined $table && $table->isa('HTML::TableContent::Table') ) {
        if ( $self->has_nested ) {
            push @{ $self->current_table->nested }, $element;
        }
        push @{ $self->nested }, $element;
        push @{ $table->nested }, $element;
        push @{ $table->get_last_row->get_last_cell->nested }, $element;
    }
    else {
        if ( my $caption = $self->selected ){
            $element->add_caption($caption);
            $self->clear_selected;
        }
        $self->current_table($element);
    }
}

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

    if ( $self->has_nested ) {
        return $self->clear_last_nested;
    }
    else {
        push @{ $self->current_tables }, $self->current_table;
        $self->clear_current_element;
        return $self->clear_current_table;
    }
}

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

    my $row = $table->get_last_row;

    if ( $row->header ) {
        $table->clear_last_row;

        my $index = 0;
        foreach my $cell ( $row->all_cells ) {
            my $row = $table->rows->[$index];
            if ( defined $row ) {
                push @{ $row->cells }, $cell;
            }
            else {
                my $new_row = $table->add_row({});
                push @{ $new_row->cells }, $cell;
            }
            $index++;
        }
    }
    elsif ( $row->cell_count == 0 ) {
        $table->clear_last_row;
    }

    return;
}

1;

__END__