tabularize

#!/usr/bin/env perl

=pod

=head1 NAME

tabularize - Takes TAB-delimited lines of text and outputs formatted table.

=head1 SYNOPSIS

I<COMMAND> | tabularize [I<OPTIONS>]

=head1 OPTIONS

=over 4

=item -a, --ascii

7-bit ascii borders

=item -u, --unicode

borders with nice graphical chars

=item -H, --no-horizontal

no horizontal lines in the output

=item -M, --no-margins

no margins, ie. no right-most and left-most vertical borders

=item -p, --padding I<NUM>

add space padding in cells.
I<NUM> is how many spaces.

=item -v, --output-vertical-separator I<CHAR>

vertical separator character(s) in the output

=item -r, --align-right I<NUM>

align these columns (0-indexed) to the right,
others are auto-detected and if they seem to hold mostly numeric data,
then aligned to the right;
otherwise to the left.
this option is repeatable.

=item -l, --align-left I<NUM>

similar to --align-right option

=back

=head1 ENVIRONMENT

=over 4

=item PAGER

If B<$PAGER> is set and standard output is a terminal
and the resulting table is wider than the terminal,
then pipe the table through B<$PAGER>.

=back

=head1 SEE ALSO

column(1), untabularize(1)

=cut


use Data::Dumper;
use Date::Parse;
use DateTime::Format::Strptime;
use Encode qw/decode encode decode_utf8 encode_utf8/;
use Getopt::Long qw/:config no_ignore_case bundling no_getopt_compat no_auto_abbrev require_order/;
use IPC::Run qw/run/;
use List::MoreUtils qw/all any none zip/;
use Pod::Usage;
use Term::Size;
no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';


sub set_ascii
{
	$verticalBorder = '|';
	$verticalBar = '|';
	$horizontalBar = '-';
	$topleftCorner = '+';
	$toprightCorner = '+';
	$bottomleftCorner = '+';
	$bottomrightCorner = '+';
	$leftCross = '+';
	$middleCross = '+';
	$rightCross = '+';
	$topCross = '+';
	$bottomCross = '+';
}

sub set_unicode
{
	$verticalBorder = '│';
	$verticalBar = '│';
	$horizontalBar = '─';
	$topleftCorner = '┌';
	$toprightCorner = '┐';
	$bottomleftCorner = '└';
	$bottomrightCorner = '┘';
	$leftCross = '├';
	$middleCross = '┼';
	$rightCross = '┤';
	$topCross = '┬';
	$bottomCross = '┴';
}

set_unicode;

use constant { ALIGN_LEFT => 1, ALIGN_RIGHT =>2, };

$OptHorizontal = 1;
$OptMargins = 1;
$OptPadding = 0;
@columnsAlignment = ();

GetOptions(
	'a|ascii' => \&set_ascii,
	'u|unicode' => \&set_unicode,
	'H|no-horizontal' => sub { $OptHorizontal = 0; },
	'M|no-margins' => sub { $OptMargins = 0; },
	'p|padding=i' => \$OptPadding,
	'v|output-vertical-separator=s' => sub {
		my ($getopt_obj, $param) = @_;
		$verticalBorder = $param;
		$verticalBar = $param;
		$topleftCorner = $param;
		$toprightCorner = $param;
		$bottomleftCorner = $param;
		$bottomrightCorner = $param;
		$leftCross = $param;
		$middleCross = $param;
		$rightCross = $param;
		$topCross = $param;
		$bottomCross = $param;
	},
	'r|align-right=i@' => sub {
		my ($getopt_obj, $param) = @_;
		$columnsAlignment[$param] = ALIGN_RIGHT;
	},
	'l|align-left=i@' => sub {
		my ($getopt_obj, $param) = @_;
		$columnsAlignment[$param] = ALIGN_LEFT;
	},
	'help' => sub { pod2usage(-exitval=>0, -verbose=>99); },
	'<>' => sub { unshift @ARGV, @_[0]; die '!FINISH'; },
) or pod2usage(-exitval=>2, -verbose=>99);



sub is_numeric
{
	# consider a cell's value numeric if it has only 
	# - optional sign prefix,
	# - numbers,
	# - and optionally a common thousands- and/or fraction separator.
	# I don't like the anglo-saxon ".123" notation, missing leading zero before the fraction separator.
	local $_ = shift;
	/^[+-]?\d+((?'thousands_sep'[,. ])\d+(\g{thousands_sep}\d+)*)?([.,]\d+(\g{thousands_sep}\d+)*)?$/ and return 1;
	return 0;
}


