#!/bin/sh
exec ${PERL-perl} -wSx $0 ${1+"$@"}
#!perl

# fmtcols --- indent columns so they line up

# Copyright (C) 1997, 2000, 2001 Noah S. Friedman

# Author: Noah Friedman <friedman@splode.com>
# Created: 1997-08-02

# $Id: fmtcols,v 2.15 2002/10/29 08:49:56 friedman Exp $

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, you can either send email to this
# program's maintainer or write to: The Free Software Foundation,
# Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.

# Commentary:
# Code:

use Getopt::Long;
use Symbol;
use strict;

sub min { return [ sort {   $a <=> $b  } @_ ]->[0]; }
sub max { return [ sort { -($a <=> $b) } @_ ]->[0]; }

sub openfile ($)
{
  my $file = shift;
  my $fh = gensym;

  if ($file eq "-")
    {
      open ($fh, "<&STDIN");
    }
  elsif (!sysopen ($fh, $file, 0))
    {
      die join (": ", $file, $!);
    }
  return $fh;
}

sub read_input ($@)
{
  my $option = shift;

  my $fieldsep       = $option->{fieldsep};
  my $numfields      = $option->{num_fields};
  my $rj_numeric     = $option->{rj_numeric};
  my $skip_lines     = $option->{skip_lines} || 0;
  my $ignore_re      = $option->{ignore_re};
  my $skip_lwspace   = $option->{skip_lwspace};
  my $numeric_regexp = $option->{numeric_regexp};
  my @line;
  my @maxwidth;
  my @numeric;

  $numfields = -1 unless (defined $numfields);

  my $lineno = 1;
  for my $file (@_)
    {
      my $fh = openfile ($file);
      while (<$fh>)
        {
          chop;
          if ($lineno <= $skip_lines
              || (defined $ignore_re && /$ignore_re/o))
            {
              push @line, $_;
              $lineno++;
              next;
            }

          s/^\s+//o if $skip_lwspace;
          my @fields = split (/$fieldsep/o, $_, $numfields);
          my $i = 0;

          push @line, \@fields;
          for my $f (@fields)
            {
              my $l = length $f;

              $maxwidth[$i] = $l
                if (!defined $maxwidth[$i] || $l > $maxwidth[$i]);

              if (defined $rj_numeric && $lineno > $rj_numeric)
                {
                  $numeric[$i] = 1 unless (defined $numeric[$i]);
                  $numeric[$i] = 0
                    unless ($numeric[$i] && $f =~ m/$numeric_regexp/o);
                }
              $i++;
            }
          $lineno++;
        }
      close ($fh);
    }

  return { line     => \@line,
           maxwidth => \@maxwidth,
           numeric  => \@numeric,
         };
}

