#!/usr/bin/perl

# Time-stamp: <2007-06-22 15:56:09 kasper>

use warnings;
use strict;
use Getopt::Long;
use constant USAGE =><<END;

SYNOPSIS:

 tablefilter.pl [OPTIONS] <condition string> [infile [outfile]]

DESCRIPTION:

This script filters a table based on a specifies string of
conditions. Quote the string in '' not to interpolate the \$ vars in
the shell. See example.

OPTIONS:

       --help
             Prints this help.
       --seperator <char>
             Column seperator. Default is tabs

EXAMPLES:

 # Get rows where value of column one is not between 3.2 and 6.1 and
 # where the string in column four is 'foobar':

 cat file.tbl | tablefilter.pl '(\$1 < 3.2 || \$1 > 6.2) && \$4 eq \'foobar\''

 # Get rows where the first of ':'-seperated columns is lexically
 # smaller than 'foobar':

 tablefilter.pl --seperator ':' '\$1 lt \'foobar\'' file.tbl newfile.tbl

AUTHOR:

Kasper Munch

COPYRIGHT:

This program is free software. You may copy and redistribute it under
the same terms as Perl itself.

END

my $help = 0;
my $seperator = "\t";

GetOptions(
           "help" => \$help,
          ) or die USAGE;

$help and die USAGE;

my $condition = shift @ARGV or die USAGE;

@ARGV = ('-') unless @ARGV;
my $input = shift @ARGV;
open my $in, "$input" or die "$input: $!\n";
@ARGV = ('>&STDOUT') unless @ARGV;
my $output = shift @ARGV;
open my $out, ">$output" or die "$output: $!\n";

while (<$in>) {
  next if /^#/;
  chomp;
  my @columns = split /$seperator/, $_;
  $condition =~ s/(\$([0-9]+))/\$columns[$2 - 1]/g;
  print $out "$_\n" if eval $condition;
}

=head1 SYNOPSIS:

 tablefilter.pl [OPTIONS] <condition string> [infile [outfile]]

=head1 DESCRIPTION:

This script filters a table based on a specifies string of
conditions. Quote the string in '' not to interpolate the $ vars in
the shell. See example.

=head1 OPTIONS:

=over 4

=item --help

Prints this help.

=item --seperator <char>

Column seperator. Default is tabs

=back

=head1 EXAMPLES:

 # Get rows where value of column one is not between 3.2 and 6.1 and
 # where the string in column four is 'foobar':

 cat file.tbl | tablefilter.pl '($1 < 3.2 || $1 > 6.2) && $4 eq \'foobar\''

 # Get rows where the first of ':'-seperated columns is lexically
 # smaller than 'foobar':

 tablefilter.pl --seperator ':' '$1 lt \'foobar\'' file.tbl newfile.tbl

=head1 AUTHOR:

Kasper Munch

=head1 COPYRIGHT:

This program is free software. You may copy and redistribute it under
the same terms as Perl itself.


=cut