]> git.treefish.org Git - fex.git/blob - bin/fpg
Original release 20160328
[fex.git] / 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 }