#! /usr/bin/perl
$RCS_ID = '$Id: mergetbl,v 2.4 1993/04/18 10:33:31 hobbs Exp $' ;
$0 =~ s-.*/-- ;
$DSTG = ">>DEL<<" ;	# default delete string
$HelpInfo = <<EOH ;

			RDB operator: $0

Usage:  $0  [options]  < old_table  column  ...  merge_table

Options:
    -add     Add option. Add rows where the key column(s) match.
    -d       Delete option. Delete rows where the key column(s) match and
	     the data value in the delete column is equal to the delete
	     string, "$DSTG" (without the quotes) by default.
    -dSTG    Like the delete option above but use 'STG' as the delete string.
    -help    Print this help info.
    -rev     Reverse option. The tables are sorted in reverse order.

This operator merges and/or deletes rows of 'old_table' based on data values
in 'merge_table' in the specified column(s).  Both tables should be sorted
on the specified column(s).

In the normal case, one or more rows in 'merge_table' either replace one or
more existing rows in 'old_table' if the key column(s) match, or are inserted
in order if the key column(s) do NOT match.

If the delete option is specified on the command line, one or more existing
rows in 'old_table' will be deleted if there is a key column(s) match and the
data in the delete column is equal to the delete string, "$DSTG" (without
the quotes) by default.  The delete column is the first non-key column in
'merge_table'.

If the add option is specified on the command line, all rows from 'old_table'
and 'merge_table' will be put into the new table, in the proper order.

Both tables should have similar data structures. The header for the new
rdbtable is taken from 'merge_table', thus allowing a change of header 
information to be made.

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

$RCS_ID
EOH
#    -ht      Hashtable index merge. Generates new index file also.
while ( $ARGV[0] =~ /^-/ ){				# Get args
    $_ = shift ;
    if( /-a.*/ ){ $ADD++ ; next ; }
    if( /-d(.*)/ ){ $DEL++ ; $DSTG = $1 if $1 ; next ; }
    if( /-ht.*/ ){ $HTI++ ; next ; }
    if( /-h.*/ ){ print $HelpInfo ; exit 1 ; }
    if( /-r.*/ ){ $REV++ ; next ; }
    if( /-x.*/ ){ $XBUG++ ; next ; }
    die "\nBad arg: $_\n", "For help type \"$0 -help\".\n" ; 
}
die "\n$0: Not enough info given.\n", "For help type \"$0 -help\".\n"
    unless @ARGV >= 2 ;
die "\n$0: Can't use both add and delete options.\n",
    "For help type \"$0 -help\".\n" if $DEL && $ADD ;
$mgtbl = pop(@ARGV) ;
open( MT, $mgtbl ) || die "\nCan't open merge_tbl: $mgtbl.\n" ;
while( <STDIN> ){					# read old_tbl header
    if( /^\s*#/ ){	# comment 
	next ; }
    chop ;
    if( ++$lln == 1 ){
	@CN = split( /\t/, $_ );	# col names
	$NC = @CN ;
	next ; }
    @CD = split( /\t/, $_ );		# col definitions
    for (@CD){
	($_) = /(\S+)/ ; }	# keep only 1st word
    last ; }
while( <MT> ){						# read merge_tbl header
    print ;
    if( /^\s*#/ ){	# comment 
	next ; }
    chop ;
    if( ++$mln == 1 ){
	@MCN = split( /\t/, $_ );	# col names
	next ; }
    # @MCD = split( /\t/, $_ );		# col definitions (not used)
    last ; }
if( @CN != @MCN ){
	die "\nDifferent column count in merge_tbl, old_tbl.\n" ; }
for $col (@ARGV){		# chk column name ndx, set @KEY, #numcmp, $delx
    for( $delx = -1, $k=$i=0 ; $i < @CN ; $i++ ){
	if( $col eq $CN[$i] ){
	    $k++ ;
	    push( @KEY, $i ) ;
	    $x = ($CD[$i] =~ /N/i ? 1 : 0 ) ;
	    push( @numcmp, $x ) ;
	    next ; }
	$delx = $i if $delx < 0 ;	# delete column index
    }
    die "\nColumn name no match: $col\n" unless $k ;
}
&read_old ; &read_merge ;
while( 1 ){						# main loop
    if( $eof ){
	if( ! $eofa ){
	    until( $eofa ){
		print $a, "\n" ;
		&read_old ; } }
	if( ! $eofb ){
	    until( $eofb ){
		print $b, "\n" ;
		&read_merge ; } }
	exit 0 ;
    }
    if( ($c = &cmp_key) < 0 ){	# old < merge
	if( ! $REV ){
	    print $a, "\n" ;
	    &read_old ; }
	else{
	    print $b, "\n" ;
	    &read_merge ; } }
    elsif( $c > 0 ){		# old > merge
	if( ! $REV ){
	    print $b, "\n" ;
	    &read_merge ; }
	else{
	    print $a, "\n" ;
	    &read_old ; } }
    else{			# old == merge
	&do_replace ; }
}
sub do_replace {				# replace or delete row(s)
    do {
	print $b, "\n" unless $DEL && &del_stg ;
	@PG = @G ;		# prev @G
	&read_merge ;
    } while( ! $eofb && &same_keyb ) ;
    do {
	print $a, "\n" if $ADD ;
	@PF = @F ;		# prev @F
	&read_old ;
    } while( ! $eofa && &same_keya ) ;
}
sub same_keya {		# return 1 iff curr row a key = prev row a key
    for( $i=0 ; $i < @KEY ; $i++ ){
	$k = $KEY[$i] ;
	if( $numcmp[$i] ){
	    return 0 if $F[$k] != $PF[$k] ; }
	else{
	    return 0 if $F[$k] ne $PF[$k] ; }
    }
    1 ;
}
sub same_keyb {		# return 1 iff curr row b key = prev row b key
    for( $i=0 ; $i < @KEY ; $i++ ){
	$k = $KEY[$i] ;
	if( $numcmp[$i] ){
	    return 0 if $G[$k] != $PG[$k] ; }
	else{
	    return 0 if $G[$k] ne $PG[$k] ; }
    }
    1 ;
}
sub del_stg {			# return 1 iff the delete string is present
    return 1 if $G[$delx] eq $DSTG ;
    0 ;
}
sub cmp_key {		# compares the value of key cols of line a & line b
			# returns -1, 0, 1 if a<b, a==b, or a>b
    for( $i=0 ; $i < @KEY ; $i++ ){
	$k = $KEY[$i] ;
	if( $numcmp[$i] ){
	    if( $F[$k] < $G[$k] ){	# numeric comparsion
		return -1 ; }
	    if( $F[$k] > $G[$k] ){
		return 1 ; }
	}
	else{
	    if( $F[$k] lt $G[$k] ){	# string comparsion
		return -1 ; }
	    if( $F[$k] gt $G[$k] ){
		return 1 ; }
	}
    }
    0 ;
}
sub read_old {			# read next line from old_tbl into $a & @F
    $a = <STDIN> ;
    if( $a ){
	chop $a ;
	@F = split( /\t/, $a, $NC ) ; }
    else{
	$eof++ ; $eofa++ ; }
}
sub read_merge {		# read next line from merge_tbl into $b & @G
    $b = <MT> ;
    if( $b ){
	chop $b ;
	@G = split( /\t/, $b, $NC ) ; }
    else{
	$eof++ ; $eofb++ ; }
}