Detect POD sections like perl would
Vincent Pit [Mon, 30 Jul 2012 19:26:03 +0000 (21:26 +0200)]
perl considers that a POD section begins with a line that starts by "=X",
X being any alphabetic character, and ends by "=cut" followed by a
non-alphabetic character. This commit makes Module::Metadata follow this
strategy.

Note that there's still a gotcha : "=X" must be a statement to start a POD
section. This means that in

    my $x
    =pod
    ;

'pod' is treated as a bareword, hence is compiled to either a string
literal or a function call depending on whether a pod() sub has been
previously declared in the current package. Module::Metadata cannot do
anything about this situation.

This commit partially reverts the previous commit a4aafbc2.

lib/Module/Metadata.pm
t/metadata.t

index e5910d0..0d73988 100644 (file)
@@ -61,10 +61,6 @@ my $VERS_REGEXP = qr{ # match a VERSION definition
   =[^=~]  # = but not ==, nor =~
 }x;
 
-my $PODSECT_REGEXP = qr{
- ^=(cut|pod|head[1-4]|over|item|back|begin|end|for|encoding)\b
-}x;
-
 sub new_from_file {
   my $class    = shift;
   my $filename = File::Spec->rel2abs( shift );
@@ -500,9 +496,14 @@ sub _parse_fh {
 
     chomp( $line );
 
+    # From toke.c : any line that begins by "=X", where X is an alphabetic
+    # character, introduces a POD segment.
     my $is_cut;
-    if ( $line =~ /$PODSECT_REGEXP/o ) {
-      $is_cut = $1 eq 'cut';
+    if ( $line =~ /^=([a-zA-Z].*)/ ) {
+      my $cmd = $1;
+      # Then it goes back to Perl code for "=cutX" where X is a non-alphabetic
+      # character (which includes the newline, but here we chomped it away).
+      $is_cut = $cmd =~ /^cut(?:[^a-zA-Z]|$)/;
       $in_pod = !$is_cut;
     }
 
index a0bcaaa..b7adb1e 100644 (file)
@@ -502,19 +502,21 @@ EXPECTED
   # test things that look like POD, but aren't
 $dist->change_file( 'lib/Simple.pm', <<'---' );
 package Simple;
-sub podzol () { 1 }
-sub cute () { 2 }
-my $x
-=podzol
-;
 
-our $VERSION = '1.23';
+=YES THIS STARTS POD
+
+our $VERSION = '999';
 
-my $y
 =cute
-;
 
-our $VERSION = '999';
+our $VERSION = '666';
+
+=cut
+
+*foo
+=*no_this_does_not_start_pod;
+
+our $VERSION = '1.23';
 
 ---
   $dist->regen;