sub print_output ($$)
{
  my ($input, $option) = @_;

  my $line          = $input->{line};
  my $maxwidth      = $input->{maxwidth};
  my $numeric       = $input->{numeric};

  my $fieldsep      = $option->{fieldsep};
  my $outsep        = $option->{outsep};
  my $width_limit   = $option->{width_limit};
  my $right_justify = $option->{right_justify};
  my $rj_numeric    = $option->{rj_numeric};

  my @fmts;
  my $i = 0;
  my $width;
  foreach $width (@$maxwidth)
    {
      my $w = (defined $width_limit ? min ($width, $width_limit) : $width);

      $right_justify->{$i} = 1 if (defined $rj_numeric && $numeric->[$i]);

      push @fmts, join ("",
                        (exists $right_justify->{$i} ? "%" : "%-"),
                        $w,
                        (defined $width_limit ? "." . ($w-1) : ""),
                        "s");
      $i++;
    }
  $fmts[$#fmts] = "%s" if (scalar @fmts > 0
                           && substr ($fmts[$#fmts], 1, 1) eq '-');
  my $fmtstr = join ($outsep, @fmts);

  my $l;
  foreach $l (@$line)
    {
      my $refp = ref $l;
      if ($refp && $refp eq 'ARRAY')
        {
          local $^W = 0;
          my $s = sprintf ($fmtstr, @$l);
          $s =~ s/\s+$//o;
          print $s, "\n";
        }
      else
        {
          print $l, "\n";
        }
    }
}

sub parse_options ()
{
  my $fieldsep    = "[ \t]+";
  my $outsep      = " ";
  my $num_fields;
  my $rj_numeric;
  my $numeric_regexp = '^[-+]?[\d,.]+%?$';
  my $skip_lines;
  my @ignore_re;
  my $width_limit;
  my $skip_lwspace;
  my %right_justify;
  my @rightcols;

  Getopt::Long::config ('bundling', 'autoabbrev');
  GetOptions ("i|ignore-matching=s@",      \@ignore_re,
              "k|skip-lines=i",            \$skip_lines,
              "N|numeric-right-justify:i", \$rj_numeric,
              "numeric-regexp=s",          \$numeric_regexp,
              "n|num-fields=i",            \$num_fields,
              "m|max-field-width=i",       \$width_limit,
              "r|right-justify=s@",        \@rightcols,
              "S|output-separator=s",      \$outsep,
              "s|separator=s",             \$fieldsep,
              "w|skip-leading-whitespace", \$skip_lwspace,
              "h|help",                    \&usage);

  my $ignore_re;
  if (@ignore_re)
    {
      $ignore_re = (scalar @ignore_re == 1
                    ? $ignore_re[0]
                    : "(?:" . join ("|", @ignore_re) . ")");
    }

  my $col;
  foreach $col (split (/\s*,\s*/o, join (",", @rightcols)))
    {
      $right_justify{$col} = 1;
    }

  return { fieldsep       => $fieldsep,
           outsep         => $outsep,
           width_limit    => $width_limit,
           num_fields     => $num_fields,
           right_justify  => \%right_justify,
           rj_numeric     => $rj_numeric,
           skip_lines     => $skip_lines,
           ignore_re      => $ignore_re,
           skip_lwspace   => $skip_lwspace,
           numeric_regexp => $numeric_regexp,
         };
}

sub usage ()
{
  $0 =~ s|.*/||;
  print "Usage: $0 {options} [files {...}]\n
Options are:
-h, --help                      You're looking at it.
-r, --right-justify  F0,F1,...  Right-justify fields F0, F1, ...
                                This option may be specified more than once.
-N, --numeric-right-justify N   Right-justify any fields which are all-numeric.
                                Optional argument N means skip first N lines of
                                input before examining fields for numeric
                                compliance (use it to skip column headers).
                                First N lines are still column-aligned unless
                                \`-skip-lines' option is specified.
--numeric-regexp       REGEXP   Use this regular expression to match
                                numeric-only fields.
-i, --ignore-matching  REGEXP   Do not column-align lines matching REGEXP.
                                This option may be specified more than once.
-k, --skip-lines       N        Do not column-align first N lines of input.
-s, --separator        SEP      Field separator between columns.
                                This can be any regular expression.
                                The default field separator is any number of
                                tabs and spaces, i.e. \"[ \\t]+\".
-w, --skip-leading-whitespace   Skip leading whitespace before splitting
                                fields.  This option is probably only useful in
                                conjunction with the default separator regexp.
-S, --output-separator SEP      Output separator between fields.  Default \" \".
-n, --num-fields       NUM      Assume there are no more than NUM fields.
                                If there are more, last column contains all
                                remaining elements.
-m, --max-field-width  MAX      Truncate fields on output that are larger than
                                this limit.  By default, there is no limit.\n";
  exit (1);
}

sub main
{
  my $options = parse_options ();
  push @ARGV, "-" unless (scalar @ARGV > 0);
  my $input = read_input ($options, @ARGV);
  print_output ($input, $options);
}

main ();

# local variables:
# mode: perl
# eval: (auto-fill-mode 1)
# end:

# fmtcols ends here