File Coverage

blib/lib/Term/Table.pm

Criterion	Covered	Total	%
statement	149	162	91.9
branch	66	82	80.4
condition	46	64	71.8
subroutine	12	13	92.3
pod	0	5	0.0
total	273	326	83.7

package Term::Table;
use strict;
use warnings;

our $VERSION = '0.017';

use Term::Table::Cell();

use Term::Table::Util qw/term_size uni_length USE_GCS/;
use Scalar::Util qw/blessed/;
use List::Util qw/max sum/;
use Carp qw/croak carp/;

use Term::Table::HashBase qw/rows _columns collapse max_width mark_tail sanitize show_header auto_columns no_collapse header allow_overflow pad/;

sub BORDER_SIZE()   { 4 }    # '| ' and ' |' borders
sub DIV_SIZE()      { 3 }    # ' | ' column delimiter
sub CELL_PAD_SIZE() { 2 }    # space on either side of the |

sub init {
    my $self = shift;

    croak "You cannot have a table with no rows"
        unless $self->{+ROWS} && @{$self->{+ROWS}};

    $self->{+MAX_WIDTH}   ||= term_size();
    $self->{+NO_COLLAPSE} ||= {};
    if (ref($self->{+NO_COLLAPSE}) eq 'ARRAY') {
        $self->{+NO_COLLAPSE} = {map { ($_ => 1) } @{$self->{+NO_COLLAPSE}}};
    }

    if ($self->{+NO_COLLAPSE} && $self->{+HEADER}) {
        my $header = $self->{+HEADER};
        for(my $idx = 0; $idx < @$header; $idx++) {
            $self->{+NO_COLLAPSE}->{$idx} ||= $self->{+NO_COLLAPSE}->{$header->[$idx]};
        }
    }

    $self->{+PAD} = 4 unless defined $self->{+PAD};

    $self->{+COLLAPSE}  = 1 unless defined $self->{+COLLAPSE};
    $self->{+SANITIZE}  = 1 unless defined $self->{+SANITIZE};
    $self->{+MARK_TAIL} = 1 unless defined $self->{+MARK_TAIL};

    if($self->{+HEADER}) {
        $self->{+SHOW_HEADER}  = 1 unless defined $self->{+SHOW_HEADER};
    }
    else {
        $self->{+HEADER}       = [];
        $self->{+AUTO_COLUMNS} = 1;
        $self->{+SHOW_HEADER}  = 0;
    }
}

sub columns {
    my $self = shift;

    $self->regen_columns unless $self->{+_COLUMNS};

    return $self->{+_COLUMNS};
}

sub regen_columns {
    my $self = shift;

    my $has_header = $self->{+SHOW_HEADER} && @{$self->{+HEADER}};
    my %new_col = (width => 0, count => $has_header ? -1 : 0);

    my $cols = [map { {%new_col} } @{$self->{+HEADER}}];
    my @rows = @{$self->{+ROWS}};

    for my $row ($has_header ? ($self->{+HEADER}, @rows) : (@rows)) {
        for my $ci (0 .. max(@$cols - 1, @$row - 1)) {
            $cols->[$ci] ||= {%new_col} if $self->{+AUTO_COLUMNS};
            my $c = $cols->[$ci] or next;
            $c->{idx}  ||= $ci;
            $c->{rows} ||= [];

            my $r = $row->[$ci];
            $r = Term::Table::Cell->new(value => $r)
                unless blessed($r)
                && ($r->isa('Term::Table::Cell')
                || $r->isa('Term::Table::CellStack')
                || $r->isa('Term::Table::Spacer'));

            $r->sanitize  if $self->{+SANITIZE};
            $r->mark_tail if $self->{+MARK_TAIL};

            my $rs = $r->width;
            $c->{width} = $rs if $rs > $c->{width};
            $c->{count}++ if $rs;

            push @{$c->{rows}} => $r;
        }
    }

    # Remove any empty columns we can
    @$cols = grep {$_->{count} > 0 || $self->{+NO_COLLAPSE}->{$_->{idx}}} @$cols
        if $self->{+COLLAPSE};

    my $current = sum(map {$_->{width}} @$cols);
    my $border = sum(BORDER_SIZE, $self->{+PAD}, DIV_SIZE * (@$cols - 1));
    my $total = $current + $border;

    if ($total > $self->{+MAX_WIDTH}) {
        my $fair = ($self->{+MAX_WIDTH} - $border) / @$cols;
        if ($fair < 1) {
            return $self->{+_COLUMNS} = $cols if $self->{+ALLOW_OVERFLOW};
            croak "Table is too large ($total including $self->{+PAD} padding) to fit into max-width ($self->{+MAX_WIDTH})";
        }

        my $under = 0;
        my @fix;
        for my $c (@$cols) {
            if ($c->{width} > $fair) {
                push @fix => $c;
            }
            else {
                $under += $c->{width};
            }
        }

        # Recalculate fairness
        $fair = int(($self->{+MAX_WIDTH} - $border - $under) / @fix);
        if ($fair < 1) {
            return $self->{+_COLUMNS} = $cols if $self->{+ALLOW_OVERFLOW};
            croak "Table is too large ($total including $self->{+PAD} padding) to fit into max-width ($self->{+MAX_WIDTH})";
        }

        # Adjust over-long columns
        $_->{width} = $fair for @fix;
    }

    $self->{+_COLUMNS} = $cols;
}

