#!/usr/bin/perl -w

#
# dbcol
# Copyright (C) 1991-2002 by John Heidemann <johnh@isi.edu>
# $Id: dbcol,v 1.25 2003/07/09 23:38:49 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 [-drv] [-e EmptyValue] column [column...]
    	Select one or more columns from the input database.
	If a value is given for empty columns with the -e option,
	then any named columns which don't exist will be created.
	Otherwise, non-existent columns are an error.

	Note:  a safer way to create columns is dbcolcreate.

Options:
    -d	    enable debug mode
    -r	    relaxed error checking: ignore columns that aren't there
    -v	    output all columns except those listed (like grep -v)
    -e EmptyValue   specify the value newly created columns get

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 account | dbcol account

Sample output:
#h      account
johnh
greg
root
# this is a simple database
#  | dbcol account
END
    #';   hack for font-lock mode
    exit 1;
}

# require 5.000;

BEGIN {
    $dblibdir = "/home/johnh/BIN/DB";
    push(@INC, $dblibdir);
}
require "$dblibdir/dblib.pl";
use DbGetopt;

my(@orig_argv) = @ARGV;
my($prog) = &progname;
my($null_value) = undef;
my($debug) = undef;
my($invert_match) = undef;
my($relaxed_errors) = undef;
my($dbopts) = new DbGetopt("de:rv?", \@ARGV);
my($ch);
while ($dbopts->getopt) {
    $ch = $dbopts->opt;
    if ($ch eq 'e') {
    	$null_value = $dbopts->optarg;
    } elsif ($ch eq 'd') {
	$debug = 1;
    } elsif ($ch eq 'r') {
	$relaxed_errors = 1;
    } elsif ($ch eq 'v') {
	$invert_match = 1;
    } else {
	&usage;
    };
};


&readprocess_header;

if ($invert_match) {
    my(@old_av) = @ARGV;
    my($badcol);
    my(@candidate_colnames) = @colnames;
    # ick... O(n^2)... but n is small.
    foreach $badcol (@old_av) {
	my($badf) = $colnametonum{$badcol};
	if (!defined($badf)) {
	   die "$prog: unknown column ``$badcol'' for ommision.\n"
	       if (!$relaxed_errors);
           # skip it if relaxed
	   next;
	};
	# remove this column from the acceptable list
	my(@new_colnames) = ();
	foreach (@candidate_colnames) {
	    push (@new_colnames, $_) if ($badf != $colnametonum{$_});
	};
	die "$prog: multiply omitted column ``$badcol''.\n"
	    if ($#candidate_colnames != $#new_colnames + 1);
	@candidate_colnames = @new_colnames;
    };
    # Pretend like the user actually asked for the longer version.
    @ARGV = @candidate_colnames;
};

my($code) = "";
for $i (0..$#ARGV) {
    if (defined($colnametonum{$ARGV[$i]})) {
    	$code .= '$nf['.$i.'] = $f['.$colnametonum{$ARGV[$i]}.'];' . "\n";
    } elsif (!defined($null_value)) {
    	die ("$prog: creating new column ``$ARGV[$i]'' without specifying null value.\n");
    } else {
    	$code .= '$nf['.$i."] = '" . $null_value . "';\n";
    };
};
@outcolnames = ();
foreach (@ARGV) {
    # convert to colnames (to map 0 back to the first column name)
    if (defined($colnametonum{$_})) {
	# existing column
        push(@outcolnames, $colnames[$colnametonum{$_}]);
    } else {
	push(@outcolnames, $_);
    };
};

&write_header(@outcolnames);

# since perl5 doesn't cache eval, eval the whole loop;
my(@nf) = ();   # for -w
my($loop) = q[
    while (<STDIN>) {
        &pass_comments && next;
	&split_cols;
] . $code . q[
	&write_these_cols(@nf);
    };
];
eval $loop;
$@ && die "$prog: interal eval error: $@.\n";


print "# $prog\'s code: " . code_prettify($code) . "\n"
    if ($debug);
print "#  | $prog ", join(" ", @orig_argv), "\n";
exit 0;