#!/usr/bin/perl -w
#
# align: Measure the fields on all lines, then copy, padding to align everything.
#
# Written ~2006-11-15 by Steven J. DeRose, sderose@acm.org.
# 2008-05-09 sjd: Fix uninit'd variables; lineends.
#
# To do:
#    Support input/output line-end variations
#    Auto-justify (test for int and float fields).
#    Option to wrap and indent beyond some width.
#    Option to associate delimiter to l or r of padding, or delete.
#    Finish decimal justification calculations.
#

use strict;
use Getopt::Long;

my $version = "2008-05-09";

my $dft_delim = "\\s\\s*";
my $dft_lineends = "U";
my $dft_outlineends = "U";

my $altfillchar = ".";     # Alternate fill character
my $altfillinterval = 3;   # Use altfill every how many lines?
my $autojustify = 0;       # Set justification from apparent datatypes
my $boxdraw = 0;           # Put in box-drawing characters?
my $boxu = 0;              # Unicode box-drawing characters?
my $com = "";              # Expression for what's a comment line
my $count = 0;             # Verify that all records have same number of fields?
my $delim = $dft_delim;    # Regex used to split into fields
my $dot = 0;               # Use altfill and altfillinterval?
my $fillchar = " ";        # What char to pad with
my $help = 0;
my $howmany = 0;           # Do only this many fields per record
my $justify = "";          # List of ways to justify: L/R/C/.
my $last = -1;             # Pad last field (-1 = default, see help)
my $left = 1;              # Left-align fields instead of right?
my $lineends = $dft_lineends;
my $outlineends = $dft_outlineends;
my $quiet = 0;
my $strip = 0;
my $tabs = 0;              # Don't expand tabs
my $trim = 0;              # Trim whitespace off of field values?
my $verbose = 0;


# Process options
Getopt::Long::Configure ("ignore_case");
my $result = GetOptions(
    "autojustify"               => \$autojustify,
    "boxdraw"                   => \$boxdraw,
    "boxu"                      => \$boxu,
    "c|fill=s"                  => \$fillchar,
    "com=s"                     => \$com,
    "count!"                    => \$count,
    "d=s"                       => \$delim,
    "dot"                       => \$dot,
    "h|help|?"                  => \$help,
    "j|justify=s"               => \$justify,
    "l|left!"                   => \$left,
    "last"                      => \$last,
    "lineends|linends=s"        => \$lineends,
    "n=n"                       => \$howmany,
    "outlineends|outlinends=s"  => \$outlineends,
    "q|quiet!"                  => \$quiet,
    "r|right"                   => sub { $left = 0; },
    "strip!"                    => \$strip,
    "t"                         => \$trim,
    "tabs=n"                    => \$tabs,
    "v|verbose+"                => \$verbose,
    "version"                   => sub {
        die "Version of $version, by Steven J. DeRose, sderose\@acm.org.\n";
    }
    );

if ($help) { showUsage(); exit; }
($result) || die "Bad options.\n";

my $lineendChar = "\n";
if ($lineends =~ m/M/i) { $lineendChar = "\r"; }
if ($lineends =~ m/D/i) { $lineendChar = "\r\n"; }

my $outlineendChar = "\n";
if ($outlineends =~ m/M/i) { $outlineendChar = "\r"; }
if ($outlineends =~ m/D/i) { $outlineendChar = "\r\n"; }

# Validate and default options, and set up box-drawing charset

($howmany < 0) && die "-n value must be positive.\n";
($tabs < 0)    && die "Invalid tab interval $tabs.\n";
my @justifyList = ();
if ($justify ne "") {
    @justifyList = split(/\s*/,uc($justify));
    for my $j (@justifyList) {
        ($j =~ m/^[LCR.]/) || die "Bad justification setting '$j'.\n";
    }
}
(length($fillchar) == 1) ||
    die "fill character must be a single character, not '$fillchar'.\n";
(length($altfillchar) == 1) ||
    die "alternate fill character must be a single character, not '$fillchar'.\n";

