bin/fpg

   1 #!/usr/bin/perl -w
   2 #
   3 # Programname:                  fpg - Frams' Perl grep
   4 # Author:                       framstag@rus.uni-stuttgart.de
   5 # Licence:                      Perl Artistic
   6 #
   7 # History:
   8 #   2003-02-27 Framstag         initial version
   9 #   2003-02-28 Framstag         added exit status
  10 #   2007-03-09 Framstag         added option -Q
  11 #   2007-06-01 Framstag         added options -s and -c
  12 #                               and changed default output mode
  13 #   2007-06-03 Framstag         added ReadLine-support
  14 #   2007-08-31 Framstag         added option -x
  15 #   2008-02-06 Framstag         added implicit gunzip
  16 #                               -F ==> -R, new -F option
  17 #   2008-10-07 Framstag         added option -p
  18 #                               -n ==> -S, new -n option
  19 #   2008-10-14 Framstag         added option -M
  20 #   2008-11-23 Framstag         added option -~
  21 #   2016-06-12 Framstag         option -o respects (match)
  22
  23 use Getopt::Std;
  24 use Term::ReadLine;
  25 use locale;
  26
  27 $0 =~ s:.*/::;
  28 $| = 1;
  29
  30 $usage  = <<EOD;
  31 usage: $0 [options] 'EXP' [file...]
  32    or: $0 [options] -Q file...
  33 options: -r        recursively scan through directories
  34          -i        ignore case
  35          -v        print only lines that do NOT match
  36          -s        verbose scanning/searching
  37          -n        prefix with line number
  38          -l        list filenames only
  39          -L        list filenames only that do NOT match
  40          -p        show paragraphs, not lines (multiline record separator)
  41          -o        show only matched strings (in parenthesis), not whole lines
  42          -M        mail-mode: search and show complete mails from mbox files
  43          -c        print (count) only number of matches (NOT LINES!)
  44          -F        EXP is a string, not a Perl regular expression
  45          -e        EXP is any perl code which returns TRUE/FALSE
  46          -S \#      minimum string length \# for binary files, default: 4
  47          -C \#      \# lines of context
  48          -R 'RS'   record separator, default: newline (\\n) if not set -p
  49          -x 'exp'  extra regexp for highlighting (not used for searching)
  50          -X 'exp'  exclude files (filename matching this regexp) when searching
  51          -~        search in backup files *~ #*#, too
  52          -Q        query-loop-prompt for search expression (with readline)
  53 arguments: EXP     is a Perl regular expression
  54            file... can be one or more files, even binary or compressed ones
  55 EOD
  56 #examples: $0 -r 'from.*STDIN' *
  57 #          $0 -e 'length>30 and not /\\w/' script
  58 #See "perldoc perlre" for help on regular expressions.
  59
  60
  61 $maxlen = 0;
  62
  63 $opt_i = $opt_r = $opt_v = $opt_l = $opt_h = $opt_e = $opt_n = $opt_o = 0;
  64 $opt_s = $opt_c = $opt_Q = $opt_F = $opt_p = $opt_M = $opt_C = $opt_S = 0;
  65 ${'opt_~'} = 0;
  66 $opt_S = 4;
  67 $opt_x = $opt_X = '';
  68 $opt_R = "\n";
  69
  70 getopts('hirvlLFMopscQen~S:R:C:x:X:') or die $usage;
  71
  72 if ($opt_h) {
  73   print $usage;
  74   exit;
  75 }
  76
  77 unless ($opt_Q) {
  78   $exp = shift or die $usage;
  79 }
  80
  81 if ($opt_C and ($opt_l or $opt_L or $opt_s or $opt_v or $opt_p or $opt_M)) {
  82   die "$0: cannot mix option -C with any of -l -L -s -v -p -M\n";
  83 }
  84
  85 if ($opt_M and ($opt_l or $opt_L or $opt_s or $opt_v or $opt_p or $opt_C)) {
  86   die "$0: cannot mix option -M with any of -l -L -s -v -p -C\n";
  87 }
  88
  89 if ($opt_o and ($opt_v or $opt_l or $opt_L or $opt_c or $opt_F or $opt_C)) {
  90   die "$0: cannot mix option -E with any of -l -L -v -c -C -F\n";
  91 }
  92
  93 $opt_XX = 0;
  94 if (not ${'opt_~'}) {
  95   @bfiles = grep(/~$|^#.*#$/,@ARGV);
  96   if (@bfiles and
  97       (grep(/[^~]$/,@ARGV) or grep(/(^|\/)#[^\/]*#$/,@ARGV))) {
  98     $opt_XX = 1;
  99     warn "$0: ignoring @bfiles\n"; # unless $opt_r;
 100   }
 101 }
 102
 103 if (-t STDOUT) {
 104   $B = "\033[1m";
 105   $N = "\033[m";
 106 } else {
 107   $B = $N = '';
 108 }
 109
 110 if ($opt_p) { $/ = '' }
 111 else        { $/ = $opt_R }
 112 #else        { eval '$/ = "'.$opt_R.'"' }
 113
 114 $opt_h = 1 if not $opt_r and @ARGV < 2;
 115
 116 if ($opt_Q) {
 117   $q = new Term::ReadLine $0;
 118   $q->ornaments(0) unless $ENV{PERL_RL};
 119   for (;;) {
 120     $exp = $q->readline("$B\nsearch-expression:$N ");
 121     last unless $exp;
 122     &scan;
 123   }
 124 } else {
 125   &scan;
 126 }
 127
 128 exit ($found?0:1);
 129
 130 sub scan {
 131   $egrep = '';
 132   if ($opt_e) {
 133     eval "\$egrep =  sub { $exp }";
 134   } else {
 135     $exp =~ s/([\@\$\%\^\&\*\(\)\+\[\]\{\}\\\|\.\?])/\\$1/g if $opt_F;
 136     $exp = '(?i)'.$exp if $opt_i;
 137     $exp = '(?s)'.$exp if $opt_p or $opt_R ne "\n";
 138     #? $exp =~ s/\.\*\*/[.\n]*/g;
 139   }
 140
 141   $found = 0;
 142
 143   if (@ARGV) {
 144     foreach $file (@ARGV) {
 145       next if $opt_X  and $file =~ /$opt_X/;
 146       next if $opt_XX and ($file =~ /~$/ or $file =~ m{(^|/)#[^/]*#$});
 147       my $error = ''; open $file,$file or $error = $!; close $file;
 148       if ($error) {
 149         warn "$0: cannot read file $file - $error\n";
 150         next;
 151       }
 152       unless (-f $file or -d $file or -c $file or -S $file or -p $file) {
 153         warn "$0: ignoring special file $file\n";
 154         next;
 155       }
 156       $maxlen = length $file if $maxlen < length $file;
 157       # printf "%s\r",substr("scanning $file".(" " x 255),0,$maxlen+9) if -t STDOUT;
 158       # print  $B."scanning $file\n".$N if -t STDOUT and not $opt_l||$opt_L;
 159       if ($opt_r and -d $file) {
 160         $found += grepd($file);
 161         next;
 162       }
 163       # next if -z $file; # Achtung: special files unter /proc sind "empty" !
 164       # $type = `file -L $file`;
 165       # if ($type =~ /text/i and open F,$file or open F,"strings $file|") {
 166       $fileq = quotemeta $file;
 167       if (-T $file) {
 168         open $file,$file;
 169         # warn "$file\n";
 170       } else {
 171         if ($file =~ /\.bz2$/) {
 172           open $file,"bunzip2 <$fileq|";
 173           # warn "gunzip <$file|\n";
 174         } elsif ($file =~ /\.gz$/) {
 175           open $file,"gunzip <$fileq|";
 176           # warn "gunzip <$file|\n";
 177         } else {
 178           open $file,"strings -a -n $opt_S $fileq|";
 179           # warn "strings -n $opt_S $file|\n";
 180         }
 181       }
 182       if (fileno $file) {
 183         $found += grepf($file,$file);
 184         close $file;
 185       } else {
 186         warn "$0: cannot open $file - $!\n";
 187         next;
 188       }
 189     }
 190     # print " " x ($maxlen+9),"\r" if -t STDOUT;
 191   } else {
 192     $found = grepf(STDIN);
 193   }
 194 }
 195
 196 sub grepd {
 197   my $dir = shift;
 198   my $file;
 199   my $found = 0;
 200
 201   opendir $dir,$dir or return;
 202   while (defined($file = readdir $dir)) {
 203     next if $file eq '.' or $file eq '..';
 204     if (not ${'opt_~'} and $file =~ /~$|^#[^\/]*#$/) {
 205       # warn "$0: ignoring $dir/$file\n";
 206       next;
 207     }
 208     $file = "$dir/$file";
 209     next unless -r $file;
 210     if (-d $file and not -l $file) {
 211       $found += grepd($file);
 212       next;
 213     }
 214     next unless -f $file or -c $file or -S $file or -p $file or -z $file;
 215     $fileq = quotemeta $file;
 216     if (-T $file and open $file,$file or
 217         open $file,"strings -a -n $opt_S $fileq|") {
 218       $found += grepf($file,$file);
 219       close $file;
 220     }
 221   }
 222   closedir $dir;
 223   return $found;
 224 }
 225
 226
 227 sub grepf {
 228   my $F = shift;
 229   my $file = shift;
 230   my $found = 0;
 231   my ($n,$l,$c);
 232
 233   warn $B."scanning $file".$N."\n" if -t STDOUT and $opt_s;
 234
 235   while (<$F>) {
 236     $_ .= "\n" unless /\n$/;
 237     if ($opt_M) {
 238       if ($mail and (/^From / or eof $F)) {
 239         my $__ = $_;
 240         $_ = $mail;
 241         $mail = $__;
 242       } else {
 243         $mail .= $_;
 244         next;
 245       }
 246     }
 247     $l++;
 248     $n = 0;
 249     if ($opt_C) {
 250       for (my $i=$opt_C;$i;$i--) {
 251         $C{$i} = $C{$i-1} if defined $C{$i-1};
 252       }
 253       $C{0} = [$l,$_];
 254     }
 255     if ($opt_e) {
 256       if ($opt_v) {
 257         next if &$egrep;
 258       } else {
 259         unless (&$egrep) {
 260           if ($opt_C and $c) {
 261             print "$l:" if $opt_n;
 262             print;
 263             $L{$l} = $l;
 264             $c--;
 265           }
 266           next;
 267         }
 268       }
 269       $n++;
 270     } else {
 271       if ($opt_v) {
 272         # print ">>>$_" if $opt_i and /$exp/oi or /$exp/o;
 273         if ($opt_Q) {
 274           next if /$exp/m;
 275         } else {
 276           next if /$exp/om;
 277         }
 278         $n++;
 279       } else {
 280         if ($opt_c) {
 281           if ($opt_Q) { $n++ while /$exp/mg }
 282           else        { $n++ while /$exp/omg }
 283         } else {
 284           if ($opt_o) {
 285             if ($exp =~ /\([^?]+\)/) {
 286               if (/$exp/) {
 287                 $n++;
 288                 $_ = "$1\n";
 289               }
 290             } else {
 291               my $m = '';
 292               while (s/($exp)//) {
 293                 $n++;
 294                 $m .= "$1\n";
 295               }
 296               $_ = $m;
 297             }
 298           } elsif ($opt_Q) {
 299             $n += s/($exp)/$B$1$N/mg;
 300           } else {
 301             $n += s/($exp)/$B$1$N/omg;
 302           }
 303         }
 304       }
 305     }
 306     unless ($n) {
 307       if ($opt_C and $c) {
 308         print "$l:" if $opt_n;
 309         print;
 310         $L{$l} = $l;
 311         $c--;
 312       }
 313       next;
 314     }
 315     $found += $n;
 316     # print " " x ($maxlen+9),"\r" if -t STDOUT and $found==1;
 317     next if $opt_c;
 318     last if $opt_l or $opt_L;
 319     if ($file and not $opt_s) {
 320       print "\n$B$file$N:\n";
 321       $file = '';
 322     }
 323     if ($opt_x and $n) {
 324       if ($opt_i) { s/($opt_x)/$B$1$N/ogi }
 325       else        { s/($opt_x)/$B$1$N/og }
 326     }
 327     for (my $i=$opt_C;$i;$i--) {
 328       if (defined $C{$i}) {
 329         my ($ln,$ls) = @{$C{$i}};
 330         unless (defined $L{$ln}) {
 331           $L{$ln} = $ln;
 332           print "$ln:" if $opt_n;
 333           print $ls;
 334         }
 335       }
 336     }
 337     print "$l:" if $opt_n;
 338     print;
 339     $L{$l} = $l;
 340     $c = $opt_C;
 341   }
 342
 343   if ($opt_c) {
 344     print "$file:" if @ARGV>1;
 345     print "$found\n";
 346   } else {
 347     print "$file\n" if $opt_l and $found or $opt_L and not $found;
 348   }
 349   return $found;
 350 }