File Coverage

blib/lib/Text/Matrix.pm

Criterion	Covered	Total	%
statement	181	183	98.9
branch	37	46	80.4
condition	10	15	66.6
subroutine	21	21	100.0
pod	12	12	100.0
total	261	277	94.2

package Text::Matrix;

use warnings;
use strict;

use List::Util ();
use List::MoreUtils ();
use Storable ();

our $VERSION = '1.00';

sub new
{
    my $this = shift;
    my %options = @_;
    my ( $self, $class );

    $self = {};
    $class = ref( $this ) || $this;
    bless $self, $class;

    #  Defaults.
    $self->spacer( ' ' );

    #  Nasty nasty.  But I'm lazy and it works...
    foreach my $opt ( keys( %options ) )
    {
        #  Yes, special-case new(), someone's bound to try it if they
        #  see my ugly implementation here. :P
        die "Unknown option '$opt'" if $opt eq 'new' or not $self->can( $opt );
        $self->$opt( $options{ $opt } );
    }

    return( $self );
}

sub _self_or_instance
{
    my ( $self ) = @_;

    return( ref( $self ) ? $self : $self->new() );
}

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

    $self = $self->_self_or_instance();

    $self->{ rows } = $rows;
    delete $self->{ _layout };

    return( $self );
}

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

    $self = $self->_self_or_instance();

    $self->{ columns } = $columns;
    delete $self->{ _layout };

    return( $self );
}

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

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

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

    $self = $self->_self_or_instance();

    $self->{ data } = $data;
    delete $self->{ _layout };
    delete $self->{ _data };
    delete $self->{ _mapped_data };

    return( $self );
}

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

    $self = $self->_self_or_instance();

    if( defined( $mapper ) )
    {
        $self->{ mapper } = $mapper;
    }
    else
    {
        delete $self->{ mapper };
    }
    delete $self->{ _layout };
    delete $self->{ _mapped_data };

    return( $self );
}

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

    $self = $self->_self_or_instance();

    $self->{ spacer } = defined( $spacer ) ? $spacer : ' ';
    delete $self->{ _layout };

    return( $self );
}

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

    $self = $self->_self_or_instance();

    if( defined( $max_width ) )
    {
        $self->{ max_width } = $max_width;
    }
    else
    {
        delete $self->{ max_width };
    }
    delete $self->{ _layout };

    return( $self );
}

sub _layout
{
    my ( $self ) = @_;
    my ( $layout, $start_column, $data );

    return( $self->{ _layout } ) if $self->{ _layout };

    $layout = {};
    $data   = $self->_mapped_data();

    $layout->{ row_label_width } =
        List::Util::max( map { length( $_ ) } @{$self->{ rows }} );

    $layout->{ data_width } =
        List::Util::max( map { List::Util::max( map { length( $_ ) } @{$_} ) }
            @{$data} );

    $start_column = 0;
    $layout->{ sections } = [];
    while( $start_column < @{$self->{ columns }} )
    {
        my ( $end_column, $previous_width, $block, $prefix );

        $previous_width = $layout->{ row_label_width } + 1;
        if( defined( $self->{ max_width } ) )
        {
            $end_column = $start_column - 1;
            while( ( $end_column + 1 < @{$self->{ columns }} ) and
                ( ( $previous_width +
                    length( $self->{ columns }->[ $end_column + 1 ] ) ) <=
                  $self->{ max_width } ) )
            {
                $end_column++;
                $previous_width +=
                    $layout->{ data_width } + length( $self->{ spacer } );
            }

            #  Can't fit even a single column... :/
            return( undef ) if $end_column < $start_column;
        }
        else
        {
            $end_column = @{$self->{ columns }} - 1;
        }

        push @{$layout->{ sections }},
            {
                start_column => $start_column,
                end_column   => $end_column,
                #  Maybe paging will be added at some point...
                start_row    => 0,
                end_row      => @{$self->{ rows }} - 1,
            };

        $start_column = $end_column + 1;
    }

    $self->{ _layout } = $layout;

#use Data::Dumper;
#print "layout: " . Data::Dumper::Dumper( $layout ) . "\n";

    return( $layout );
}

