#!/usr/bin/perl -w

#
# dbrecolize
# Copyright (C) 1997-1998 by John Heidemann <johnh@isi.edu>
# $Id: dbrecolize,v 1.10 2003/05/23 04:15:48 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 new-field-separator

Covert an existing colized list into a new one with a different
field separator.

Possible field separators:
    D (default)	    any amount of whitespace
    S		    two or more spaces (supports single spaces in fields)
    t		    a single tab
    anything else   a single copy of whatever you specify

These separators appear on in the table header as -Fx.

(Regardless of what the column separator is for the body of the data,
it is always whitespace in the header.)

Sample input:
#h name id test1
a 1 80
b 2 70
c 3 65

Sample command:
cat data.jdb | dbrecolize S

Sample output:
#h -FS name id test1
a  1  80
b  2  70
c  3  65
#  | dbrecolize S


Sample input 2:
#h name id test1
a 1 80
b    2   70
c	3	65
# default (any number of spaces)
# S = two or more spaces
# t = single tab

#h -FS name id test1
a  1  80
b    2   70
c  3   65
# default (any number of spaces)
# S = two or more spaces
# t = single tab

#h -Ft name id test1
a	1	80
b	2	70
c	3	65
# default (any number of spaces)
# S = two or more spaces
# t = single tab

Sample command:
cat data.jdb | dbrecolize D

Sample output:
#h name id test1
a       1       80
b       2       70
c       3       65
# default (any number of spaces)
# S = two or more spaces
# t = single tab
#  | dbrecolize D

Related programs:
    dbcolneaten, dbcolize, dblistize

END
    exit 1;
}

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

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


&readprocess_header;

my($new_fsre, $new_outfs) = fs_code_to_fsre_outfs($new_fs_code);
@coloptions = grep(!/^-F/, @coloptions);
push(@coloptions, "-F$new_fs_code")
    if ($new_fs_code ne 'D');    # default

&write_header();

# switch outfs
$outfs = $new_outfs;
$outfs = $new_outfs;  # suppress warning

@f = ();   # suppress warning
while (<STDIN>) {
    &pass_comments && next;
    &split_cols;
    foreach (@f) {
	die("$prog: existing field contains new field separator: ``$_'' contains ``$new_fsre''.\n")
	    if (/$new_fsre/);
    };
    &write_cols;
};

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