Original release 20160919

[fex.git] / bin / fpg

diff --git a/bin/fpg b/bin/fpg
index 5f2f7511734dce91bb76771ac19448539778be3e..7e616bd6288f330323e9c057dfacd8ea44642e5c 100755 (executable)
--- a/bin/fpg
+++ b/bin/fpg
@@ -2,7 +2,7 @@
 #
 # Programname:                 fpg - Frams' Perl grep
 # Author:                      framstag@rus.uni-stuttgart.de
-# Copyright:                   GPL
+# Licence:                     Perl Artistic
 #
 # History:
 #   2003-02-27 Framstag                initial version
@@ -18,13 +18,16 @@
 #                               -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
@@ -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)) {
@@ -129,7 +134,7 @@ 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;
   }
 
@@ -277,12 +282,19 @@ sub grepf {
           else       { $n++ while /$exp/omg }
         } else {
           if ($opt_o) {
-            my $m = '';
-            while (s/($exp)//) {
-              $n++;
-              $m .= "$1\n";
+            if ($exp =~ /\([^?]+\)/) {
+              if (/$exp/) {
+                $n++;
+                $_ = "$1\n";
+              }
+            } else {
+              my $m = '';
+              while (s/($exp)//) {
+                $n++;
+                $m .= "$1\n";
+              }
+              $_ = $m;
             }
-            $_ = $m;
           } elsif ($opt_Q) {
             $n += s/($exp)/$B$1$N/mg;
           } else {