#!/usr/bin/env perl

use strict;
use IO::File;
use Getopt::Long;

my $Usage = <<ENDUSE;

Usage: cmpcol {-i|-u|-us|-x|-x1|-x2} [options] file1[:col\#] file2[:col\#]

 Comparison modes:
  -i        : produce intersection of file1[:col\#] and file2[:col\#]
  -u(s)     : produce union (and identify sources)
  -x        : produce exclusive-or, identifying sources
  -x1 (-x2) : produce items unique to file1 (or file2)

 Options:
  -l1 (-l2) : print whole lines from file1 or file2
  -l{a|b} [str] : print whole lines from both files joined by 'str' (def=:<>:)
  -g(v) ptn : grep (-v) -- only compare lines that (don\'t) contain /ptn/
  -c cchar  : ignore material following cchar
  -d delim  : use /delim/ as input column separator (default is white-space)

         use "-d tab" for tab-delimited,   "-d vb" for vert.bar-delimited
             "-d dot" for period-delimited "-d bs" for backslash-delimited

 file1 or file2 may be 'stdin'
 default ':col#' for comparison is first column from each file, which is ':1'
          ':-1' selects last column, ':-2' is next-to-last, etc.
          ':i,j' selects concatenation of columns i and j
ENDUSE

my %opt = ();
my $cmd_okay = GetOptions( \%opt, 'i','u','us','x','x1','x2',
                           'l1','l2','la:s','lb:s','d=s','c=s','g=s','gv=s' );
my $arg_okay = ( @ARGV == 2 and $ARGV[0] ne $ARGV[1] and 
                 ( $opt{i} + $opt{u} + $opt{us} + $opt{x} + $opt{x1} + $opt{x2} ) == 1 );

die $Usage unless ( $cmd_okay && $arg_okay );

my ( @clm, @Input );
my $lfn = '';
for ( @ARGV ) {
    my ( $fn, $cl );
    if ( /(.*):(-?[,\d]+)$/ and ( $1 eq 'stdin' or -f $1 )) {
        ( $fn, $cl ) = ( $1, $2 );
    } elsif ( /^stdin$/ or -f ) {
        ( $fn, $cl ) = ( $_, 1 );
    } else {
        die "\n$_ is not a data file.\n$Usage";
    }
    push @Input, new IO::File;
    if ( $fn eq 'stdin' ) {
        $Input[$#Input]->fdopen( fileno(STDIN), 'r' );
    } else {
        $Input[$#Input]->open( "< $fn" ) or die "$fn: $! $Usage";
    }
    push @clm, ( $cl =~ /^-/ or $cl =~ /,/ ) ? $cl : $cl - 1;
}

my $delim = '\s+';
if ( $opt{d} ne '' ) {
    my %ctrl = ( tab => "\t", dot => '\.', vb => '\|', bs => '\\\\' );
    $delim = ( exists( $ctrl{$opt{d}} )) ? $ctrl{$opt{d}} : $opt{d};
}
my $joiner = undef;
my $jointype = ( defined( $opt{la} )) ? 'la' : ( defined( $opt{lb} )) ? 'lb' : '';
if ( $jointype ) {
    $joiner = 
        ( $opt{$jointype} eq 'nl' ) ? "\n" :
        ( $opt{$jointype} eq 'tab' ) ? "\t" : ':<>:';
}
my %tknsourc = ();
my %tkndata = ();

sub simple_key
{
    return (split( /$delim/, $_[0] ))[$_[1]];
}
sub multi_key
{
    my @k = map { $_ - 1 } split /,/, $_[1];
    return join( " ", (split( /$delim/, $_[0] ))[@k] );
}

# Read lines from first file

my $getkey = ( $clm[0] =~ /,/ ) ? \&multi_key : \&simple_key;

while ( $_ = $Input[0]->getline ) {
    s/[\r\n]+$//;
    s/$opt{c}.*// if ( $opt{c} ne "" );
    next if ( /^\s*$/ || ( $opt{g} ne "" && ! /$opt{g}/ ) || ( $opt{gv} ne "" && /$opt{gv}/ ));
    s/^\s*// if ( $delim eq '\s+' );   # for /\s+/ delimited data, remove initial whitespace first
    my $k = &$getkey( $_, $clm[0] );
    $tknsourc{$k} .= "1";
    if ( $opt{l1} || defined( $joiner )) {
        $tkndata{$k} .= "$_\n";
    } 
    elsif ( $opt{l2} ) {
        $tkndata{$k} = "($k)\n";
    }
}

# Now do the same for second file

$getkey = ( $clm[1] =~ /,/ ) ? \&multi_key : \&simple_key;

while ( $_ = $Input[1]->getline ) {
    s/[\r\n]+$//;
    s/$opt{c}.*// if ( $opt{c} ne "" );
    next if ( /^\s*$/ || ( $opt{g} ne "" && ! /$opt{g}/ ) || ( $opt{gv} ne "" && /$opt{gv}/ ));
    s/^\s*// if ( $delim eq "\\s+" );
    my $k = &$getkey( $_, $clm[1] );
    $tknsourc{$k} .= "2";
    if ( defined( $joiner ) && exists( $tkndata{$k} )) {
        if ( $tkndata{$k} =~ /\n/ ) {
            $tkndata{$k} =~ s/\n/\x08$_\x0b/;
        }
        else {
            my ( $prefix ) = ( $jointype eq 'la' ) ? ( $tkndata{$k} =~ /^([^\x08]+)/ ) : '';
            $tkndata{$k} .= "$prefix\x08$_\x0b";
        }
    }
    elsif ( $opt{l2} ) {
        my $newval = (( ! exists( $tkndata{$k} )) || $tkndata{$k} eq "($k)\n" ) ?
            "$_\n" : $tkndata{$k} . "$_\n";
        $tkndata{$k} = $newval;
    }
    elsif ( $opt{l1} && ! exists( $tkndata{$k} )) {
        $tkndata{$k} = "($k)\n";
    }
}

# Now print the desired results

if ( $opt{i} ) {  # print the intersection: all records where $tknsourc{} contains "12"
    foreach my $k ( sort( keys( %tknsourc ))) {
        &printData( $k ) if ( $tknsourc{$k} =~ /12/ );
    }
}
elsif ( $opt{u} || $opt{us} ) {  # print the union: all records
    foreach my $k ( sort( keys( %tknsourc ))) {
        if ( $opt{us} ) {
            my $src = $tknsourc{$k};
            $src =~ s/11+/+1/;
            $src =~ s/22+/2+/;
            print "$k <$src\n";
        } else {
            &printData( $k );
        }
    }
}
elsif ( $opt{x} ) {  # print exclusive-or: all records where $tknsourc{} doesn't show "12"
    foreach my $k ( sort( keys( %tknsourc ))) {
        if ( $tknsourc{$k} !~ /12/ ) {
            my $src = $tknsourc{$k};
            $src =~ s/11+/+1/;
            $src =~ s/22+/2+/;
            print "$k <$src\n";
        }
    }
}
elsif ( $opt{x1} ) {  # print excl-or-1: all records where $tknsourc{} doesn't show "2"
    foreach my $k ( sort( keys( %tknsourc ))) {
        &printData( $k ) if ( $tknsourc{$k} !~ /2/ );
    }
}
elsif ( $opt{x2} ) {  # print excl-or-2: all records where $tknsourc{} doesn't show "1"
    foreach my $k ( sort( keys( %tknsourc ))) {
        &printData( $k ) if ( $tknsourc{$k} !~ /1/ ); 
    }
}

sub printData
{
    my( $k ) = @_;
    $_ = ( $opt{l1} or $opt{l2} or defined( $joiner )) ? $tkndata{$k} : "$k\n";
    if ( $jointype eq 'la' and /([^\x08\x0b]+)\x0b[^\x08\x0b]*\n/ ) {
        my $suffix = $1;
        s/\n/\x08$suffix\x0b/g;
    }
    if ( defined( $joiner )) {
        s/\x08/$joiner/g;
        tr/\x0b/\n/;
    }
    print;
}

=head1 NAME

cmpcol

=head1 SYNOPSIS

 cmpcol {-i|-u|-us|-x|-x1|-x2} [options] file1[:col\#] file2[:col\#]

 Comparison modes:
  -i        : produce intersection of file1[:col\#] and file2[:col\#]
  -u(s)     : produce union (and identify sources)
  -x        : produce exclusive-or, identifying sources
  -x1 (-x2) : produce items unique to file1 (or file2)

 Options:
  -l1 (-l2) : print whole lines from file1 or file2
  -l{a|b} [str] : print both whole lines joined by 'str' (def=:<>:)
  -g(v) ptn : grep (-v), only compare lines that (don't) contain /ptn/
  -c cchar  : ignore material following cchar
  -d delim  : use /delim/ as input column separator (def=whitespace)

         use "-d tab": tab-delimited,   "-d vb": vert.bar-delimited
             "-d dot": period-delimited "-d bs": backslash-delimited

 file1 or file2 may be 'stdin'
 default ':col#' for comparison is first column from each file (':1')
          ':-1' selects last column, ':-2' is next-to-last, etc.
          ':i,j' selects concatenation of columns i and j

=head1 DESCRIPTION

Given two lists as input (either of which could be stdin), cmpcol can
output the union, intersection or differences, and will print these to
stdout.  One or both inputs may be treated as multi-column tables
where one or more specified columns can be used to determine the set
relations.

By default the first space-separated token on each line of both files
is used as the key field, and only the unique set of keys meeting the
chosen condition is printed as output.

When using one of the "-l" options to output full lines from one or
both inputs, multiple occurrences of each key will be listed
exhaustively with the full lines that contain them.

Both "-la [sep]" and "-lb [sep]" will list full lines from both
inputs, joined together one matching pair per line, with the provided
"sep" string as the delimiter between the two source strings.  The
default separator is ":<>:".

The difference between -la and -lb has to do with happens when a given
key occurs more often in one input than the other.  The following
example will demonstrate.  Given these two input files:

 in1:
      x foo
      y bar
      z faz
      z gar
      w boo

 in2:
      a moo
      b mar
      y naz
      y paz
      z noo

The output of "cmpcol -la -i in1 in2" will produce four full lines by
repeating one line from each input:

 y bar:<>:y naz
 y bar:<>:y paz
 z faz:<>:z noo
 z gar:<>:z noo

The output of "cmpcol -lb -i in1 in2" will produce two full lines and
two partial lines -- notice that the "sep" string (the default ":<>:"
in this case) will be line-initial when there's an extra instance of
the key in the second input, and is absent from the line when the
first input has the extra instance of the key:

 y bar:<>:y naz
 :<>:y paz
 z faz:<>:z noo
 z gar

It's often more useful to use "-la tab" or "-lb tab".

=head1 AUTHOR

David Graff <graff (at) ldc (dot) upenn (dot) edu>

=cut