#!/usr/local/bin/perl

#! ADD?
#! trim B (only include lines in B that have ID in A, always include A)
#! ignore multiple
#! multiple occurrences of an ID in one file (merge each with same line in other file(s) multiple times)
#
# TEST:
#! @subfields
# id-first-column
# rows with missing id
# multiple rows with same id
# multiple columns with same header
# subdelim (bad if '|')
# blank lines, blank trailing fields


my %settings =
    (
     "input-files" => undef,
     "output-file" => undef,
     "columns" => undef,
     "delimiter" => "\t",    #! single quotes doesn't work?
     "squash" => 0,
     "id-first-column" => 0,
     "subdelimiter" => undef,
     "subfields" => undef,
     "intersection" => 0,
     "append" => 0,
    );


sub usage_exit {
    print STDERR "Usage options, in order of precedence (all modes):\n";
    print STDERR "  --input-files=?          List of source files, delimited by ','. (at least 2)\n";
    print STDERR "  --output-file=?          The output file. [stdout]\n";
    print STDERR "  --delimiter=?            Set the field delimiter. [tab]\n";
    print STDERR "  --squash                 Treat multiple consecutive delimiters as one. [no]\n";
    print STDERR "  --intersection           Only include rows for which the ID appears in all files. [no]\n";
    print STDERR "  --columns=?              The IDs or numbers of the columns to merge on, corresponding to input files. (required)\n";
    print STDERR "  --id-first-column        Put the ID in the first column and do not reproduce ID columns from input files. [no]\n";
    print STDERR "  --subdelimiter           Divide the ID column with this subdelimiter. [undefined]\n";
    print STDERR "  --subfields              Choose the subfield that contains the ID, per input file, (required if --subdelimiter)\n";
    print STDERR "All files must have the same delimiter, and the first row of each must contain the column headers.\n";
    exit(1);
}


sub parse_args {
    my $argn;

    for ($argn = 0; $argn <= $#ARGV; $argn++) {
	my $arg = $ARGV[$argn];
	if ($arg !~ /^\-\-/) {
	    print STDERR "**** all arguments start with '--' ****\n";
	    &usage_exit;
	}
	$arg =~ s/^\-\-//;

	my ($var, $val) = split(/=/, $arg);
	if (!defined($var)) {
	    print STDERR "**** can't grok '$arg' ****\n";
	    &usage_exit;
        }
	$val = -1 if (!defined($val));   # -1 denotes default value, ok for bool too
	if (exists($settings{$var})) {
            # 1 may be a valid column number, so we distinguish truth with -1
	    $val = -1 if ((!defined($val)) && (defined($settings{$var})));
	    $settings{$var} = $val;
	} else {
	    print STDERR "**** unknown option '$var' ****\n";
	    &usage_exit;
	}
    }

    return 0;
}


&parse_args;
my @input_files = split(',', $settings{'input-files'});
# check arguments
if ($#input_files < 1) {
    print STDERR "**** At least 2 input files are required. ****\n";
    usage_exit;
}
my @col_ids = split(',', $settings{'columns'});
if ($#col_ids != $#input_files) {
    print STDERR "**** You must provide columns, one for each input file, on which to merge. ****\n";
    usage_exit;
}
if ((defined($settings{'subdelimiter'})) ^ (defined($settings{'subfields'}))) {
    print STDERR "**** --subdelimiter and --subfield must be used together ****\n";
    usage_exit;
}
# catch these common delimiters that might give us trouble
if (($settings{'delimiter'} eq "|") || ($settings{'delimiter'} eq "||")) {
    $settings->{'delimiter'} =~ s/\|/\\\|/g;
}
if (($settings{'subdelimiter'} eq "|") || ($settings{'subdelimiter'} eq "||")) {
    $settings{'subdelimiter'} =~ s/\|/\\\|/g;
}
my @subfields;
if (defined($settings{'subfields'})) {
    @subfields = split(',', $settings{'subfields'});
    if ($#subfields != $#input_files) {
	print STDERR "**** You must provide subfields, one for each input file, on which to merge. ****\n";
	print STDERR "**** Use 0 where not applicable.                                             ****\n";
	usage_exit;
    }
}


