Port changes from core

tsee · Dec 19, 2011 · a19caaa · a19caaa
1 parent 7d4923f
commit a19caaa
Show file tree

Hide file tree

Showing 3 changed files with 34 additions and 8 deletions.
diff --git a/lib/Filter/Simple.pm b/lib/Filter/Simple.pm
@@ -4,7 +4,7 @@ use Text::Balanced ':ALL';
 
 use vars qw{ $VERSION @EXPORT };
 
-$VERSION = '0.87';
+$VERSION = '0.88';
 
 use Filter::Util::Call;
 use Carp;
@@ -36,22 +36,31 @@ my $CUT = qr/\n=cut.*$EOP/;
 my $pod_or_DATA = qr/
               ^=(?:head[1-4]|item) .*? $CUT
             | ^=pod .*? $CUT
-            | ^=for .*? $EOP
-            | ^=begin \s* (\S+) .*? \n=end \s* \1 .*? $EOP
+            | ^=for .*? $CUT
+            | ^=begin .*? $CUT
             | ^__(DATA|END)__\r?\n.*
             /smx;
+my $variable = qr{
+        [\$*\@%]\s*
+            \{\s*(?!::)(?:\d+|[][&`'#+*./|,";%=~:?!\@<>()-]|\^[A-Z]?)\}
+      | (?:\$#?|[*\@\%]|\\&)\$*\s*
+               (?:  \{\s*(?:\^(?=[A-Z_]))?(?:\w|::|'\w)*\s*\}
+                  |      (?:\^(?=[A-Z_]))?(?:\w|::|'\w)*
+                  | (?=\{)  # ${ block }
+               )
+        )
+      | \$\s*(?!::)(?:\d+|[][&`'#+*./|,";%=~:?!\@<>()-]|\^[A-Z]?)
+   }x;
 
 my %extractor_for = (
-    quotelike  => [ $ws,  \&extract_variable, $id, { MATCH  => \&extract_quotelike } ],
+    quotelike  => [ $ws,  $variable, $id, { MATCH  => \&extract_quotelike } ],
     regex      => [ $ws,  $pod_or_DATA, $id, $exql           ],
     string     => [ $ws,  $pod_or_DATA, $id, $exql           ],
-    code       => [ $ws, { DONT_MATCH => $pod_or_DATA },
-    		        \&extract_variable,
+    code       => [ $ws, { DONT_MATCH => $pod_or_DATA }, $variable,
                     $id, { DONT_MATCH => \&extract_quotelike }   ],
     code_no_comments
                => [ { DONT_MATCH => $comment },
-                    $ncws, { DONT_MATCH => $pod_or_DATA },
-    		        \&extract_variable,
+                    $ncws, { DONT_MATCH => $pod_or_DATA }, $variable,
                     $id, { DONT_MATCH => \&extract_quotelike }   ],
     executable => [ $ws, { DONT_MATCH => $pod_or_DATA }      ],
     executable_no_comments

diff --git a/t/filter_only.t b/t/filter_only.t
@@ -20,6 +20,20 @@ print "ok 5\n";
 
 ok 7 unless not ok 6;
 
+=begin scrumbly
+
+=end scrumbly
+
+shromple
+
+=cut
+
+=for us
+
+shromple again
+
+=cut
+
 no Filter::Simple::FilterOnlyTest; # THE FUN STOPS HERE
 
 print "not " unless "not ok" =~ /^not /;

diff --git a/t/lib/Filter/Simple/FilterOnlyTest.pm b/t/lib/Filter/Simple/FilterOnlyTest.pm
@@ -8,4 +8,7 @@ FILTER_ONLY
 		while (my($pat, $str) = splice @_, 0, 2) {
 			s/$pat/$str/g;
 		}
+	},
+	code_no_comments => sub {
+		$_ =~ /shromple/ and die "We wants no shromples!";
 	};