File Coverage

blib/lib/Text/MarkdownTable.pm

Criterion	Covered	Total	%
statement	96	96	100.0
branch	36	38	94.7
condition	15	20	75.0
subroutine	16	16	100.0
pod	2	2	100.0
total	165	172	95.9

package Text::MarkdownTable;
use strict;
use warnings;
use 5.010;

our $VERSION = '0.3.1';

use Moo;
use IO::File;
use IO::Handle::Util ();

has file => (
    is      => 'ro',
    lazy    => 1,
    default => sub { \*STDOUT },
);

has fh => (
    is      => 'ro',
    lazy    => 1,
    default => sub {
        my $fh = $_[0]->file;
        $fh = ref $fh
            ? IO::Handle::Util::io_from_ref($fh) : IO::File->new($fh,"w");
        die "invalid option file" if !$fh;
        binmode $fh, $_[0]->encoding;
        $fh;
    }
);

has encoding => (
    is      => 'ro',
    default => sub { ':utf8' }
);

has fields => (
    is     => 'rw',
    trigger => 1,
);

# TODO: ensure that number of columns is number of fields
has columns => (
    is      => 'lazy',
    coerce  => \&_coerce_list,
    builder => sub { $_[0]->fields }
);

has widths => (
    is      => 'lazy',
    coerce  => \&_coerce_list,
    builder => sub {
        $_[0]->_fixed_width(0);
        return [map { defined($_) ? length $_ : 0 } @{$_[0]->columns}]
    },
);

has header => (
    is => 'rw',
    default => sub { 1 }
);

has edges => (
    is => 'rw',
    default => sub { 1 },
);

has condense => (
    is => 'rw',
);

has streaming => (is => 'rwp');

has _fixed_width => (is => 'rw', default => sub { 1 });

# TODO: duplicated in Catmandu::Exporter::CSV fields-coerce
sub _coerce_list {
    if (ref $_[0]) {
        return $_[0] if ref $_[0] eq 'ARRAY';
        return [sort keys %{$_[0]}] if ref $_[0] eq 'HASH';
    }
    return [split ',', $_[0]];
}

sub _trigger_fields {
    my ($self, $fields) = @_;
    $self->{fields} = _coerce_list($fields);
    if (ref $fields and ref $fields eq 'HASH') {
        $self->{columns} = [ map { $fields->{$_} // $_ } @{$self->{fields}} ];
    }
}

sub add {
    my ($self, $data) = @_;
    unless ($self->fields) {
        $self->{fields} = [ sort keys %$data ]
    }
    my $fields = $self->fields;
    my $widths = $self->widths; # may set
    my $row = [ ];

    if (!$self->streaming and ($self->condense or $self->_fixed_width)) {
        $self->_set_streaming(1);
        $self->_print_header if $self->header;
    }

    foreach my $col (0..(@$fields-1)) {
        my $field = $fields->[$col];
        my $width = $widths->[$col];

        my $value = $data->{$field} // "";
        $value =~ s/[\n|]/ /g;

        my $w = length $value;
        if ($self->_fixed_width) {
            if (!$width or $w > $width) {
                if ($width > 5) {
                    $value = substr($value, 0, $width-3) . '...';
                } else {
                    $value = substr($value, 0, $width);
                }
            }
        } else {
            $widths->[$col] = $w if !$width or $w > $width;
        }
        push @$row, $value;
    }

    $self->_add_row($row);
    $self;
}

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

    if ($self->streaming) {
        $self->_print_row($row);
    } else {
        push @{$self->{_rows}}, $row;
    }
}

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

    if ($self->{_rows}) {
        $self->_print_header if $self->header;
        $self->_print_row($_) for @{$self->{_rows}};
    }
}

sub _print_header {
    my ($self) = @_;
    my $fh     = $self->fh;

    $self->_print_row($self->columns);
    if ($self->condense) {
        $self->_print_row([ map { '-' x length $_ } @{$self->columns} ]);
    } elsif ($self->edges) {
        print $fh '|'.('-' x ($_+2)) for @{$self->widths};
        print $fh "|\n";
    } else {
        print $fh substr(join('|',map { '-' x ($_+2) } @{$self->widths}),1,-1);
        print $fh "\n";
    }
}

has _row_format => (
    is      => 'lazy',
    builder => sub {
        if ( $_[0]->condense ) {
            join("|",map {"%s"} @{$_[0]->fields})."\n"
        } elsif ( $_[0]->edges ) {
            join("",map {"| %-".$_."s "} @{$_[0]->widths})."|\n";
        } else {
            join(" | ",map {"%-".$_."s"} @{$_[0]->widths})."\n";
        }
    }
);

sub _print_row {
    my ($self, $row) = @_;
    printf {$self->fh} $self->_row_format, @{$row};
}

1;
__END__