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
 #
 # Programname:                 fpg - Frams' Perl grep
 # Author:                      framstag@rus.uni-stuttgart.de

-# Copyright:                   GPL
+# Licence:                     Perl Artistic

 #
 # History:
 #   2003-02-27 Framstag                initial version
 #
 # 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 -~
 #                               -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;
 
 
 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
 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)
         -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
         -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.
 #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;
 
 
 $maxlen = 0;
 


@@ -67,10 +67,15 @@ $opt_S = 4;
 $opt_x = $opt_X = '';
 $opt_R = "\n";
 
 $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) {
 
 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)) {
 }
 
 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;
   } 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;
   }
 
     #? $exp =~ s/\.\*\*/[.\n]*/g;
   }
 


@@ -277,12 +282,19 @@ sub grepf {
           else       { $n++ while /$exp/omg }
         } else {
           if ($opt_o) {
           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 {
           } elsif ($opt_Q) {
             $n += s/($exp)/$B$1$N/mg;
           } else {