#!/afs/athena/contrib/perl/perl
$RCS_ID = '$Id: sorttbl,v 2.1 1992/06/10 15:30:48 hobbs Exp $' ;
$0 =~ s-.*/-- ;
$HelpInfo = <<EOH ;

	    RDB operator: $0

Usage:  $0  [options]  [-r]  column  [[-r]  column]  ...

Options:
    -c       Check that the rdbtable is sorted on the selected columns.
    -d       Dictionary order. Only letters, digits, and SPACE are significant
	     in comparisons.
    -f       Fold in lower case. Treat upper- and lower-case letters equally.
    -help    Print this help info.
    -i       Ignore characters outside the ASCII range 040-0176 in non-numeric
	     comparisons.
    -r       Reverse order. Applys to the following column only.
    -u       Make rows unique on selected columns.

Sorts an rdbtable on one or more columns. Each column may be sorted in normal
(ascending) or reverse (descending) order. Note that the '-r' on the command
line applies only to the next column; the absense of a '-r' means the next
column will sort in normal order.

Also a column of monthnames (Jan, Apr, ...) in any case letters, may be sorted.

This operator reads an rdbtable via STDIN and writes an rdbtable via STDOUT.
Options may be abbreviated.

$RCS_ID
EOH
while ( $ARGV[0] =~ /^-/ ){				# Get args
    $_ = shift ;
    if( /-c.*/ ){
	$CHK++ ;
	$sarg .= '-c ' ;  		# check sort order
	next ; }
    if( /-d.*/ ){			# Dictionary order
	$sarg .= '-d ' ; next ; }
    if( /-f.*/ ){			# fold up/low case
	$sarg .= '-f ' ; next ; }
    if( /-h.*/ ){
	print $HelpInfo ; exit; }
    if( /-i.*/ ){			# Ignore bad characters
	$sarg .= '-i ' ; next ; }
    if( /-r.*/ ){			# descending order
	$cf .= 'r' ;
	$sarg .= '-r ' ; next ; }
    if( /-u.*/ ){			# unique
	$sarg .= '-u ' ; next ; }
    if( /-x.*/ ){ $XBUG++ ; next ; }
    die "Bad arg: $_\n", $HelpInfo ; exit ;
}
if( @ARGV ){
    $sarg =~ s/\-r// ; }	# unless reverse sort by entire rows
$|++ ;		# to force out 1st 2 lines (in pipe)
while(<STDIN>){
    if( $lln < 2 ){
	print unless $CHK ;
	if( /^#\s|^\s+#/ && ! $lln ){ next ; }	# comment
	chop ;
	@H = split( /\t/, $_ );
	if( ++$lln == 1 ){			# header line
	    @F = @H ;
	    &get_col_x ; }  	# chk column names
	else{		# definition line
	    $| = 0 ;
	    for $arg ( @ARGV ){
		if( $arg =~ /^-r.*/ ){
		    $cf .= 'r' ;
		    next ; }
		for( $f=0, $g=1 ; $f <= $#F ; $f++, $g++ ){
		    if( $arg eq $F[$f] ){
			if( $H[$f] =~ /(\S+)/ && $1 =~ /N/i ){ # numeric
			    $cf .= 'n' ; }
			if( $H[$f] =~ /(\S+)/ && $1 =~ /M/i ){ # month
			    $cf .= 'M' ; }
			$sarg .= "+$f -$g$cf " ;
			$cf = '' ;
			last ; }
		}
	    }
	    if( $CHK && $sarg =~ /\+/ ){
		$ADDCOL++ ;
		$f = @H ;
		$g = $f +1 ;
		$cf = 'n' ;
		$sarg .= "+$f -$g$cf " ; }
	    print "sort arg:  -t\"\t\" $sarg\n" if $XBUG ;
	    open( SS, "| sort -t\"\t\" $sarg" ) ||	# UNIX sort
		die "Can't open pipe to sort\n" ;
	}
	next ;
    }
    if( $ADDCOL ){	# add dummy column for check option
	chop ;
	print SS $_, "\t", $., "\n" ; }
    else{		# normal case
	print SS $_ ; }
}
close( SS ) ;
sub get_col_x {		# get, chk column indexes, inc -v, die if bad column
			# uses @H, $INV, put indexes in @n.
			# modified for sorttbl.
    local( $f, $ok, @nn ) ;
    for $arg (@ARGV){
	next if $arg =~ /^-/ ;
	for( $ok=$f=0 ; $f < @H ; $f++ ){
	    if( $arg eq $H[$f] ){	# match existing column
		$ok++ ;
		push( @n, $f );
		last ; }
	}
	die "$0: Bad column name: $arg\n" if ! $ok ;
    }
    if( $INV ){					# inverse option
	loop: for( $f=0 ; $f < @H ; $f++ ){
	    for $i (@n){
		next loop if $i eq $f ; }
	    push( @nn, $f ); }
	@n = @nn ;
    }
}