#!/usr/bin/perl

#
# dbcolsplittorows
# Copyright (C) 1991-1998 by John Heidemann <johnh@isi.edu>
# $Id: dbcolsplittocols,v 1.20 2005/02/26 18:12:32 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 [-C ElementSeperator] column [column...]

Options:

    -C sep    gives the separator

Create new columns by spliting an existing column.
The fragments of the column are each divided by ElementSeparator
(default is underscore).

This command is the opposite of dbcolmerge.
Names of the new columns are given by splitting the name
of the existing column.  dbcolrename may be useful
to set column names.

Sample input:
#h      first_last
John_Heidemann
Greg_Johnson
Root
# this is a simple database
#  | dbcolrename fullname first_last
#  | /home/johnh/BIN/DB/dbcol first_last

Sample command:
cat data.jdb | dbcolsplittocols first_last

Sample output:
#h      first_last      first   last
John_Heidemann  John    Heidemann
Greg_Johnson    Greg    Johnson
Root    Root
# this is a simple database
#  | dbcolrename fullname first_last
#  | /home/johnh/BIN/DB/dbcol first_last
#  | /home/johnh/BIN/DB/dbcolsplittocols first_last
END
    exit 1;
}

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

@orig_argv = @ARGV;
my($prog) = &progname;
$elem_separator = "_";
my($dbopts) = new DbGetopt("C:?", \@ARGV);
my($ch);
while ($dbopts->getopt) {
    $ch = $dbopts->opt;
    if ($ch eq 'C') {
    	$elem_separator = $dbopts->optarg;
    } else {
	&usage;
    };
};

&usage if ($#ARGV < 0);

&readprocess_header;

#
# Generate a header for each new field,
# and write the code which splits the old field
# and then fills in each new field.
#
$code = '';
foreach $oldcoltag (@ARGV) {
    die ("$prog: unknown column ``$oldcoltag''.\n")
    	if (!defined($colnametonum{$oldcoltag}));
    $oldcolname = $colnames[$colnametonum{$oldcoltag}];
    @newcolnames = split(/$elem_separator/, $oldcolname);
    die ("$prog: column ``$oldcolnames'' doesn't split.\n") if ($#newcolnames == -1);
    $t = $elem_separator; $t =~ s/(\W)/\\\1/g;
    $code .= '@e = split(/' . $t . '/, $f[' .
    	$colnametonum{$oldcoltag} . ']);' . "\n";
    $ei = 0;
    foreach $newcolname (@newcolnames) {
	# col_create checks for duplicates.
    	$newnum = &col_create($newcolname);
	$code .= '$f[' . $newnum . '] = $e[' . $ei++ . '];' . "\n";
    };
};

&write_header();

my($loop) = q[
    while (<STDIN>) {
        &pass_comments && next;
        &split_cols;
] . $code . q[
        &write_cols;
    };
];
eval $loop;
$@ && die "$prog: interal eval error: $@.\n";

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