#  The data in normal form.
sub _data
{
    my ( $self ) = @_;
    my ( $data );

    return( $self->{ _data } ) if $self->{ _data };

    return( undef ) unless $self->{ data };

    $data = Storable::dclone( $self->{ data } );

    $data = [ map { $data->{ $_ } } @{$self->{ rows }} ]
        if ref( $data ) eq 'HASH';

    foreach my $row ( @{$data} )
    {
        $row = [ map { $row->{ $_ } } @{$self->{ columns }} ]
            if ref( $row ) eq 'HASH';
    }

    $self->{ _data } = $data;
    #  No need to hold on to the non-normalized form.
    delete $self->{ data };

#use Data::Dumper;
#print "data: " . Data::Dumper::Dumper( $data ) . "\n";

    return( $data );
}

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

    return( $self->{ _mapped_data } ) if $self->{ _mapped_data };

    $data = $self->_data();
    return( undef ) unless defined( $data );
    return( $data ) unless $mapper = $self->{ mapper };

    $data = Storable::dclone( $data );

    foreach my $row ( @{$data} )
    {
        $row = [ map { scalar( $mapper->( $_ ) ) } @{$row} ];
    }

    $self->{ _mapped_data } = $data;

#use Data::Dumper;
#print "mapped data: " . Data::Dumper::Dumper( $data ) . "\n";

    return( $data );
}

sub head
{
    my ( $self ) = @_;
    my ( @ret, $layout, $column_width );

    $self = $self->_self_or_instance();

    return( undef ) unless $layout = $self->_layout();

    $column_width = $layout->{ data_width } + length( $self->{ spacer } );

    @ret = ();
    foreach my $section ( @{$layout->{ sections }} )
    {
        my ( $block, $prefix );

        $block  = '';
        $prefix = ' ' x ( $layout->{ row_label_width } + 1 );
        foreach my $column
            ( $section->{ start_column }..$section->{ end_column } )
        {
            $block .= $prefix . $self->{ columns }->[ $column ] . "\n";
            $prefix .= '|' . ( ' ' x ( $column_width - 1 ) );
        }
        $prefix =~ s/\s+$//;
        $block .= $prefix . "\n" .
            ( ' ' x ( $layout->{ row_label_width } + 1 ) ) .
            ( ( 'v' . ( ' ' x ( $column_width - 1 ) ) ) x
              ( $section->{ end_column } - $section->{ start_column } ) ) .
            "v\n\n";
        push @ret, $block;
    }

    return( \@ret );
}

sub body
{
    my ( $self ) = @_;
    my ( @ret, $layout, $data );

    $self = $self->_self_or_instance();

    return( undef ) unless $layout = $self->_layout();
    return( undef ) unless $data   = $self->_mapped_data();

    @ret = ();
    foreach my $section ( @{$layout->{ sections }} )
    {
        my ( $block );

        $block = '';
        foreach my $row
            ( $section->{ start_row }..$section->{ end_row } )
        {
            $block .= sprintf( '%*s ', $layout->{ row_label_width },
                $self->{ rows }->[ $row ] );
            $block .= join( $self->{ spacer },
                map { sprintf( '%-*s', $layout->{ data_width },
                    $data->[ $row ]->[ $_ ] ) }
                    ( $section->{ start_column }..$section->{ end_column } ) );
            $block .= "\n";
        }
        push @ret, $block;
    }

    return( \@ret );
}

sub foot
{
    my ( $self ) = @_;
    my ( @ret, $layout );

    $self = $self->_self_or_instance();

    $layout = $self->_layout();
    return( undef ) unless $layout;

    @ret = ( "\n" ) x scalar( @{$layout->{ sections }} );
    $ret[ $#ret ] = '';

    return( \@ret );
}

sub matrix
{
    my ( $self, $rows, $columns, $data ) = @_;
    my ( $head, $body, $foot );

    $self = $self->_self_or_instance();

    $self->rows( $rows )       if defined $rows;
    $self->columns( $columns ) if defined $columns;
    $self->data( $data )       if defined $data;

    return( undef ) unless defined( $head = $self->head() ) and
                           defined( $body = $self->body() ) and
                           defined( $foot = $self->foot() );

    return( join( '', List::MoreUtils::mesh( @$head, @$body, @$foot ) ) );
}

1;

__END__