File Coverage

blib/lib/Text/Table/Manifold.pm

Criterion	Covered	Total	%
statement	172	240	71.6
branch	33	82	40.2
condition	7	25	28.0
subroutine	20	26	76.9
pod	8	8	100.0
total	240	381	62.9

package Text::Table::Manifold;

use strict;
use warnings;
use warnings qw(FATAL utf8); # Fatalize encoding glitches.
use open     qw(:std :utf8); # Undeclared streams in UTF-8.

use Const::Exporter constants =>
[
	# Values of alignment().

	align_left   => 0,
	align_center => 1, # The default.
	align_right  => 2,

	# Values for empty(), i.e. empty string handling.

	empty_as_empty => 0, # Do nothing. The default.
	empty_as_minus => 1,
	empty_as_text  => 2, # 'empty'.
	empty_as_undef => 3,

	# Values for escape().

	escape_nothing => 0, # The default.
	escape_html    => 1,
	escape_uri     => 2,

	# Values for extend().

	extend_with_empty => 0, # The default.
	extend_with_undef => 1,

	# Values for format().

	format_internal_boxed        => 0, # The default.
	format_text_csv              => 1,
	format_internal_github       => 2,
	format_internal_html         => 3,
	format_html_table            => 4,
	format_text_unicodebox_table => 5,

	# Values for include().

	include_data    => 1, # Default.
	include_footers => 2,
	include_headers => 4, # Default.

	# Values for undef(), i.e. undef handling.

	undef_as_empty => 0,
	undef_as_minus => 1,
	undef_as_text  => 2, # 'undef'.
	undef_as_undef => 3, # Do nothing. The default.
];

use HTML::Entities::Interpolate; # This module can't be loaded at runtime.

use List::AllUtils 'max';

use Module::Runtime 'use_module';

use Moo;

use Types::Standard qw/Any ArrayRef HashRef Int Str/;

use String::TtyLength 0.02 qw/ tty_width /;

has alignment =>
(
	default  => sub{return []},
	is       => 'rw',
	isa      => ArrayRef,
	required => 0,
);

has data =>
(
	default  => sub{return []},
	is       => 'rw',
	isa      => ArrayRef,
	required => 0,
);

