#! /usr/bin/perl
# col_grep greps a column matching a pattern, and is released
# under the terms of the GPL version 2, or any later version, at your
# option. See the file README and COPYING for more information.
# Copyright 2008 by Don Armstrong <don@donarmstrong.com>.
# $Id: perl_script 1153 2008-04-08 00:04:20Z don $


use warnings;
use strict;

use Getopt::Long;
use Pod::Usage;

=head1 NAME

col_grep - grep for a column matching a pattern

=head1 SYNOPSIS

col_grep [options] PATTERN [FILE...]
col_grep [options] [-e PATTERN] [FILE...]

 Options:
  --delimiter, -d Delimiter to use (default tab)
  --regexp, -e pattern to match
  --fields, -f field number to match (default 1)
  --help, -h display this help
  --man, -m display manual

=head1 OPTIONS

=over

=item B<--delimiter,-d>

Delimiter to use, defaults to tab

=item B<--regexp, -e>

Pattern to match

=item B<--fields, -f>

Field number to match; starts at 1

=item B<--help, -h>

Display brief useage information.

=item B<--man, -m>

Display this manual.

=back

=head1 EXAMPLES


=cut


use vars qw($DEBUG);

my %options = (debug            => 0,
	       help             => 0,
	       man              => 0,
	       delimiter        => "\t",
	       field            => [],
	       regexp           => [],
	      );

GetOptions(\%options,
	   'delimiter=s',
	   'field|f=s@',
	   'regexp|e=s@',
	   'debug|d+','help|h|?','man|m');

pod2usage() if $options{help};
pod2usage({verbose=>2}) if $options{man};

$DEBUG = $options{debug};

my @USAGE_ERRORS;
# if (1) {
#      push @USAGE_ERRORS,"You must pass something";
# }

if (not @{$options{field}}) {
    $options{field} = [1];
}

my @field_indexes = map { $_ > 0 ? $_ - 1 : $_;}
    map {split /,/} @{$options{field}};
my %field_indexes;
@field_indexes{@field_indexes} = @field_indexes;
@field_indexes = values %field_indexes;

if (grep {not /-?\d+/} @field_indexes) {
    push @USAGE_ERRORS,"Invalid field index(es)";
}

pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;

if (not @{$options{regexp}} and @ARGV) {
    push @{$options{regexp}}, shift @ARGV;
}

my %compiled_regexes;
LINE: while (<>) {
    my $chomped = chomp;
    my $line = $_;
    my @fields = split /$options{delimiter}/;
    # skip lines which don't have enough fields
    next LINE if grep {not defined $_} @fields[@field_indexes];
 REGEX: for my $regex (@{$options{regexp}}) {
    FIELDS: for my $field (@fields[@field_indexes]) {
	    if (length $regex) {
		if (not exists $compiled_regexes{$regex}) {
		    $compiled_regexes{$regex} = qr/$regex/;
		}
		$field =~ $compiled_regexes{$regex} or next LINE;
	    }
	}
    }
    print $_;
    print $/ if $chomped;
}


__END__