# compute the width of each column

@Table = ();
@columnsWidth = ();
@numericals_by_col = ();
@non_numericals_by_col = ();

while(<STDIN>)
{
	chomp;
	my @cells = split /\t/;
	
	for my $idx (0 .. $#cells)
	{
		my $cell = $cells[$idx] || '';
		my $width = length $cell;  # TODO multibyte chars?
		$columnsWidth[$idx] = $width if $columnsWidth[$idx] < $width;
		
		# guess if this cell has numerical content (skip 1st line as it's likely a header)
		if($. > 0 and not defined $columnsAlignment[$idx])
		{
			is_numeric($cell) ? ($numericals_by_col[$idx]++) : ($non_numericals_by_col[$idx]++);
		}
	}
	
	push @Table, \@cells;
}

if(not @Table)
{
	exit;
}


# compose the format string

if(not $OptMargins)
{
	$verticalBorder = '';
	$topleftCorner = '';
	$toprightCorner = '';
	$bottomleftCorner = '';
	$bottomrightCorner = '';
	$leftCross = '';
	$rightCross = '';
}

for my $idx (0 .. $#columnsWidth)
{
	if(not defined $columnsAlignment[$idx])
	{
		if($numericals_by_col[$idx] >= $non_numericals_by_col[$idx])
		{
			$columnAlignment[$idx] = ALIGN_RIGHT;
		}
		else
		{
			$columnAlignment[$idx] = ALIGN_LEFT;
		}
	}
	
	$full_table_width += $idx == 0 ? length($verticalBorder) : length($verticalBar);
	$full_table_width += $columnsWidth[$idx] + 2*$OptPadding;
}

$full_table_width += length($verticalBorder);
$n_cols = scalar @columnsWidth;
@verticalBars = ($verticalBar) x ($n_cols-1);

if($OptHorizontal)
{
	$gridlineTop = $topleftCorner . join($topCross, map {$horizontalBar x ($_+2*$OptPadding)} @columnsWidth) . $toprightCorner;
	$gridlineInner = $leftCross . join($middleCross, map {$horizontalBar x ($_+2*$OptPadding)} @columnsWidth) . $rightCross;
	$gridlineBottom = $bottomleftCorner . join($bottomCross, map {$horizontalBar x ($_+2*$OptPadding)} @columnsWidth) . $bottomrightCorner;
}
$line_format = '%s'.
	join('%s',
		map {(' 'x$OptPadding).'%'.$_.'s'.(' 'x$OptPadding)}
		map {($columnAlignment[$_] == ALIGN_RIGHT ? 1 : -1) * $columnsWidth[$_]} 0 .. $#columnsWidth
	).'%s';


sub print_table
{
	my $fh = shift;
	my $row_num = 0;
	for my $row (@Table)
	{
		$row_num++;
		if($OptHorizontal)
		{
			print {$fh} ($row_num == 1 ? $gridlineTop : $gridlineInner) . "\n";
		}
		
		my @cells = map {$row->[$_] || ''} 0 .. $#columnsWidth;
		my @cells_and_inner_borders = zip @cells, @verticalBars;
		delete $cells_and_inner_borders[-1];
		printf {$fh} $line_format."\n", $verticalBorder, @cells_and_inner_borders, $verticalBorder;
	}
	
	if($OptHorizontal)
	{
		print {$fh} $gridlineBottom . "\n";
	}
}


# display the rendered table

if(-t 1 and $ENV{PAGER})
{
	my ($terminal_cols, $terminal_rows) = Term::Size::chars(*STDOUT);
	if($terminal_cols <= $full_table_width)
	{
		my ($p_read, $p_write);
		pipe($p_read, $p_write) or die "$0: pipe: $!\n";
		my $pid = fork;
		die "$0: fork: $!\n" if not defined $pid;
		if($pid == 0)
		{
			close $p_read;
			print_table($p_write);
			close $p_write;
			exit 0;
		}
		open \*STDIN, '<&', $p_read;
		close $p_write;
		exec {$ENV{PAGER}} [$ENV{PAGER}] or warn "$0: exec: $!\n";
		exit 127;
	}
}

print_table(\*STDOUT);