File Coverage

blib/lib/Text/Table/Sprintf.pm

Criterion	Covered	Total	%
statement	0	29	0.0
branch	0	24	0.0
condition	0	9	0.0
subroutine	0	1	0.0
pod	1	1	100.0
total	1	64	1.5

# we strive for minimality
## no critic: TestingAndDebugging::RequireUseStrict
package Text::Table::Sprintf;

#IFUNBUILT
# # use strict 'subs', 'vars';
# # use warnings;
#END IFUNBUILT

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-11-11'; # DATE
our $DIST = 'Text-Table-Sprintf'; # DIST
our $VERSION = '0.008'; # VERSION

our %FEATURES = (
    set_v => {
        TextTable => 1,
    },

    features => {
        TextTable => {
            can_align_cell_containing_wide_character => 0,
            can_align_cell_containing_color_code     => 0,
            can_align_cell_containing_newline        => 0,
            can_use_box_character                    => 0,
            can_customize_border                     => 0,
            can_halign                               => {
                value => 1,
                summary => 'Only support l (left) and r (right) alignment, not c (center)',
            },
            can_halign_individual_row                => 0,
            can_halign_individual_column             => 0,
            can_halign_individual_cell               => 0,
            can_valign                               => 0,
            can_valign_individual_row                => 0,
            can_valign_individual_column             => 0,
            can_valign_individual_cell               => 0,
            can_rowspan                              => 0,
            can_colspan                              => 0,
            can_color                                => 0,
            can_color_theme                          => 0,
            can_set_cell_height                      => 0,
            can_set_cell_height_of_individual_row    => 0,
            can_set_cell_width                       => 0,
            can_set_cell_width_of_individual_column  => 0,
            speed                                    => 'fast',
            can_hpad                                 => 0,
            can_hpad_individual_row                  => 0,
            can_hpad_individual_column               => 0,
            can_hpad_individual_cell                 => 0,
            can_vpad                                 => 0,
            can_vpad_individual_row                  => 0,
            can_vpad_individual_column               => 0,
            can_vpad_individual_cell                 => 0,
        },
    },
);

sub table {
    my %params = @_;
    my $rows = $params{rows} or die "Must provide rows!";
    # XXX check that all rows contain the same number of columns

    return "" unless @$rows;

    # determine the width of each column
    my @widths;
    for my $row (@$rows) {
        for (0..$#{$row}) {
            my $len = length $row->[$_];
            $widths[$_] = $len if !defined $widths[$_] || $widths[$_] < $len;
        }
    }

    # determine the alignment of each column
    my @aligns = @$rows ? (map {'l'} @{$rows->[0]}) : ();
    if ($params{align}) {
        if (ref $params{align} eq 'ARRAY') {
            @aligns = @{ $params{align} }
        } else {
            $_ = $params{align} for @aligns;
        }
    }

    # determine the sprintf format for a single row
    my $rowfmt = join(
        "",
        (map { ($_ ? "" : "|") . " %".($aligns[$_] eq 'r' ? '':'-')."$widths[$_]s |" } 0..$#widths),
        "\n");
    my $line = join(
        "",
        (map { ($_ ? "" : "+") . ("-" x ($widths[$_]+2)) . "+" } 0..$#widths),
        "\n");

    # determine the sprintf format for the whole table
    my $tblfmt;
    if ($params{header_row}) {
        $tblfmt = join(
            "",
            $line,
            $rowfmt,
            $line,
            (map { $rowfmt . ($params{separate_rows} && $_ < $#{$rows} ? $line : '') } 1..@$rows-1),
            $line,
        );
    } else {
        $tblfmt = join(
            "",
            $line,
            (map { $rowfmt . ($params{separate_rows} && $_ < $#{$rows} ? $line : '') } 1..@$rows),
            $line,
        );
    }

    # generate table
    sprintf $tblfmt, map { @$_ } @$rows;
}

{
#IFUNBUILT
# #     no warnings 'once';
#END IFUNBUILT
    *generate_table = \&table;
}

1;
# ABSTRACT: Generate simple text tables from 2D arrays using sprintf()

__END__