sub render {
    my $self = shift;

    my $cols = $self->columns;
    for my $col (@$cols) {
        for my $cell (@{$col->{rows}}) {
            $cell->reset;
        }
    }
    my $width = sum(BORDER_SIZE, $self->{+PAD}, DIV_SIZE * @$cols, map { $_->{width} } @$cols);

    #<<< NO-TIDY
    my $border   = '+' . join('+', map { '-' x ($_->{width}  + CELL_PAD_SIZE) }      @$cols) . '+';
    my $template = '|' . join('|', map { my $w = $_->{width} + CELL_PAD_SIZE; '%s' } @$cols) . '|';
    my $spacer   = '|' . join('|', map { ' ' x ($_->{width}  + CELL_PAD_SIZE) }      @$cols) . '|';
    #>>>

    my @out = ($border);
    my ($row, $split, $found) = (0, 0, 0);
    while(1) {
        my @row;

        my $is_spacer = 0;

        for my $col (@$cols) {
            my $r = $col->{rows}->[$row];
            unless($r) {
                push @row => '';
                next;
            }

            my ($v, $vw);

            if ($r->isa('Term::Table::Cell')) {
                my $lw = $r->border_left_width;
                my $rw = $r->border_right_width;
                $vw = $col->{width} - $lw - $rw;
                $v = $r->break->next($vw);
            }
            elsif ($r->isa('Term::Table::CellStack')) {
                ($v, $vw) = $r->break->next($col->{width});
            }
            elsif ($r->isa('Term::Table::Spacer')) {
                $is_spacer = 1;
            }

            if ($is_spacer) {
                last;
            }
            elsif (defined $v) {
                $found++;
                my $bcolor = $r->border_color || '';
                my $vcolor = $r->value_color  || '';
                my $reset  = $r->reset_color  || '';

                if (my $need = $vw - uni_length($v)) {
                    $v .= ' ' x $need;
                }

                my $rt = "${reset}${bcolor}\%s${reset} ${vcolor}\%s${reset} ${bcolor}\%s${reset}";
                push @row => sprintf($rt, $r->border_left || '', $v, $r->border_right || '');
            }
            else {
                push @row => ' ' x ($col->{width} + 2);
            }
        }

        if (!grep {$_ && m/\S/} @row) {
            last unless $found || $is_spacer;

            push @out => $border if $row == 0 && $self->{+SHOW_HEADER} && @{$self->{+HEADER}};
            push @out => $spacer if $split > 1 || $is_spacer;

            $row++;
            $split = 0;
            $found = 0;

            next;
        }

        if ($split == 1 && @out > 1 && $out[-2] ne $border && $out[-2] ne $spacer) {
            my $last = pop @out;
            push @out => ($spacer, $last);
        }

        push @out => sprintf($template, @row);
        $split++;
    }

    pop @out while @out && $out[-1] eq $spacer;

    unless (USE_GCS) {
        for my $row (@out) {
            next unless $row =~ m/[^\x00-\x7F]/;
            unshift @out => "Unicode::GCString is not installed, table may not display all unicode characters properly";
            last;
        }
    }

    return (@out, $border);
}

sub display {
    my $self = shift;
    my ($fh) = @_;

    my @parts = map "$_\n", $self->render;

    print $fh @parts if $fh;
    print @parts;
}

1;

__END__