col_grep

   1 #! /usr/bin/perl
   2 # col_grep greps a column matching a pattern, and is released
   3 # under the terms of the GPL version 2, or any later version, at your
   4 # option. See the file README and COPYING for more information.
   5 # Copyright 2008 by Don Armstrong <don@donarmstrong.com>.
   6 # $Id: perl_script 1153 2008-04-08 00:04:20Z don $
   7
   8
   9 use warnings;
  10 use strict;
  11
  12 use Getopt::Long;
  13 use Pod::Usage;
  14
  15 =head1 NAME
  16
  17 col_grep - grep for a column matching a pattern
  18
  19 =head1 SYNOPSIS
  20
  21 col_grep [options] PATTERN [FILE...]
  22 col_grep [options] [-e PATTERN] [FILE...]
  23
  24  Options:
  25   --delimiter, -d Delimiter to use (default tab)
  26   --regexp, -e pattern to match
  27   --fields, -f field number to match (default 1)
  28   --help, -h display this help
  29   --man, -m display manual
  30
  31 =head1 OPTIONS
  32
  33 =over
  34
  35 =item B<--delimiter,-d>
  36
  37 Delimiter to use, defaults to tab
  38
  39 =item B<--regexp, -e>
  40
  41 Pattern to match
  42
  43 =item B<--fields, -f>
  44
  45 Field number to match; starts at 1
  46
  47 =item B<--help, -h>
  48
  49 Display brief useage information.
  50
  51 =item B<--man, -m>
  52
  53 Display this manual.
  54
  55 =back
  56
  57 =head1 EXAMPLES
  58
  59
  60 =cut
  61
  62
  63 use vars qw($DEBUG);
  64
  65 my %options = (debug            => 0,
  66                help             => 0,
  67                man              => 0,
  68                delimiter        => "\t",
  69                field            => [],
  70                regexp           => [],
  71               );
  72
  73 GetOptions(\%options,
  74            'delimiter=s',
  75            'field|f=s@',
  76            'regexp|e=s@',
  77            'debug|d+','help|h|?','man|m');
  78
  79 pod2usage() if $options{help};
  80 pod2usage({verbose=>2}) if $options{man};
  81
  82 $DEBUG = $options{debug};
  83
  84 my @USAGE_ERRORS;
  85 # if (1) {
  86 #      push @USAGE_ERRORS,"You must pass something";
  87 # }
  88
  89 if (not @{$options{field}}) {
  90     $options{field} = [1];
  91 }
  92
  93 my @field_indexes = map { $_ > 0 ? $_ - 1 : $_;}
  94     map {split /,/} @{$options{field}};
  95 my %field_indexes;
  96 @field_indexes{@field_indexes} = @field_indexes;
  97 @field_indexes = values %field_indexes;
  98
  99 if (grep {not /-?\d+/} @field_indexes) {
 100     push @USAGE_ERRORS,"Invalid field index(es)";
 101 }
 102
 103 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 104
 105 if (not @{$options{regexp}} and @ARGV) {
 106     push @{$options{regexp}}, shift @ARGV;
 107 }
 108
 109 my %compiled_regexes;
 110 LINE: while (<>) {
 111     my $chomped = chomp;
 112     my $line = $_;
 113     my @fields = split /$options{delimiter}/;
 114     # skip lines which don't have enough fields
 115     next LINE if grep {not defined $_} @fields[@field_indexes];
 116  REGEX: for my $regex (@{$options{regexp}}) {
 117     FIELDS: for my $field (@fields[@field_indexes]) {
 118             if (length $regex) {
 119                 if (not exists $compiled_regexes{$regex}) {
 120                     $compiled_regexes{$regex} = qr/$regex/;
 121                 }
 122                 $field =~ $compiled_regexes{$regex} or next LINE;
 123             }
 124         }
 125     }
 126     print $_;
 127     print $/ if $chomped;
 128 }
 129
 130
 131 __END__