has empty =>
(
	default  => sub{return empty_as_empty},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has escape =>
(
	default  => sub{return escape_nothing},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has extend_data =>
(
	default  => sub{return extend_with_empty},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has extend_footers =>
(
	default  => sub{return extend_with_empty},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has extend_headers =>
(
	default  => sub{return extend_with_empty},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has format =>
(
	default  => sub{return format_internal_boxed},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has footers =>
(
	default  => sub{return []},
	is       => 'rw',
	isa      => ArrayRef,
	required => 0,
);

has headers =>
(
	default  => sub{return []},
	is       => 'rw',
	isa      => ArrayRef,
	required => 0,
);

has include =>
(
	default  => sub{return include_data | include_headers},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has join =>
(
	default  => sub{return ''},
	is       => 'rw',
	isa      => Str,
	required => 0,
);

has padding =>
(
	default  => sub{return 0},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has pass_thru =>
(
	default  => sub{return {} },
	is       => 'rw',
	isa      => HashRef,
	required => 0,
);

has undef =>
(
	default  => sub{return undef_as_undef},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has widths =>
(
	default  => sub{return []},
	is       => 'rw',
	isa      => ArrayRef,
	required => 0,
);

our $VERSION = '1.01_01';

# ------------------------------------------------

sub _align_to_center
{
	my($self, $s, $width, $padding) = @_;
	$s           ||= '';
	my($s_width) = tty_width($s);
	my($left)    = int( ($width - $s_width) / 2);
	my($right)   = $width - $s_width - $left;

	return (' ' x ($left + $padding) ) . $s . (' ' x ($right + $padding) );

} # End of _align_to_center;

# ------------------------------------------------

sub _align_to_left
{
	my($self, $s, $width, $padding) = @_;
	$s           ||= '';
	my($s_width) = tty_width($s);
	my($right)   = $width - $s_width;

	return (' ' x $padding) . $s . (' ' x ($right + $padding) );

} # End of _align_to_left;

# ------------------------------------------------

sub _align_to_right
{
	my($self, $s, $width, $padding) = @_;
	$s           ||= '';
	my($s_width) = tty_width($s);
	my($left)    = $width - $s_width;

	return (' ' x ($left + $padding) ) . $s . (' ' x $padding);

} # End of _align_to_right;

# ------------------------------------------------
# Apply empty_as_* and undef_as_* options, as well as escaping option(s).

sub _clean_data
{
	my($self, $alignment, $headers, $data, $footers) = @_;
	my($empty)  = $self -> empty;
	my($escape) = $self -> escape;
	my($undef)  = $self -> undef;

	use_module('URI::Escape') if ($escape == escape_uri);

	my($s);

	for my $row (0 .. $#$data)
	{
		for my $column (0 .. $#{$$data[$row]})
		{
			$s = $$data[$row][$column];
			$s = defined($s)
					? (length($s) == 0) # tty_width() should not be necessary here.
						? ($empty == empty_as_minus)
							? '-'
							: ($empty == empty_as_text)
								? 'empty'
								: ($empty == empty_as_undef)
									? undef
									: $s # No need to check to empty_as_empty here!
						: $s
					: ($undef == undef_as_empty)
							? ''
							: ($undef == undef_as_minus)
								? '-'
								: ($undef == undef_as_text)
									? 'undef'
									: $s; # No need to check for undef_as_undef here!

			$s                    = $Entitize{$s}  if (defined($s) && ($escape == escape_html) );
			$s                    = URI::Escape::uri_escape($s) if ($escape == escape_uri); # Undef harmless here.
			$$data[$row][$column] = $s;
		}
	}

} # End of _clean_data.

# ------------------------------------------------

sub format_as_html_table
{
	my($self, $alignment, $headers, $data, $footers) = @_;

	my($html) = use_module('HTML::Table') -> new(%{${$self -> pass_thru}{new} }, -data => $data);

	return [$html -> getTable];

} # End of format_as_html_table.

# ------------------------------------------------

sub format_as_internal_boxed
{
	my($self, $alignment, $headers, $data, $footers) = @_;
	my($padding)   = $self -> padding;
	my($widths)    = $self -> widths;
	my($separator) = '+' . join('+', map{'-' x ($_ + 2 * $padding)} @$widths) . '+';
	my(@output)    = $separator;

	my($align);
	my(@s);

	for my $column (0 .. $#$widths)
	{
		$align = $$alignment[$column];

		if ($align == align_left)
		{
			push @s, $self -> _align_to_left($$headers[$column], $$widths[$column], $padding);
		}
		elsif ($align == align_center)
		{
			push @s, $self -> _align_to_center($$headers[$column], $$widths[$column], $padding);
		}
		else
		{
			push @s, $self -> _align_to_right($$headers[$column], $$widths[$column], $padding);
		}
	}

	push @output, '|' . join('|', @s) . '|';
	push @output, $separator;

	for my $row (0 .. $#$data)
	{
		@s = ();

		for my $column (0 .. $#$widths)
		{
			$align = $$alignment[$column];

			if ($align == align_left)
			{
				push @s, $self -> _align_to_left($$data[$row][$column], $$widths[$column], $padding);
			}
			elsif ($align == align_center)
			{
				push @s, $self -> _align_to_center($$data[$row][$column], $$widths[$column], $padding);
			}
			else
			{
				push @s, $self -> _align_to_right($$data[$row][$column], $$widths[$column], $padding);
			}
		}

		push @output, '|' . join('|', @s) . '|';
	}

	push @output, $separator;

	return [@output];

} # End of format_as_internal_boxed.

# ------------------------------------------------

sub format_as_internal_github
{
	my($self, $alignment, $headers, $data, $footers) = @_;
	my(@output) = join('|', @$headers);
	my($widths) = $self -> widths;

	my($align);
	my(@line);

	for my $column (0 .. $#$widths)
	{
		$align = $$alignment[$column];

		if ($align == align_left)
		{
			push @line, ':' . ('-' x $$widths[$column - 1]);
		}
		elsif ($align == align_center)
		{
			push @line, ':' . ('-' x $$widths[$column - 2]) . ':';
		}
		else
		{
			push @line, ('-' x $$widths[$column - 1]) . ':';
		}
	}

	push @output, join('|', @line);

	for my $row (0 .. $#$data)
	{
		push @output, join('|', map{defined($_) ? $_ : ''} @{$$data[$row]});
	}

	return [@output];

} # End of format_as_internal_github.

# ------------------------------------------------

sub format_as_internal_html
{
	my($self, $alignment, $headers, $data, $footers) = @_;
	my($table)         = '';
	my($table_options) = ${$self -> pass_thru}{new}{table} || {};
	my(@table_keys)    = sort keys %$table_options;
	my($include)       = $self -> include;
	my(%align)         =
	(
		0   => "",
		1 => "",
		2  => "",
	);

	if (scalar @table_keys)
	{
		$table .= ' ' . join(' ', map{qq|$_ = "$$table_options{$_}"|} sort keys %$table_options);
	}

	my(@output) = "";

	my(@line);
	my($value);

	if ( ($include & include_headers) && ($#$headers >= 0) )
	{
		push @output, '

		for my $column (0 .. $#$headers)
		{
			push @line, "
		}

		push @output, '
		push @output, '
	}

	if ($include & include_data)
	{
		for my $row (0 .. $#$data)
		{
			@line = ();

			# Every row will have the same # of columns, so we pick 1.

			for my $column (0 .. $#{$$data[0]})
			{
				$value = $$data[$row][$column];
				$value = defined($value) ? $value : '';

				push @line, "
			}

			push @output, '
		}
	}

	if ( ($include & include_footers) && ($#$footers >= 0) )
	{
		push @output, '

		@line = ();

		for my $column (0 .. $#$footers)
		{
			push @line, "
		}

		push @output, '
		push @output, '
	}

	push @output, '