#!/usr/bin/perl -w

use strict;

my $fields_in = ($ARGV[0]||'') eq "F"
	and shift;
my $fields_out = ($ARGV[0]||'') eq "f"
	and shift;
my $no_named_fields = ($ARGV[0]||'') eq "N"
	and shift;

@ARGV >= 1 and ($fields_in || $no_named_fields xor @ARGV > 1)
	or die "syntax: $0 F [f] [N] predicate < input > output\n        $0 [f] [N] predicate fields < input > output\n";

my $predicate = shift;

my @fields;
if ($fields_in) {
	chomp(my $line = <STDIN>);
	@fields = split /\s+/, $line, -1;
} else {
	@fields = @ARGV;
}

my $my_fields = join ', ', map "\$$_", @fields;

my $before_predicate = '';

unless ($no_named_fields) {
	$before_predicate = "my ($my_fields) = \@row;\n";
}

if ($fields_out) {
	print join "\t", @fields;
	print "\n";
}

eval q%
	my $line;
	my @row;
	while (defined ($line = <STDIN>)) {
		chomp $line;
#		print ">$line";
		@row = split /\\t/, $line, -1;
		for (@row) {
			if ($_ eq "\\0") {
				undef $_;
			} else {
				s/([^\\\\]|^)((?:\\\\\\\\)*)\\\\0/$1$2\\0/g;
				s/([^\\\\]|^)((?:\\\\\\\\)*)\\\\n/$1$2\\n/g;
				s/([^\\\\]|^)((?:\\\\\\\\)*)\\\\t/$1$2\\t/g;
				s/\\\\\\\\/\\\\/g;
			}
		}
% . qq%
		if (do {
			$before_predicate
			$predicate
		}) {
			print \$line;
			print "\n";
		}
	}
%;
if ($@) {
	die "predicate error: $@\n";
}