# Unicode boxdrawing chars? Block 0x2500-0x257F:
#    Code    Name = "Box drawings light..."
#    0x2500  horizontal                        (-)
#    0x2502  vertical                          (|)
#    0x250c  down/right                        (upper-left corner)
#    0x2510  down/left                         (upper-right corner)
#    0x2514  up/right                          (lower-left corner)
#    0x2518  up/left                           (lower-right corner)
#    0x251c  vertical/right                    (left end)
#    0x2524  vertical/left                     (right end)
#    0x252c  down/horizontal                   (top end)
#    0x2534  up/horizontal                     (bottom end)
#    0x253c  vertical/horizontal               (cross)
#
#    0x256d  arc down/right                    (upper-left round corner)
#    0x256e  arc down/left                     (upper-right round corner)
#    0x256f  arc up/left                       (lower-left round corner)
#    0x2570  arc up/right                      (lower-right round corner)
#    0x2571  diagonal upper-right/lower-left   (slash)
#    0x2572  diagonal upper-left/lower-right   (backslash)
#    0x2573  diagonal cross                    (x)
#    0x2574  left
#    0x2575  up
#    0x2576  down
#    0x2577  right

my $boxpad      = " ";       # Space after column-sep ("|")
my $boxhoriz    = "-";
my $boxvert     = "|";
my $boxulcorner = "/";
my $boxurcorner = "\\";
my $boxllcorner = "\\";
my $boxlrcorner = "/";
my $boxlend     = "|";
my $boxrend     = "|";
my $boxtend     = "-";
my $boxbend     = "-";
my $boxcross    = "+";

if ($boxu)    {
    $boxdraw = 1;
    $boxhoriz    = "&#x2500;";
    $boxvert     = "&#x2502;";
    $boxulcorner = "&#x250c;";
    $boxurcorner = "&#x2510;";
    $boxllcorner = "&#x2514;";
    $boxlrcorner = "&#x2518;";
    $boxlend     = "&#x251c;";
    $boxrend     = "&#x2524;";
    $boxtend     = "&#x252c;";
    $boxbend     = "&#x2534;";
    $boxcross    = "&#x2536;";
}
if ($boxdraw) { $last = 1; }
if ($last == -1) {
    $last = ($left) ? 0:1;
}


################################################################################
# Load all of stdin (which limits filesize, but enables doing both passes)
my @lines = <>;
($verbose) && warn "align: Total lines: " . scalar(@lines) . ".\n";

# Expand tabs, or we may count wrong.
if ($tabs > 0  && 1==0) {
    for (my $lnum=0; $lnum < scalar @lines; $lnum++) {
        $lines[$lnum] = expandTabs($lines[$lnum],$tabs); 
    }
}

# Find the widest instance of each field
my @maxes = ();
my @preDecMax = (); 
my @postDecMax = (); 
my @fieldtype = ();
my $delimHasS = ($delim =~ m/\\s/) ? 1:0;
my $sawEmptyTabbedFields = 0;
my $priorTokenCount = -1;
my $recNum = 0;

