File Coverage

blib/lib/Text/TabularDisplay.pm

Criterion	Covered	Total	%
statement	107	118	90.6
branch	36	44	81.8
condition	12	18	66.6
subroutine	14	15	93.3
pod	8	9	88.8
total	177	204	86.7

package Text::TabularDisplay;

# -------------------------------------------------------------------
# Text::TabularDisplay - Display text in formatted table output
# Copyright (C) 2004-2014 darren chamberlain
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 USA
# -------------------------------------------------------------------

use strict;
use integer;
use vars qw($VERSION);

$VERSION = "1.38";

# ---======================= Public Methods ======================---

# -------------------------------------------------------------------
# new([@columns])
#
# Instantiate a new Text::TabularDisplay instance.  Optionally takes
# column names, which are passed to the columns method.
# -------------------------------------------------------------------
sub new {
    my $class = shift;
    return $class->clone
        if ref $class && UNIVERSAL::isa($class, __PACKAGE__);

    my $self = bless {
        _COLUMNS => [ ],
        _DATA    => [ ],
        _LENGTHS => [ ],
        _SIZE    => 0,
    } => $class;

    $self->columns(@_) if (@_);

    return $self;
}

# -------------------------------------------------------------------
# clone
#
# Clones a Text::TabluarDisplay instance.
# -------------------------------------------------------------------
sub clone {
    my $self = shift;
    my $class = ref $self || return $self->new;
    my $clone = $class->new($self->columns);

    for (@{ $self->{ _DATA } }) {
        $clone->add(@$_);
    }

    return $clone;
}

# -------------------------------------------------------------------
# columns([@columns])
#
# Returns a list of column names in list context, but returns the
# number of columns in scalar context.
# -------------------------------------------------------------------
sub columns {
    my $self = shift;
    my @columns;

    if (@_) {
        my $cnum = $self->{ _SIZE };
        if ($cnum > scalar @_) {
            push @_, ""
                while ($self->columns > scalar @_);
        }

        @{ $self->{ _COLUMNS } } = ();
        $self->_add($self->{ _COLUMNS }, $self->{ _LENGTHS }, \$self->{ _SIZE }, [ @_ ]);
    }
    @columns = @{ $self->{ _COLUMNS }->[0] || [ ]};

    return wantarray ? @columns : scalar @columns;
}

# -------------------------------------------------------------------
# add(@data)
#
# Adds a row to the instance.  Returns $self, for chaining:
#   $self->add(@one)->add(@two)->add(@three);
# -------------------------------------------------------------------
sub add {
    my $self = shift;
    my $add = UNIVERSAL::isa($_[0], 'ARRAY') ? shift : [ @_ ];

    if (@$add) {
        $self->_add($self->{ _DATA }, $self->{ _LENGTHS }, \$self->{ _SIZE }, $add);
    }

    return $self;
}

# -------------------------------------------------------------------
# render([$start, $end])
#
# Returns the data formatted as a table.  By default, all rows are
# returned; if $start or $end are specified, then only those indexes
# are returned.  Those are the start and end indexes!
# -------------------------------------------------------------------
sub render {
    my $self = shift;
    my $start = shift || 0;
    my $end = shift || $#{ $self->{ _DATA } };
    my $size = $self->{ _SIZE };
    my ($bar, @columns, $datum, @text);

    $bar = join "+", "",
                     map( { "-" x ($_ + 2) } @{ $self->{ _LENGTHS } }),
                     "";

    push @text, $bar;
    if (@columns = $self->columns) {
        push @text, _format_line(\@columns, $self->{ _LENGTHS });
        push @text, $bar;
    }

    for (my $i = $start; $i <= $end; $i++) {
        $datum = $self->{ _DATA }->[$i];
        last unless defined $datum;

        # Pad the array if there are more elements in @columns
        push @$datum, ""
            until (@$datum == $size);
        push @text, _format_line($datum, $self->{ _LENGTHS });
    }

    push @text, $bar;
    return join "\n", @text;
}

sub items {
    my $self = shift;
    return scalar @{ $self->{ _DATA } };
}

# ----------------------------------------------------------------------
# reset()
#
# Resets the instance.
# ----------------------------------------------------------------------
sub reset {
    my $self = shift;

    @{ $self->{ _COLUMNS } } = ();
    @{ $self->{ _LENGTHS } } = ();
    @{ $self->{ _DATA    } } = ();

    $self->columns(@_) if (@_);

    return $self;
}

# ----------------------------------------------------------------------
# populate(\@data)
#
# populate() takes a reference to an array of references to arrays,
# and calls add() repeatedly.  Primarily for use with DBI's
# selectall_arrayref() method.
# ----------------------------------------------------------------------
sub populate {
    my $self = shift;
    (@_) or return $self;
    my $data = UNIVERSAL::isa($_[0], 'ARRAY') ? shift : [ @_ ];

    for (my $i = 0; $i <= $#$data; $i++) {
        $self->add($data->[$i]);
    }

    return $self;
}


# ----------------------------------------------------------------------
# paginate($items_per_page)
#
# Returns a list of rendered pages, with $items_per_page - 4 elements
# on each (operational overhead)
# ----------------------------------------------------------------------
sub paginate {
    my $self = shift;
    my $items_per_page = shift || 62;
    my ($items, $pages, $current, @pages);

    $items = $self->items;
    $pages = $items / $items_per_page;
    $pages += 1 if $items % $items_per_page;

    for (my $i = 0; $i < $pages; $i++) {
        push @pages, $self->render($current, $items_per_page);
        $current += $items_per_page;
    }

    return @pages;
}


# ---====================== Private Methods ======================---


# -------------------------------------------------------------------
# _add(\@where, \@lengths, \@add)
#
# Adds @add to @where and modifies @lengths, as necessary
# -------------------------------------------------------------------
sub _add {
    my $self = shift;
    my ($where, $length, $size, $add) = @_;
    my @data;

    $$size = scalar @$add
        if (scalar @$add > $$size);

    for (my $i = 0; $i <= $#$add; $i++) {
        my $l = _column_length($add->[$i]);

        push @data, $add->[$i];
        $length->[$i] = $l
            unless $length->[$i] && $length->[$i] > $l;
    }
    push @$where, \@data;
}

# -------------------------------------------------------------------
# _format_line(\@columns, \@lengths)
#
# Returns a formatted line out of @columns; the size of $column[$i]
# is determined by $length[$i].
# -------------------------------------------------------------------
sub _format_line {
    my ($columns, $lengths) = @_;

    my $height = 0;
    my @col_lines;
    for (@$columns) {
        my @lines = split "\n", ((defined $_ && length $_) ? $_ : ' ');
        $height = scalar @lines
            if $height < @lines;
        push @col_lines, \@lines;
    }

    my @lines;
    for my $h (0 .. $height - 1 ) {
        my @line;
        for (my $i = 0; $i <= $#$columns; $i++) {
            my $val = defined($col_lines[$i][$h]) ? $col_lines[$i][$h] : '';
            push @line, sprintf " %-" . $lengths->[$i] . "s ", $val;
        }
        push @lines, join '|', "", @line, "";
    }

    return join "\n", @lines;
}

# -------------------------------------------------------------------
# _column_length($str)
# -------------------------------------------------------------------
sub _column_length
{
    my ($str) = @_;
    $str = '' unless defined $str;

    my $len = 0;
    for (split "\n", $str) {
        $len = length
            if $len < length;
    }

    # untaint $len
    unless ($len =~ m|^(\d+)$|s)
        { die 'invalid length: ' . $len }
    $len = $1;

    return $len;
}

1;

__END__