bin/fpg

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