foreach my $l (@lines) {
    $recNum++;
    chomp($l);
    if ($strip) { $l =~ s/^\s*//; $l =~ s/\s*$//; }
    if ($com ne "" && $l =~ m/$com/) { next; }
    if ($delimHasS && $l =~ m/\t\t/) { $sawEmptyTabbedFields++; }
    my @tokens = split("\($delim\)", $l); # we keep the delims, too

    # Chop off extra fields if user asked
    if ($howmany > 0 && scalar @tokens > $howmany) { 
        my @remainder = splice @tokens, $howmany+1;
        $tokens[$howmany] = join("",@remainder);
        ($verbose) && warn "   align: Unbroken: $tokens[$howmany]\n";
    }
    ($verbose) && warn "align: Tokenized: |" . join("|",@tokens) . "|\n";

    # Verify that we have consistent number of fields
    if ($count) {
        my $curTokenCount = scalar(@tokens);
        if ($priorTokenCount == -1) {
            $priorTokenCount = $curTokenCount;
        }
        elsif ($curTokenCount != $priorTokenCount) {
            warn "align: Record $recNum has different number of delims+fields"
                . "($curTokenCount)"
                . " than prior record(s) had ($priorTokenCount):\n"
                . "'" . showInvisibles($l) . "'\n";
            die "It parsed into:\n    '" . join("'\n    '",@tokens) . "'\n";
        }
    }

    for (my $i=0; $i<scalar(@tokens); $i++) {
        # Try to determine field's datatype
        if ($autojustify) {
            my $mytype = ""; # alphabetical order = priority order !
            if    ($tokens[$i] =~ m/^\s*[-+]?\d+\s*$/) {
                $mytype = "I"; }
            elsif ($tokens[$i] =~ m/^\s*[-+]?\d\.\d+([eE][-+]?\d+)\s*$/) {
                $mytype = "R"; }
            else {
                $mytype = "S"; }
            if ($mytype gt $fieldtype[$i]) { $fieldtype[$i] = $mytype; }
        }
        # Look for any fields wider than we've seen before
        if ($i >= scalar(@maxes)) { $maxes[$i] = 0; }
        if ($trim) {
            $tokens[$i] =~ s/^\s*//;
            $tokens[$i] =~ s/\s*$//;
        }
        my $len = length($tokens[$i]);
        if ($len > $maxes[$i]) {
            $maxes[$i] = $len;
        }
        if (defined($justifyList[$i]) &&
        	$justifyList[$i] =~ m/^\./) {
            my $dpos = index($tokens[$i],".");
            my $preDecLength  = ($dpos >= 0) ? $dpos : length($tokens[$i]);
            my $postDecLength = ($dpos >= 0) ? (length($tokens[$i])-$dpos-1) : 0;
            if ($preDecLength > $preDecMax[$i]) {
                $preDecMax[$i] = $preDecLength;
            }
            if ($postDecLength > $postDecMax[$i]) {
                $postDecMax[$i] = $postDecLength;
            }
        }
    } # for $i
} # for $l

# Set the max field length for decimal-justified fields to maxpre+maxpost+1.
for (my $i=0; $i<scalar @maxes; $i++) {
    if ($justifyList[$i] =~ m/^\./) {
        $maxes[$i] = $preDecMax[$i] + $postDecMax[$i] + 1;
    }
}

($quiet) || ($sawEmptyTabbedFields==0) ||
    warn "\nalign: WARNING: The field delimiter includes \\s, and I saw "
    . "$sawEmptyTabbedFields record(s) containing \\t\\t.\n"
    . "    This may not parse as you intend. Try -d '\\t'?\n\n";

# In case any fields/delims maxed out to 0 width, bump up to 1
my $nfields = scalar @maxes;
for (my $i=0; $i<$nfields; $i++) {
    if ($maxes[$i] <= 0) {
        $maxes[$i] = 1;
    }
}


# Create box-drawing pieces
my $datasep = "$boxpad$boxvert$boxpad";
my $linesep = ($boxhoriz x length($boxpad)) . $boxcross .
              ($boxhoriz x length($boxpad));
my $totalWidth = 0;
my $topLine    = $boxulcorner;
my $rowsepLine = $boxlend;
my $bottomLine = $boxllcorner;
for my $w (@maxes) {
    $totalWidth += $w;
    $topLine    .= ($boxhoriz x $w) . $linesep;
    $rowsepLine .= ($boxhoriz x $w) . $linesep;
    $bottomLine .= ($boxhoriz x $w) . $linesep;
}
my $cutTo = length($rowsepLine) - length("$boxcross$boxpad");
$topLine    = substr($topLine,   0,$cutTo) . $boxurcorner . $outlineendChar;
$rowsepLine = substr($rowsepLine,0,$cutTo) . $boxrend     . $outlineendChar;
$bottomLine = substr($bottomLine,0,$cutTo) . $boxlrcorner . $outlineendChar;

if ($verbose) {
    warn "align:\n";
    warn "Max fields/line: " . (scalar(@maxes)+1)/2 . ".\n";
    warn "Field widths: " . join(", ",@maxes) . ".\n";
    warn "Total data width: $totalWidth.\n";
    if ($boxdraw) {
        my $paddedWidth = $totalWidth + scalar(@maxes)*length($linesep) - 2;
        warn "   (with padding and lines: $paddedWidth)\n";
    }
}


################################################################################
# Pad the fields in each line and write them out
my $lnum = 0;
($boxdraw) && print $topLine;
foreach my $l (@lines) {
    $lnum++;
    my $curfillchar = $fillchar;
    if ($dot && $lnum % $altfillinterval == 0) {
        $curfillchar = $altfillchar;
    }
    if ($strip) { $l =~ s/^\s*//; $l =~ s/\s*$//; }
    if ($com ne "" && $l =~ m/$com/) { print "$l\n"; next; }
    chomp($l);
    if (index($l,"\n") > -1) { warn "align: mid-line newline found\n"; }
    my @tokens = split("\($delim\)", $l); # we keep the delims, too
    if ($howmany > 0 && scalar @tokens > $howmany) { 
        my @remainder = splice @tokens, $howmany+1;
        $tokens[$howmany] = join("",@remainder);
    }
    my $out = "";
    for (my $i=0; $i<scalar(@maxes); $i++) {
        if ($boxdraw) { $out .= "$boxvert$boxpad"; }
        if ($trim) {
            $tokens[$i] =~ s/^\s*//;
            $tokens[$i] =~ s/\s*$//;
        }
        my $t = $tokens[$i] ? $tokens[$i]:"";
        my $needed = $maxes[$i] - length($t);
        my $tpad = "";
        if ($needed <= 0) {
            $tpad = $t;
        }
        elsif ($left) { 
           $tpad = $t . ($curfillchar x $needed);
        }
        elsif ($justifyList[$i]) { # Handle fieldtype here too
            my $just = $justifyList[$i];
            if    ($just =~ m/^L/) {                     # Left-justified
                $tpad = $t . ($curfillchar x $needed); }
            elsif ($just =~ m/^C/) {                     # Centered
                $tpad = ($curfillchar x ($needed/2)) . $t
                      . ($curfillchar x (($needed+1)/2));
            }
            elsif ($just =~ m/^\./) {                    # Decimal-justified
                # We counted the post-decimals no first pass
                my $dpos = index($t,".");
                my $postDecLength = ($dpos >= 0) ? (length($t)-$dpos-1) : 0;
                my $postDecNeeded = $postDecMax[$i] = $postDecLength;
                if ($postDecNeeded > 0) { 
                    $tpad .= ($curfillchar x $postDecNeeded);
                }
                $needed = $maxes[$i] = length($t);
                if ($needed > 0) { $tpad = ($curfillchar x $needed) . $t; }
            }
            else {                                       # Right-justified
                $tpad = ($curfillchar x $needed) . $t; }
        }
        else { # default to R justified
            $tpad = ($curfillchar x $needed) . $t;
        }
        $out .= $tpad . $boxpad;
    }
    if (!$last) { $out =~ s/$curfillchar+$//; }
    if ($boxdraw) { 
        print "$out$boxvert\n";
        print $rowsepLine;
    }
    else {
        print "$out\n";
    }
}

($boxdraw) && print $bottomLine;

my $rct = scalar @lines;
($quiet) || warn "align: Done, $rct records.\n";

exit;


################################################################################

sub expandTabs {
    my $l = $_[0];
    my $interval = $_[1];
    my $buf = "";
    for (my $i=0; $i<length($l); $i++) {
        if (substr($l,$i,1) eq "\t") {
            my $needed = $interval - (length($buf) % $tabs);
            $buf .= (" " x $needed);
        }
        else {
            $buf .= substr($l,$i,1);
        }
    }
    return($buf);
}


sub showInvisibles {
    my $rc = $_[0];
    $rc =~ s/\t/\\t/g;
    $rc =~ s/\r/\\r/g;
    $rc =~ s/\n/\\n/g;
    $rc =~ s/\f/\\f/g;
    return($rc);
}

################################################################################

sub showUsage {
    warn "
Usage:
    align [options] 
    Split lines of stdin into fields based on a Perl regex,
    find the max width of each field (across all lines), and
    pad each occurrence of each field to that max, so the fields all line up.
Options:
    -autojustify  Set justification by apparent datatypes (unfinished).
    -boxdraw      Draw borders (default: Using ASCII characters).
    -boxu         Use Unicode box-drawing characters (block at 0x2500).
    -c char       Use 'char' instead of ' ' as the fill character.
    -com 'regex'  Do not align lines that match this regex (typically comments).
    -count        Scream if all records don't have the same number of fields.
    -d 'regex'    Set the field delimiter (passed to Perl split()).
                      (the default delimiter expression is /$dft_delim/).
    -j 'j1 j2...' Justify fields as specified (L/C/R/.)  '.' finds the
                      maximum post-decimal width, and right-aligns that.
    -l            Align left edge of fields (default).
    -last         Right-pad the *last* field too (default: off with -l,
                      on with -nol, on with -boxdraw).
    -lineends t   Whether to expect Mac, Unix, or Dos style line-ends in input.
    -n n          Pad only the first 'n' fields per line.
    -outlineends t   Whether to generate Mac, Unix, or Dos style line-ends.
    -q            Suppress most messages.
    -r            Align right edge of fields.
    -strip        Remove leading/trailing space before parsing into fields
                      (use this if *some* records have leading whitespace).
    -t            Trim leading/trailing whitespace from each field.
                      (use this if some lines begin with space, or else we'll
                       assume there's an empty first field).
    -v            Report details like #lines, #fields/line, field widths.
    -version      Print version information and exit ($version, sjd).
Known bugs and limitations:
    Loads the whole file because it scans it twice. Thus, limited size, and
    it can't align ongoing text like 'traceroute' output.
    Cannot ignore multi-line comments with -com.
    Decimal justification is not finished.
Related commands:
    tab2xml, paste, makeHTMLtable, wrap.
";
}