#!/afs/athena/contrib/perl/perl
$RCS_ID = '$Id: headchg,v 2.1 1992/06/16 09:26:34 hobbs Exp $' ;
($pgm  = $0) =~ s-.*/-- ;
$HelpInfo = <<EOH ;

	    RDB operator: $pgm

Usage:  $pgm  [options]  file.tpl

Options:
    -add     Add the header to an rdbtable instead of replacing it.
    -copy    Copies the header from 'file.tpl' instead of generating it.
	     In this case 'file.tpl` is (at least a header of) an rdbtable,
	     NOT a template file.
    -del     Delete the rdbtable header instead of replacing it. No 'flie.tpl'
	     used in this case.
    -gen     Generate header only, no rdbtable read.
    -help    Print this help info.
    -ndoc    Documentation in template file is NOT to be included in the header
	     (included by default).
    -quiet   No messages printed on STDERR.
    -templ   Generate a template file from the header of the table, on STDOUT.

Replaces the header of an rdbtable with a header generated from information in
the template file 'file.tpl'.  Options are available to add, copy, or delete
the header, or to generate a template file from an existing rdbtable.

Each line of the Template file contains info about a column, in order.  The
lines contain: (optional) index number (starting at 0 or 1), column name,
definition, and (optional) column documention, white space seperated.

Comment lines appearing before the column definition lines will be put in the
new header. Other comment lines and all blank lines will be ignored.

Template file comment lines just start with a '#' char (there may be preceeding
space chars), which is slightly different from the format of rdbtable
documentation (comment) lines. These comment lines will be converted to the
other format if necessary.

The number of columns in the header is normally reported on STDERR.

This operator reads an rdbtable via STDIN (except in the case of the '-gen'
option) and writes an rdbtable via STDOUT.  Options may be abbreviated.
Uses the RDB operator: valid.

$RCS_ID
EOH
$COMM++ ;	# default doc included
while ( $ARGV[0] =~ /^-/ ) {				# Get args
    $_ = shift ;
    if( /-a.*/ ){ $ADD++ ; next ; }		# add option
    if( /-com.*/ ){ ; next ; }
    if( /-c.*/ ){ $COPY++ ; next ; }		# copy option
    if( /-d.*/ ){ $DEL++ ; next ; }		# delete option
    if( /-g.*/ ){ $GEN++ ; next ; }		# generate only option
    if( /-h.*/ ){ print $HelpInfo ; exit; }
    if( /-n.*/ ){ $COMM = 0 ; next ; }		# no doc option
    if( /-q.*/ ){ $QUIET++ ; next ; }
    if( /-r.*/ ){ $rdb++ ; $mode2++ ; next ; }
    if( /-t.*/ ){ $TPL++ ; next ; }
    die "Bad arg: $_\n", $HelpInfo ; exit ;
}
if( $TPL ){
    exec "valid -t" ; exit ; }
								# the header
if( ! $DEL ){
    open( REP, $ARGV[0] ) || die "Can't open rep.file: $ARGV[0]\n" ;
    if( $COPY ){	# copy header from rdbtable
	while(<REP>){
	    print ;
	    unless( /^#\s|^\s+#/ ){
		last if ++$lln >= 2 ; }
	}
    }
    else{
	&do_head ; }
}
if( ! $GEN ){							# copy body
    $lln = 0 ;
    while(<STDIN>){
	if( $lln < 2 ){
	    unless( /^#\s|^\s+#/ ){ $lln++ ; }
	    next unless $ADD ; }
	print ; }
}
if( ! $DEL && ! $COPY && ! $QUIET ){
    $x = scalar(@s) ;
    printf STDERR "Columns: %d\n", $x ; }
sub do_head {					# gen, write new header
    while(<REP>){
	next if /^\s*$/ ;	# skip blank lines
	if( /^\s*#/ ){		# comment line
	    if( ! $lln && $COMM ){
		if( /^#\S/ ){
		    s/^#/# / ; }# chg to valid format
		print ; }
	    next ; }
	$lln++ ;  		# logical line nr
	chop ;
	if( $lln <= 2 && $rdb ){ next ; }
	if( $lln == 1 && /^\s*[01]\.?\s/ ){ $mode2++ ; }
	@a = () ;
	while( s/\s*(\S+)// ){		# parse the line
	    $x = $1 ;
	    if( $x =~ /^\"/ ){	# dbl quote ...
		$x =~ s/^\"// ;
		if( $x !~ /\"$/ ){
		    s/[^"]*\"// ;
		    $x .= $& ; }
		$x =~ s/\"$// ;
	    }
	    push( @a, $x ) ;
	}
	shift( @a ) if $mode2 ;		# rm index nr, if any
	print "\t" if $needtab++ > 0 ;
	print shift @a ;		# print col name
	$x = join( ' ', @a ) ;
	$x =~ s/ +.*$// if ! $COMM ;
	push( @s, $x );
    }
    print "\n" ;
    print join( "\t", @s ), "\n" ;	# print data definitions
}