#!/usr/bin/perl -w
use strict;
use Getopt::Std;
use IPC::Open2;
use Data::Dumper;

# BUG - won't work if one column is being processed by "tac" or "sort" or
# something, only 1->1.  Might be dodgy if one program does more buffering that
# the other can cope with.

use vars qw/$opt_m/;
getopts('ma');

my @processors = ();

if ($opt_m) {
	while (@ARGV) {
		my ($slice, $process) = splice @ARGV, 0, 2;
		$process or die "usage: $0 -m ( slice process ) *";
		processor($slice, split / /, $process);
	}
} else {
	@ARGV > 1 or die "usage: $0 [-m] slice process arg arg ...\n";
	processor(@ARGV);
}

sub processor {
	my $slice = shift;
	my ($rdrfh, $wtrfh);
	open2($rdrfh, $wtrfh, @_);
	push @processors, [[map {$_>0 ? $_-1 : $_} split / /, $slice], $rdrfh, $wtrfh];
}

my ($pipe_rdr, $pipe_wtr);
pipe($pipe_rdr, $pipe_wtr);

my $pid;
my @row;
my @slice;
if (($pid = fork()) == -1) {
	die "can't fork\n";
} elsif ($pid) {
	close $pipe_rdr;
	for (@processors) {
		close $$_[1];
	}
	my $line;
	while (defined ($line = <STDIN>)) {
		chomp $line;
		@row = split /\t/, $line, -1;
		for (@processors) {
			@slice = @row[@{$$_[0]}];
			my $fh = $$_[2];
			my $slice = join("\t", @slice);  ###########
			print $fh $slice, "\n";
		}
		print $pipe_wtr "$line\n";
	}
	for (@processors) {
		close $$_[2];
	}
	close $pipe_wtr;
} else {
	my $slice;
	close $pipe_wtr;
	for (@processors) {
		close $$_[2];
	}
	my $line;
	while (defined ($line = <$pipe_rdr>)) {
		chomp $line;
		@row = split /\t/, $line, -1;
		for (@processors) {
			my $fh = $$_[1];
			chomp($slice = <$fh>);
			@row[@{$$_[0]}] = split /\t/, $slice, -1;
		}
		print join("\t", @row), "\n";
	}
	for (@processors) {
		close $$_[1];
	}
	close $pipe_rdr;
}
while (wait != -1) {}