# We can't currently pass a regexp for the delimiter,
# because \t and \s behave differently, and I haven't
# found a way around it.
#print "passed '".$settings{'delimiter'}."'\n";
if ($settings{'delimiter'} eq "space") {
    # must use single quote
    $settings{'delimiter'} = '\s';
} elsif ($settings{'delimiter'} eq "tab") {
    # must use single quote
    $settings{'delimiter'} = '\t';
#} else {
    # this doesn't work for spaces (tabs ok?)
#    $settings{'delimiter'} =~ s/\\t/\t/g;
#    $settings{'delimiter'} =~ s/\\s/\s/g;
}
#print "a".$settings{'delimiter'}."b<br>\n";
my $delim = $settings{'delimiter'};
my $one_delim = $delim;
#! check for weird chars
if ($settings{'squash'}) {
#    $delim = "(".$delim.")+";   #! avoid errors with multiple consecutive +'s
	$delim = $delim."+";
}


my $out_fh = STDOUT;
if (defined($settings{'output-file'})) {
    $out_fh = OUT_FH;
    if (!open($out_fh, ">".$settings{'output-file'})) {
	#!!#
	die "Cannot open output file ".$settings{'output-file'};
    }
}


my %msgs;
my %rows;
my @col_headers;
my $total_ncols = 0;
my $total_nrows = 0;
my $output_has_headers = 0;
for (my $f = 0; $f <= $#input_files; $f++) {
    my $file = $input_files[$f];
    my $id_col;   # the index of the column with that id
    my %ids;      # keeping track of which ids are in this file
    my $max_ncols;
    my $has_headers;

    if ($col_ids[$f] =~ /^(\#?)(\d+)$/) {
	$id_col = $2 - 1;
	if ($1 eq "#") {
	    $has_headers = 0;
	} else {
	    $has_headers = 1;
	}
    } else {
	$has_headers = 1;
    }
    $output_has_headers |= $has_headers;

    my $min_ncols = $max_ncols;

    if (open(IN, $file)) {
	while (<IN>) {
	    my $line = $_;
	    chomp($line);
	    my @fields;
	    #! hack - for some reason lines ending in delimiter(s) do not get the last empty field(s)
	    if ($line =~ /$delim$/) {
		my $non_delim;    # we just need something we know does not contain the delimiter
		if ($one_delim eq '-') {
		    $non_delim = '=';
		} else {
		    $non_delim = '-';
		}
		# put in a fake field after the trailing delimiter(s)
		$line .= $non_delim;
		@fields = split(/$delim/, $line);
		# remove the fake field
		$fields[$#fields] = "";
	    } else {
		@fields = split(/$delim/, $line);
	    }

	    if (($has_headers) && ($. == 1)) {
		# find ID column and push column headers
		if (!defined($id_col)) {
		    for (my $i = 0; $i <= $#fields; $i++) {
			if ($fields[$i] eq $col_ids[$f]) {
			    if (defined($id_col)) {
				die "Multiple occurrences of ".$fields[$i]." column header\n";
			    } else {
				$id_col = $i;
			    }
			}
		    }
		}
		if (!defined($id_col)) {
#		    die "Can't find ID column in $file\n";
		    print STDERR "Can't find ID column in $file\n";
		    goto SKIP_FILE;
		}
		for (my $i = 0; $i <= $#fields; $i++) {
		    unless (($i == $id_col) && 
			    (($settings{'id-first-column'}) || (($settings{'append'}) && ($f > 0)))) {
			push(@col_headers, $fields[$i]);
		    }
		}
		$max_ncols = $#fields + 1;
		$max_ncols -= 1 if (($settings{'id-first-column'}) || (($settings{'append'}) && ($f > 0)));
		next;
	    }

	    my $id;
	    if (@subfields && $subfields[$f]) {
		my @s = split($settings{'subdelimiter'}, $fields[$id_col]);
		$id = $s[$subfields[$f]-1];
	    } else {
		$id = $fields[$id_col];
	    }
	    if (!$id) {
		$msgs{"Some rows in $file are missing IDs"} = 1;
		next;
	    }
	    if ($ids{$id}) {
		die "Multiple rows have ID $id in $file\n";
	    }
	    $ids{$id} = 1;
	    if (!defined($rows{$id})) {
		# If intersection, only include this row if this is the first file
		# or there has been a row in a previous file. (optimization)
		if (($f == 0) || (!$settings{'intersection'})) {
		    $rows{$id}->{order} = $total_nrows++;
#		    print STDERR "prepad $id to $total_ncols\n";
		    for (my $c = 0; $c < $total_ncols; $c++) {
			push(@{$rows{$id}->{fields}}, "");
		    }
		}
	    }
	    if (defined($rows{$id})) {
		for (my $i = 0; $i <= $#fields; $i++) {
		    unless (($i == $id_col) &&
			    (($settings{'id-first-column'}) || (($settings{'append'}) && ($f > 0)))) {
		    # Push the field on the list of those for this row.
#		    # Catch the case where all previous files did not have this id.
#		    if (!$settings{'intersection'}) {
#			for (my $c = $#{$rows{id}}; $c < $#col_headers - $ncols; $c++) {
#			    push(@{$rows{id}}, "");
#			}
#		    }
			push(@{$rows{$id}->{fields}}, $fields[$i]);
		    }
		}
	    }

	    # subtract one for skipped col with id
	    if (($settings{'id-first-column'}) || (($settings{'append'}) && ($f > 0))) {
		if ((!defined($max_ncols)) || ($max_ncols < $#fields + 1 - 1)) {
		    $max_ncols = $#fields + 1 - 1;
		}
	    } else {
		if ((!defined($max_ncols)) || ($max_ncols < $#fields + 1)) {
		    $max_ncols = $#fields + 1;
		}
	    }
	}

	close(IN);

	$total_ncols += $max_ncols;

	# Pad the column headers if necessary.
	for (my $c = $#col_headers + 1; $c < $total_ncols; $c++) {
	    push(@col_headers, "");
	}

	# If the ID was not found, and we are in intersection mode,
	# delete the row for that ID entirely. Otherwise, be sure to
	# pad the row out to the correct number of fields.
	my @keys = keys(%rows);
	for (my $i = 0; $i <= $#keys; $i++) {
	    my $id = $keys[$i];
	    if (!$ids{$id}) {
		if ($settings{'intersection'}) {
		    delete $rows{$id};
		    next;
		} else {
#		    print STDERR "pad $id to $total_ncols\n";
		    for (my $c = $#{$rows{$id}->{fields}} + 1; $c < $total_ncols; $c++) {
			push(@{$rows{$id}->{fields}}, "");
		    }
		}
	    }
	}
    }
SKIP_FILE:
}

if ($output_has_headers) {
    print $out_fh ($settings{'id-first-column'})? "ID".$one_delim:"", join($one_delim, @col_headers),"\n";
}

foreach my $id (sort { $rows{$a}->{order} <=> $rows{$b}->{order} } keys %rows) {
#    print $out_fh $id,$one_delim,join($one_delim, @{$rows{$id}->{fields}}),$one_delim."(".$rows{$id}->{order}.")\n";
    print $out_fh ($settings{'id-first-column'})? $id.$one_delim:"", join($one_delim, @{$rows{$id}->{fields}}),"\n";
}

foreach (keys(%msgs)) {
    print STDERR $_."\n";
}

exit(0);
