Original release 20160919

[fex.git] / bin / fpg

diff --git a/bin/fpg b/bin/fpg
index be610fe3bf8062ed86a76773be00f0ea88da9835..7e616bd6288f330323e9c057dfacd8ea44642e5c 100755 (executable)
--- a/bin/fpg
+++ b/bin/fpg
@@ -2,13 +2,13 @@
 #
 # Programname:                 fpg - Frams' Perl grep
 # Author:                      framstag@rus.uni-stuttgart.de
-# Copyright:                   GPL
+# Licence:                     Perl Artistic
 #
 # 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 
+#   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
@@ -18,16 +18,19 @@
 #                               -n ==> -S, new -n option
 #   2008-10-14 Framstag                added option -M
 #   2008-11-23 Framstag                added option -~
+#   2016-06-12 Framstag                option -o respects (match)
 
 use Getopt::Std;
 use Term::ReadLine;
 use locale;
 
-sub usage {
-  die <<EOD
+$0 =~ s:.*/::;
+$| = 1;
+
+$usage  = <<EOD;
 usage: $0 [options] 'EXP' [file...]
    or: $0 [options] -Q file...
-options: -r        recursively scan through directories   
+options: -r        recursively scan through directories
          -i        ignore case
         -v        print only lines that do NOT match
         -s        verbose scanning/searching
@@ -35,7 +38,7 @@ options: -r        recursively scan through directories
         -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
+        -o        show only matched strings (in parenthesis), 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
@@ -53,10 +56,7 @@ 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;
 
@@ -67,10 +67,15 @@ $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;
+getopts('hirvlLFMopscQen~S:R:C:x:X:') or die $usage;
+
+if ($opt_h) {
+  print $usage;
+  exit;
+}
 
 unless ($opt_Q) {
-  $exp = shift or usage();
+  $exp = shift or die $usage;
 }
 
 if ($opt_C and ($opt_l or $opt_L or $opt_s or $opt_v or $opt_p or $opt_M)) {
@@ -88,7 +93,7 @@ if ($opt_o and ($opt_v or $opt_l or $opt_L or $opt_c or $opt_F or $opt_C)) {
 $opt_XX = 0;
 if (not ${'opt_~'}) {
   @bfiles = grep(/~$|^#.*#$/,@ARGV);
-  if (@bfiles and 
+  if (@bfiles and
       (grep(/[^~]$/,@ARGV) or grep(/(^|\/)#[^\/]*#$/,@ARGV))) {
     $opt_XX = 1;
     warn "$0: ignoring @bfiles\n"; # unless $opt_r;
@@ -105,7 +110,7 @@ if (-t STDOUT) {
 if ($opt_p) { $/ = '' }
 else        { $/ = $opt_R }
 #else        { eval '$/ = "'.$opt_R.'"' }
-  
+
 $opt_h = 1 if not $opt_r and @ARGV < 2;
 
 if ($opt_Q) {
@@ -129,12 +134,12 @@ sub scan {
   } 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)'.$exp if $opt_p or $opt_R ne "\n";
     #? $exp =~ s/\.\*\*/[.\n]*/g;
   }
-  
+
   $found = 0;
-  
+
   if (@ARGV) {
     foreach $file (@ARGV) {
       next if $opt_X  and $file =~ /$opt_X/;
@@ -192,7 +197,7 @@ 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 '..';
@@ -208,7 +213,7 @@ sub grepd {
     }
     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 
+    if (-T $file and open $file,$file or
         open $file,"strings -a -n $opt_S $fileq|") {
       $found += grepf($file,$file);
       close $file;
@@ -224,9 +229,9 @@ sub grepf {
   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) {
@@ -248,9 +253,9 @@ sub grepf {
       $C{0} = [$l,$_];
     }
     if ($opt_e) {
-      if ($opt_v) { 
+      if ($opt_v) {
         next if &$egrep;
-      } else { 
+      } else {
         unless (&$egrep) {
           if ($opt_C and $c) {
             print "$l:" if $opt_n;
@@ -276,16 +281,23 @@ sub grepf {
           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";
+          if ($opt_o) {
+            if ($exp =~ /\([^?]+\)/) {
+              if (/$exp/) {
+                $n++;
+                $_ = "$1\n";
+              }
+            } else {
+              my $m = '';
+              while (s/($exp)//) {
+                $n++;
+                $m .= "$1\n";
+              }
+              $_ = $m;
             }
-            $_ = $m;
-          } elsif ($opt_Q) { 
+          } elsif ($opt_Q) {
             $n += s/($exp)/$B$1$N/mg;
-          } else { 
+          } else {
             $n += s/($exp)/$B$1$N/omg;
           }
         }
@@ -309,7 +321,7 @@ sub grepf {
       $file = '';
     }
     if ($opt_x and $n) {
-      if ($opt_i) { s/($opt_x)/$B$1$N/ogi } 
+      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--) {
@@ -327,7 +339,7 @@ sub grepf {
     $L{$l} = $l;
     $c = $opt_C;
   }
-  
+
   if ($opt_c) {
     print "$file:" if @ARGV>1;
     print "$found\n";