#!/usr/local/bin/perl -w

#
# dbcolneaten
# Copyright (C) 1991-1999 by John Heidemann <johnh@isi.edu>
# $Id: dbcolneaten,v 1.24 2002/07/24 17:15:39 johnh Exp $
#
# This program is distributed under terms of the GNU general
# public license, version 2.  See the file COPYING
# in $dblibdir for details.
#
sub usage {
    print <<END;
usage: $0 [field_setting]
    	Pretty-print columnar data.

Options:
    -d	    enable debugging
    -e	    omit end-of-line spaces

Field settings are of the form
    field op value
OP is >=, =, or <= specifing that the width of 
that FIELD must be more, equal, or less than that VALUE


Dbcolneaten runs in O(1) memory but disk space proportional to the
size of data.

Bugs:
It is not clear how to support field separators, so it doesn't.

Sample input:
#h account passwd uid gid fullname homedir shell
johnh * 2274 134 John_Heidemann /home/johnh /bin/bash
greg * 2275 134 Greg_Johnson /home/greg /bin/bash
root * 0 0 Root /root /bin/bash
# this is a simple database

Sample command:
cat DATA/passwd.jdb | dbcolneaten

Sample output:
#h account passwd uid  gid fullname       homedir     shell     
johnh      *      2274 134 John_Heidemann /home/johnh /bin/bash 
greg       *      2275 134 Greg_Johnson   /home/greg  /bin/bash 
root       *      0    0   Root           /root       /bin/bash 
# this is a simple database
#  | /home/johnh/BIN/DB/dbcolneaten 

Contributions:
Ashvin Goel <ashvin\@ficus.cs.ucla.edu> fixed a bug wrt header formatting.

Bugs:
Probably doesn't handle tabs as field seperators correctly.
END
#'
    exit 1;
};


BEGIN {
    $dblibdir = "/usr/local/lib/jdb";
    push(@INC, $dblibdir);
}
use DbGetopt;
require "$dblibdir/dblib.pl";

@orig_argv = @ARGV;
my($prog) = &progname;
$debug = 0;
my($omit_eoln_space) = 0;
my($dbopts) = new DbGetopt("de?", \@ARGV);
my($ch);
while ($dbopts->getopt) {
    $ch = $dbopts->opt;
    if ($ch eq 'd') {
	$debug++;
    } elsif ($ch eq 'e') {
	$omit_eoln_space++;
    } else {
	&usage;
    };
};


&readprocess_header;
# die "$prog: can't handle non-default field-separators.\n"
#     if ($fs_code ne 'D');

# Now we write-header ourselves.
# &write_header();

#
# figure max widths
#
@colwidth = (0) x ($#colnames + 1);

my($pre_material) = join(" ", $col_headertag, @coloptions, '');

for $i (0..$#colnames) {
    $l = length($colnames[$i]);
    if ($i == 0) {
	$l += length($pre_material);
    }
    $colwidth[$i] = $l if ($l > $colwidth[$i]);
}

#
# read all data, saving a copy aside
#
my($copy_filename) = db_tmpfile(TMP);
while (<STDIN>) {
    print TMP $_;
    &is_comment && next;
    &split_cols;
    for $i (0..$#colnames) {
    	$l = defined($f[$i]) ? length($f[$i]) : 0;
    	$colwidth[$i] = $l if ($l > $colwidth[$i]);
    };
};
close TMP;

#
# handle arguments
#
foreach (@ARGV) {
    my($field_name, $op, $value) = m/([^<>=]*)\s*([<>=]+)\s*(\d+)/;
    die "$prog: unknown field specification.\n" if (!defined($field_name) || !defined($value));
    my($field_col) = $colnametonum{$field_name};
    die ("$prog: unknown column ``$field_name''.\n")
	if (!defined($field_col));
    if ($op eq '=') {
	$colwidth[$field_col] = $value;
    } elsif ($op eq '>=') {
    	$colwidth[$field_col] = $value if ($colwidth[$field_col] < $value);
    } elsif ($op eq '<=') {
    	$colwidth[$field_col] = $value if ($colwidth[$field_col] > $value);
    } else {
        die "$prog: bad operation $op in field spec $_.\n";
    };
}

#
# write code to fix the data
#
$format = "";
$fields = "";
$outfs = " " if ($fs_code eq 'D');
for $i (0..$#colnames) {
    $format .= "%-$colwidth[$i]s$outfs";
    $header_format .= "%-$colwidth[$i]s " . ($fs_code eq 'S' ? " " : "");
    $fields .= ', $f[' . $i . ']';
};
my($code) = "\$out = sprintf(\"$format\"$fields);\n";
$code .= "\$out =~ s/\\s*\$//;\n" if ($omit_eoln_space);
$code .= "print \"\$out\\n\";\n";
my($header_code) = "printf \"$header_format\\n\"$fields;";
print STDERR "header_code:\n$header_code\ncode:\n$code\n" if ($debug);
exit 1 if ($debug);

#
# show the pretty data
#

# first the header
@f = @colnames;
$f[0] =  $pre_material . $f[0];
eval $header_code;
$@ && die "$prog: interal eval error: $@.\n";

# and reopen the tmpfile
open(TMP, "<$copy_filename") || die "$prog: cannot reopen tmpfile.\n";

# then the data
my($loop) = q[
    while (<TMP>) {
        if (&is_comment) {
    	    print $_;
	    next;
        } else {
            &split_cols;
	    # Make sure everythings init'ed.
	    push(@f, ("") x ($#colnames - $#f)) if ($#f < $#colnames);
] . $code . q[
        };
    };
];
eval $loop;
$@ && die "$prog: interal eval error: $@.\n";

close TMP;

print "#  | $prog ", join(" ", @orig_argv), "\n";
exit 0;

my($i) = $col_headertag;   # supress warning
$i = $#coloptions;
$i = $fs_code;
$i = $colnametonum{'foo'};
