user-tools/tabularize

   1 #!/usr/bin/env perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 tabularize - Takes TAB-delimited lines of text and outputs formatted table.
   8
   9 =head1 SYNOPSIS
  10
  11 I<COMMAND> | tabularize [I<OPTIONS>]
  12
  13 =head1 OPTIONS
  14
  15 =over 4
  16
  17 =item -a, --ascii
  18
  19 7-bit ascii borders
  20
  21 =item -u, --unicode
  22
  23 borders with nice graphical chars
  24
  25 =item -H, --no-horizontal
  26
  27 no horizontal lines in the output
  28
  29 =item -M, --no-margins
  30
  31 no margins, ie. no right-most and left-most vertical borders
  32
  33 =item -p, --padding I<NUM>
  34
  35 add space padding in cells.
  36 I<NUM> is how many spaces.
  37
  38 =item -v, --output-vertical-separator I<CHAR>
  39
  40 vertical separator character(s) in the output
  41
  42 =item -r, --align-right I<NUM>
  43
  44 align these columns (0-indexed) to the right,
  45 others are auto-detected and if they seem to hold mostly numeric data,
  46 then aligned to the right;
  47 otherwise to the left.
  48 this option is repeatable.
  49
  50 =item -l, --align-left I<NUM>
  51
  52 similar to --align-right option
  53
  54 =back
  55
  56 =head1 ENVIRONMENT
  57
  58 =over 4
  59
  60 =item PAGER
  61
  62 If B<$PAGER> is set and standard output is a terminal
  63 and the resulting table is wider than the terminal,
  64 then pipe the table through B<$PAGER>.
  65
  66 =back
  67
  68 =head1 SEE ALSO
  69
  70 column(1), untabularize(1)
  71
  72 =cut
  73
  74
  75 use Data::Dumper;
  76 use Date::Parse;
  77 use DateTime::Format::Strptime;
  78 use Encode qw/decode encode decode_utf8 encode_utf8/;
  79 use Getopt::Long qw/:config no_ignore_case bundling no_getopt_compat no_auto_abbrev require_order/;
  80 use IPC::Run qw/run/;
  81 use List::MoreUtils qw/all any none zip/;
  82 use Pod::Usage;
  83 use Term::Size;
  84 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
  85
  86
  87 sub set_ascii
  88 {
  89         $verticalBorder = '|';
  90         $verticalBar = '|';
  91         $horizontalBar = '-';
  92         $topleftCorner = '+';
  93         $toprightCorner = '+';
  94         $bottomleftCorner = '+';
  95         $bottomrightCorner = '+';
  96         $leftCross = '+';
  97         $middleCross = '+';
  98         $rightCross = '+';
  99         $topCross = '+';
 100         $bottomCross = '+';
 101 }
 102
 103 sub set_unicode
 104 {
 105         $verticalBorder = '│';
 106         $verticalBar = '│';
 107         $horizontalBar = '─';
 108         $topleftCorner = '┌';
 109         $toprightCorner = '┐';
 110         $bottomleftCorner = '└';
 111         $bottomrightCorner = '┘';
 112         $leftCross = '├';
 113         $middleCross = '┼';
 114         $rightCross = '┤';
 115         $topCross = '┬';
 116         $bottomCross = '┴';
 117 }
 118
 119 set_unicode;
 120
 121 use constant { ALIGN_LEFT => 1, ALIGN_RIGHT =>2, };
 122
 123 $OptHorizontal = 1;
 124 $OptMargins = 1;
 125 $OptPadding = 0;
 126 @columnsAlignment = ();
 127
 128 GetOptions(
 129         'a|ascii' => \&set_ascii,
 130         'u|unicode' => \&set_unicode,
 131         'H|no-horizontal' => sub { $OptHorizontal = 0; },
 132         'M|no-margins' => sub { $OptMargins = 0; },
 133         'p|padding=i' => \$OptPadding,
 134         'v|output-vertical-separator=s' => sub {
 135                 my ($getopt_obj, $param) = @_;
 136                 $verticalBorder = $param;
 137                 $verticalBar = $param;
 138                 $topleftCorner = $param;
 139                 $toprightCorner = $param;
 140                 $bottomleftCorner = $param;
 141                 $bottomrightCorner = $param;
 142                 $leftCross = $param;
 143                 $middleCross = $param;
 144                 $rightCross = $param;
 145                 $topCross = $param;
 146                 $bottomCross = $param;
 147         },
 148         'r|align-right=i@' => sub {
 149                 my ($getopt_obj, $param) = @_;
 150                 $columnsAlignment[$param] = ALIGN_RIGHT;
 151         },
 152         'l|align-left=i@' => sub {
 153                 my ($getopt_obj, $param) = @_;
 154                 $columnsAlignment[$param] = ALIGN_LEFT;
 155         },
 156         'help' => sub { pod2usage(-exitval=>0, -verbose=>99); },
 157         '<>' => sub { unshift @ARGV, @_[0]; die '!FINISH'; },
 158 ) or pod2usage(-exitval=>2, -verbose=>99);
 159
 160
 161
 162 sub is_numeric
 163 {
 164         # consider a cell's value numeric if it has only
 165         # - optional sign prefix,
 166         # - numbers,
 167         # - and optionally a common thousands- and/or fraction separator.
 168         # I don't like the anglo-saxon ".123" notation, missing leading zero before the fraction separator.
 169         local $_ = shift;
 170         /^[+-]?\d+((?'thousands_sep'[,. ])\d+(\g{thousands_sep}\d+)*)?([.,]\d+(\g{thousands_sep}\d+)*)?$/ and return 1;
 171         return 0;
 172 }
 173
 174
 175 # compute the width of each column
 176
 177 @Table = ();
 178 @columnsWidth = ();
 179 @numericals_by_col = ();
 180 @non_numericals_by_col = ();
 181
 182 while(<STDIN>)
 183 {
 184         chomp;
 185         my @cells = split /\t/;
 186
 187         for my $idx (0 .. $#cells)
 188         {
 189                 my $cell = $cells[$idx] || '';
 190                 my $width = length $cell;  # TODO multibyte chars?
 191                 $columnsWidth[$idx] = $width if $columnsWidth[$idx] < $width;
 192
 193                 # guess if this cell has numerical content (skip 1st line as it's likely a header)
 194                 if($. > 0 and not defined $columnsAlignment[$idx])
 195                 {
 196                         is_numeric($cell) ? ($numericals_by_col[$idx]++) : ($non_numericals_by_col[$idx]++);
 197                 }
 198         }
 199
 200         push @Table, \@cells;
 201 }
 202
 203 if(not @Table)
 204 {
 205         exit;
 206 }
 207
 208
 209 # compose the format string
 210
 211 if(not $OptMargins)
 212 {
 213         $verticalBorder = '';
 214         $topleftCorner = '';
 215         $toprightCorner = '';
 216         $bottomleftCorner = '';
 217         $bottomrightCorner = '';
 218         $leftCross = '';
 219         $rightCross = '';
 220 }
 221
 222 for my $idx (0 .. $#columnsWidth)
 223 {
 224         if(not defined $columnsAlignment[$idx])
 225         {
 226                 if($numericals_by_col[$idx] >= $non_numericals_by_col[$idx])
 227                 {
 228                         $columnAlignment[$idx] = ALIGN_RIGHT;
 229                 }
 230                 else
 231                 {
 232                         $columnAlignment[$idx] = ALIGN_LEFT;
 233                 }
 234         }
 235
 236         $full_table_width += $idx == 0 ? length($verticalBorder) : length($verticalBar);
 237         $full_table_width += $columnsWidth[$idx] + 2*$OptPadding;
 238 }
 239
 240 $full_table_width += length($verticalBorder);
 241 $n_cols = scalar @columnsWidth;
 242 @verticalBars = ($verticalBar) x ($n_cols-1);
 243
 244 if($OptHorizontal)
 245 {
 246         $gridlineTop = $topleftCorner . join($topCross, map {$horizontalBar x ($_+2*$OptPadding)} @columnsWidth) . $toprightCorner;
 247         $gridlineInner = $leftCross . join($middleCross, map {$horizontalBar x ($_+2*$OptPadding)} @columnsWidth) . $rightCross;
 248         $gridlineBottom = $bottomleftCorner . join($bottomCross, map {$horizontalBar x ($_+2*$OptPadding)} @columnsWidth) . $bottomrightCorner;
 249 }
 250 $line_format = '%s'.
 251         join('%s',
 252                 map {(' 'x$OptPadding).'%'.$_.'s'.(' 'x$OptPadding)}
 253                 map {($columnAlignment[$_] == ALIGN_RIGHT ? 1 : -1) * $columnsWidth[$_]} 0 .. $#columnsWidth
 254         ).'%s';
 255
 256
 257 sub print_table
 258 {
 259         my $fh = shift;
 260         my $row_num = 0;
 261         for my $row (@Table)
 262         {
 263                 $row_num++;
 264                 if($OptHorizontal)
 265                 {
 266                         print {$fh} ($row_num == 1 ? $gridlineTop : $gridlineInner) . "\n";
 267                 }
 268
 269                 my @cells = map {$row->[$_] || ''} 0 .. $#columnsWidth;
 270                 my @cells_and_inner_borders = zip @cells, @verticalBars;
 271                 delete $cells_and_inner_borders[-1];
 272                 printf {$fh} $line_format."\n", $verticalBorder, @cells_and_inner_borders, $verticalBorder;
 273         }
 274
 275         if($OptHorizontal)
 276         {
 277                 print {$fh} $gridlineBottom . "\n";
 278         }
 279 }
 280
 281
 282 # display the rendered table
 283
 284 if(-t 1 and $ENV{PAGER})
 285 {
 286         my ($terminal_cols, $terminal_rows) = Term::Size::chars(*STDOUT);
 287         if($terminal_cols <= $full_table_width)
 288         {
 289                 my ($p_read, $p_write);
 290                 pipe($p_read, $p_write) or die "$0: pipe: $!\n";
 291                 my $pid = fork;
 292                 die "$0: fork: $!\n" if not defined $pid;
 293                 if($pid == 0)
 294                 {
 295                         close $p_read;
 296                         print_table($p_write);
 297                         close $p_write;
 298                         exit 0;
 299                 }
 300                 open \*STDIN, '<&', $p_read;
 301                 close $p_write;
 302                 exec {$ENV{PAGER}} [$ENV{PAGER}] or warn "$0: exec: $!\n";
 303                 exit 127;
 304         }
 305 }
 306
 307 print_table(\*STDOUT);