+#!/usr/bin/perl -w
+#
+# Programname: fpg - Frams' Perl grep
+# Author: framstag@rus.uni-stuttgart.de
+# Copyright: GPL
+#
+# History:
+# 2003-02-27 Framstag initial version
+# 2003-02-28 Framstag added exit status
+# 2007-03-09 Framstag added option -Q
+# 2007-06-01 Framstag added options -s and -c
+# and changed default output mode
+# 2007-06-03 Framstag added ReadLine-support
+# 2007-08-31 Framstag added option -x
+# 2008-02-06 Framstag added implicit gunzip
+# -F ==> -R, new -F option
+# 2008-10-07 Framstag added option -p
+# -n ==> -S, new -n option
+# 2008-10-14 Framstag added option -M
+# 2008-11-23 Framstag added option -~
+
+use Getopt::Std;
+use Term::ReadLine;
+use locale;
+
+sub usage {
+ die <<EOD
+usage: $0 [options] 'EXP' [file...]
+ or: $0 [options] -Q file...
+options: -r recursively scan through directories
+ -i ignore case
+ -v print only lines that do NOT match
+ -s verbose scanning/searching
+ -n prefix with line number
+ -l list filenames only
+ -L list filenames only that do NOT match
+ -p show paragraphs, not lines (multiline record separator)
+ -o show only matched strings, not whole lines
+ -M mail-mode: search and show complete mails from mbox files
+ -c print (count) only number of matches (NOT LINES!)
+ -F EXP is a string, not a Perl regular expression
+ -e EXP is any perl code which returns TRUE/FALSE
+ -S \# minimum string length \# for binary files, default: 4
+ -C \# \# lines of context
+ -R 'RS' record separator, default: newline (\\n) if not set -p
+ -x 'exp' extra regexp for highlighting (not used for searching)
+ -X 'exp' exclude files (filename matching this regexp) when searching
+ -~ search in backup files *~ #*#, too
+ -Q query-loop-prompt for search expression (with readline)
+arguments: EXP is a Perl regular expression
+ file... can be one or more files, even binary or compressed ones
+EOD
+#examples: $0 -r 'from.*STDIN' *
+# $0 -e 'length>30 and not /\\w/' script
+#See "perldoc perlre" for help on regular expressions.
+}
+
+$0 =~ s:.*/::;
+$| = 1;
+
+$maxlen = 0;
+
+$opt_i = $opt_r = $opt_v = $opt_l = $opt_h = $opt_e = $opt_n = $opt_o = 0;
+$opt_s = $opt_c = $opt_Q = $opt_F = $opt_p = $opt_M = $opt_C = $opt_S = 0;
+${'opt_~'} = 0;
+$opt_S = 4;
+$opt_x = $opt_X = '';
+$opt_R = "\n";
+
+usage() if !getopts('hirvlLFMopscQen~S:R:C:x:X:') or $opt_h and not @ARGV;
+
+unless ($opt_Q) {
+ $exp = shift or usage();
+}
+
+if ($opt_C and ($opt_l or $opt_L or $opt_s or $opt_v or $opt_p or $opt_M)) {
+ die "$0: cannot mix option -C with any of -l -L -s -v -p -M\n";
+}
+
+if ($opt_M and ($opt_l or $opt_L or $opt_s or $opt_v or $opt_p or $opt_C)) {
+ die "$0: cannot mix option -M with any of -l -L -s -v -p -C\n";
+}
+
+if ($opt_o and ($opt_v or $opt_l or $opt_L or $opt_c or $opt_F or $opt_C)) {
+ die "$0: cannot mix option -E with any of -l -L -v -c -C -F\n";
+}
+
+$opt_XX = 0;
+if (not ${'opt_~'}) {
+ @bfiles = grep(/~$|^#.*#$/,@ARGV);
+ if (@bfiles and
+ (grep(/[^~]$/,@ARGV) or grep(/(^|\/)#[^\/]*#$/,@ARGV))) {
+ $opt_XX = 1;
+ warn "$0: ignoring @bfiles\n"; # unless $opt_r;
+ }
+}
+
+if (-t STDOUT) {
+ $B = "\033[1m";
+ $N = "\033[m";
+} else {
+ $B = $N = '';
+}
+
+if ($opt_p) { $/ = '' }
+else { $/ = $opt_R }
+#else { eval '$/ = "'.$opt_R.'"' }
+
+$opt_h = 1 if not $opt_r and @ARGV < 2;
+
+if ($opt_Q) {
+ $q = new Term::ReadLine $0;
+ $q->ornaments(0) unless $ENV{PERL_RL};
+ for (;;) {
+ $exp = $q->readline("$B\nsearch-expression:$N ");
+ last unless $exp;
+ &scan;
+ }
+} else {
+ &scan;
+}
+
+exit ($found?0:1);
+
+sub scan {
+ $egrep = '';
+ if ($opt_e) {
+ eval "\$egrep = sub { $exp }";
+ } else {
+ $exp =~ s/([\@\$\%\^\&\*\(\)\+\[\]\{\}\\\|\.\?])/\\$1/g if $opt_F;
+ $exp = '(?i)'.$exp if $opt_i;
+ $exp = '(?s)'.$exp if $opt_p or $opt_R;
+ #? $exp =~ s/\.\*\*/[.\n]*/g;
+ }
+
+ $found = 0;
+
+ if (@ARGV) {
+ foreach $file (@ARGV) {
+ next if $opt_X and $file =~ /$opt_X/;
+ next if $opt_XX and ($file =~ /~$/ or $file =~ m{(^|/)#[^/]*#$});
+ my $error = ''; open $file,$file or $error = $!; close $file;
+ if ($error) {
+ warn "$0: cannot read file $file - $error\n";
+ next;
+ }
+ unless (-f $file or -d $file or -c $file or -S $file or -p $file) {
+ warn "$0: ignoring special file $file\n";
+ next;
+ }
+ $maxlen = length $file if $maxlen < length $file;
+ # printf "%s\r",substr("scanning $file".(" " x 255),0,$maxlen+9) if -t STDOUT;
+ # print $B."scanning $file\n".$N if -t STDOUT and not $opt_l||$opt_L;
+ if ($opt_r and -d $file) {
+ $found += grepd($file);
+ next;
+ }
+ # next if -z $file; # Achtung: special files unter /proc sind "empty" !
+ # $type = `file -L $file`;
+ # if ($type =~ /text/i and open F,$file or open F,"strings $file|") {
+ $fileq = quotemeta $file;
+ if (-T $file) {
+ open $file,$file;
+ # warn "$file\n";
+ } else {
+ if ($file =~ /\.bz2$/) {
+ open $file,"bunzip2 <$fileq|";
+ # warn "gunzip <$file|\n";
+ } elsif ($file =~ /\.gz$/) {
+ open $file,"gunzip <$fileq|";
+ # warn "gunzip <$file|\n";
+ } else {
+ open $file,"strings -a -n $opt_S $fileq|";
+ # warn "strings -n $opt_S $file|\n";
+ }
+ }
+ if (fileno $file) {
+ $found += grepf($file,$file);
+ close $file;
+ } else {
+ warn "$0: cannot open $file - $!\n";
+ next;
+ }
+ }
+ # print " " x ($maxlen+9),"\r" if -t STDOUT;
+ } else {
+ $found = grepf(STDIN);
+ }
+}
+
+sub grepd {
+ my $dir = shift;
+ my $file;
+ my $found = 0;
+
+ opendir $dir,$dir or return;
+ while (defined($file = readdir $dir)) {
+ next if $file eq '.' or $file eq '..';
+ if (not ${'opt_~'} and $file =~ /~$|^#[^\/]*#$/) {
+ # warn "$0: ignoring $dir/$file\n";
+ next;
+ }
+ $file = "$dir/$file";
+ next unless -r $file;
+ if (-d $file and not -l $file) {
+ $found += grepd($file);
+ next;
+ }
+ next unless -f $file or -c $file or -S $file or -p $file or -z $file;
+ $fileq = quotemeta $file;
+ if (-T $file and open $file,$file or
+ open $file,"strings -a -n $opt_S $fileq|") {
+ $found += grepf($file,$file);
+ close $file;
+ }
+ }
+ closedir $dir;
+ return $found;
+}
+
+
+sub grepf {
+ my $F = shift;
+ my $file = shift;
+ my $found = 0;
+ my ($n,$l,$c);
+
+ warn $B."scanning $file".$N."\n" if -t STDOUT and $opt_s;
+
+ while (<$F>) {
+ $_ .= "\n" unless /\n$/;
+ if ($opt_M) {
+ if ($mail and (/^From / or eof $F)) {
+ my $__ = $_;
+ $_ = $mail;
+ $mail = $__;
+ } else {
+ $mail .= $_;
+ next;
+ }
+ }
+ $l++;
+ $n = 0;
+ if ($opt_C) {
+ for (my $i=$opt_C;$i;$i--) {
+ $C{$i} = $C{$i-1} if defined $C{$i-1};
+ }
+ $C{0} = [$l,$_];
+ }
+ if ($opt_e) {
+ if ($opt_v) {
+ next if &$egrep;
+ } else {
+ unless (&$egrep) {
+ if ($opt_C and $c) {
+ print "$l:" if $opt_n;
+ print;
+ $L{$l} = $l;
+ $c--;
+ }
+ next;
+ }
+ }
+ $n++;
+ } else {
+ if ($opt_v) {
+ # print ">>>$_" if $opt_i and /$exp/oi or /$exp/o;
+ if ($opt_Q) {
+ next if /$exp/m;
+ } else {
+ next if /$exp/om;
+ }
+ $n++;
+ } else {
+ if ($opt_c) {
+ if ($opt_Q) { $n++ while /$exp/mg }
+ else { $n++ while /$exp/omg }
+ } else {
+ if ($opt_o) {
+ my $m = '';
+ while (s/($exp)//) {
+ $n++;
+ $m .= "$1\n";
+ }
+ $_ = $m;
+ } elsif ($opt_Q) {
+ $n += s/($exp)/$B$1$N/mg;
+ } else {
+ $n += s/($exp)/$B$1$N/omg;
+ }
+ }
+ }
+ }
+ unless ($n) {
+ if ($opt_C and $c) {
+ print "$l:" if $opt_n;
+ print;
+ $L{$l} = $l;
+ $c--;
+ }
+ next;
+ }
+ $found += $n;
+ # print " " x ($maxlen+9),"\r" if -t STDOUT and $found==1;
+ next if $opt_c;
+ last if $opt_l or $opt_L;
+ if ($file and not $opt_s) {
+ print "\n$B$file$N:\n";
+ $file = '';
+ }
+ if ($opt_x and $n) {
+ if ($opt_i) { s/($opt_x)/$B$1$N/ogi }
+ else { s/($opt_x)/$B$1$N/og }
+ }
+ for (my $i=$opt_C;$i;$i--) {
+ if (defined $C{$i}) {
+ my ($ln,$ls) = @{$C{$i}};
+ unless (defined $L{$ln}) {
+ $L{$ln} = $ln;
+ print "$ln:" if $opt_n;
+ print $ls;
+ }
+ }
+ }
+ print "$l:" if $opt_n;
+ print;
+ $L{$l} = $l;
+ $c = $opt_C;
+ }
+
+ if ($opt_c) {
+ print "$file:" if @ARGV>1;
+ print "$found\n";
+ } else {
+ print "$file\n" if $opt_l and $found or $opt_L and not $found;
+ }
+ return $found;
+}
projects / fex.git / commitdiff