Version 1.03

Changes

@@ -1,4 +1,7 @@
 Revision history for perl-generators.
+1.03  Mon Feb  2 2015
+- Updated parcing of here-doc and quoted section which should be skipped
+- Update tests suite
 
 1.02  Fri Dec 12 2014
 - Fix BZ#1172716 - update regex to properly match the module name

MANIFEST

@@ -11,9 +11,13 @@ t/03_anymoose.t
 t/04_provides.t
 t/05_whitespace.t
 t/06_variables.t
+t/07_multiline.t
+t/08_heredoc.t
 t/data/anymoose
 t/data/basic
+t/data/heredoc
 t/data/list
+t/data/multiline
 t/data/provides
 t/data/todo
 t/data/variables

Makefile.PL

@@ -5,7 +5,7 @@ use ExtUtils::MakeMaker;
 
 WriteMakefile(
     'NAME' => 'generators',
-    'VERSION' => '1.02',
+    'VERSION' => '1.03',
     'AUTHOR' => 'Jitka Plesnikova <[email protected]>',
     'LICENSE' => 'gpl',
     'EXE_FILES' => [ ( glob 'bin/*' ) ],

bin/perl.prov

@@ -72,31 +72,46 @@ sub process_file {
 
   while (<FILE>) {
 
+    # skip the here-docs "<<" blocks
+    # assume that <<12 means bitwise operation
+    if (((m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?([^"'#<@])<<(\w+)\s*/ &&
+          ($2 !~ m/^\d+$/)) ||
+         m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<\s*(["'`])(.+?|)\1\s*/
+        ) &&
+         ! m/q[qxwr]?\s*[{([#|!\/][^})\]#|!\/]*?<<[^<]/
+       ) {
+      $tag = $2;
+      while (<FILE>) {
+        chomp;
+        ( $_ eq $tag ) && last;
+      }
+      $_ = <FILE>;
+    }
+
+    # skip q{} quoted sections - just hope we don't have curly brackets
+    # within the quote, nor an escaped hash mark that isn't a comment
+    # marker, such as occurs right here. Draw the line somewhere.
+    if ( m/^.*\Wq[qxwr]?\s*([{([#|!\/])[^})\]#|!\/]*$/ && ! m/^\s*(package)\s/ ) {
+      $tag = $1;
+      $tag =~ tr/{\(\[\#|!\//})]#|!\//;
+      $tag = quotemeta($tag);
+      while (<FILE>) {
+        ( $_ =~ m/$tag/ ) && last;
+      }
+    }
+
     # skip the documentation
 
     # we should not need to have item in this if statement (it
     # properly belongs in the over/back section) but people do not
     # read the perldoc.
 
-    if (m/^=(head[1-4]|pod|for|item)/) {
-      $incomment = 1;
-    }
-
-    if (m/^=(cut)/) {
-      $incomment = 0;
-      $inover = 0;
-    }
-
-    if (m/^=(over)/) {
-      $inover = 1;
-    }
-
-    if (m/^=(back)/) {
-      $inover = 0;
+    if (/^=(head[1-4]|pod|for|item)/) {
+      /^=cut/ && next while <FILE>;
     }
 
-    if ($incomment || $inover) {
-      next;
+    if (/^=over/) {
+      /^=back/ && next while <FILE>;
     }
 
     # skip the data section

bin/perl.req

@@ -83,11 +83,16 @@ sub process_file {
 
   while (<FILE>) {
 
-    # skip the "= <<" block
-
-    if (m/^\s*\$(?:.*)\s*=\s*<<\s*(["'`])(.+?)\1/ ||
-        m/^\s*\$(.*)\s*=\s*<<(\w+)\s*;/) {
+    # skip the here-docs "<<" blocks
+    # assume that <<12 means bitwise operation
+    if (((m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?([^"'#<@])<<(\w+)\s*/ &&
+          ($2 !~ m/^\d+$/)) ||
+         m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<\s*(["'`])(.+?|)\1\s*/
+        ) &&
+         ! m/q[qxwr]?\s*[{([#|!\/][^})\]#|!\/]*?<<[^<]/
+       ) {
       $tag = $2;
+      if ($_ =~ m/^\s*use\s(constant)\s/) { add_require($1, undef) }
       while (<FILE>) {
         chomp;
         ( $_ eq $tag ) && last;
@@ -98,9 +103,9 @@ sub process_file {
     # skip q{} quoted sections - just hope we don't have curly brackets
     # within the quote, nor an escaped hash mark that isn't a comment
     # marker, such as occurs right here. Draw the line somewhere.
-    if ( m/^.*\Wq[qxwr]?\s*([{([#|\/])[^})\]#|\/]*$/ && ! m/^\s*(require|use)\s/ ) {
+    if ( m/^.*\Wq[qxwr]?\s*([{([#|!\/])[^})\]#|!\/]*$/ && ! m/^\s*(require|use)\s/ ) {
       $tag = $1;
-      $tag =~ tr/{\(\[\#|\//})]#|\//;
+      $tag =~ tr/{\(\[\#|!\//})]#|!\//;
       $tag = quotemeta($tag);
       while (<FILE>) {
         ( $_ =~ m/$tag/ ) && last;
@@ -154,20 +159,20 @@ sub process_file {
         (m/^(\s*)         # we hope the inclusion starts the line
          (require|use)\s+(?!\{)     # do not want 'do {' loops
          # quotes around name are always legal
-         $begin_re?\s*
-         ([\w:\.\/]+?)
-         \s*$end_re?[^\w]*?[\t; \n]
+         (?:$begin_re?\s*([\w:\/\.]+?)\s*$end_re?|
+            ([\w:\.]+?))[^\w]*?
+         [\t; \n]
          # the syntax for 'use' allows version requirements
          \s*($modver_re)?\s*
          # catch parameter like '-norequire,'
          (-[\w,]+)?\s*
          # the latter part is for "use base qw(Foo)" and friends special case
          (?:$begin_re\s*
          ([^)\/"'\$!|}]*?)
-         \s*$end_re|['"][^'"]+['"]|)\s*
+         \s*$end_re|)\s*
          /x)
        ) {
-      my ($whitespace, $statement, $module, $version, $params, $list) = ($1, $2, $3, $4, $5, $6);
+      my ($whitespace, $statement, $module, $version, $params, $list) = ($1, $2, $3, $5, $6, $7);
       $version = undef if ($version eq '');
 
       # we only consider require statements that are flushed against

t/01_basic.t

@@ -24,7 +24,6 @@ my @expectedrequires = (
     "perl(Epsilon)\n",
     "perl(Eta)\n",
     "perl(ExtUtils::MM_Unix)\n",
-    "perl(ExtUtils::MakeMaker)\n",
     "perl(Gamma)\n",
     "perl(Iota)\n",
     "perl(Kappa)\n",

t/02_list.t

@@ -23,7 +23,6 @@ my @expectedrequires = (
     "perl(aliased)\n",
     "perl(base)\n",
     "perl(parent)\n",
-    "perl(overload)\n",
 );
 
 is_deeply([ sort @requires ], [ sort @expectedrequires ], "Only expected requires were found.");

t/07_multiline.t

@@ -0,0 +1,20 @@
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+my $file     = "t/data/multiline";
+my @requires = qx(bin/perl.req $file);
+my @provides = qx(bin/perl.prov $file);
+
+#
+# Provides
+is(scalar(@provides), 0, 'No package is provided');
+
+#
+# Requires
+my @expectedrequires = (
+    "perl(At::The::End)\n",
+    "perl(overload)\n",
+);
+
+is_deeply([ sort @requires ], [ sort @expectedrequires ], "Only expected requires were found.");

t/08_heredoc.t

@@ -0,0 +1,29 @@
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+my $file     = "t/data/heredoc";
+my @requires = qx(bin/perl.req $file);
+my @provides = qx(bin/perl.prov $file);
+
+#
+# Provides
+my @expectedprovides = (
+    "perl(More::Then::Two::Mark)\n",
+    "perl(Not::In::Heredoc)\n",
+    "perl(THAT)\n",
+);
+
+is_deeply([ sort @provides ], [ sort @expectedprovides ], "Only expected provides were found.");
+
+#
+# Requires
+my @expectedrequires = (
+    "perl(Bitwise::Operator)\n",
+    "perl(constant)\n",
+    "perl(More::Then::Two::Mark)\n",
+    "perl(Not::In::Heredoc)\n",
+    "perl(THAT)\n",
+);
+
+is_deeply([ sort @requires ], [ sort @expectedrequires ], "Only expected requires were found.");

t/data/basic

@@ -20,9 +20,6 @@ use 5.010;
 # 'use' does not accept module name with .pm
 use 'Ignore.pm';
 
-# Dist-Zilla-5.027/lib/Dist/Zilla/Plugin/MakeMaker.pm
-use ExtUtils::MakeMaker{{ defined $eumm_version && 0+$eumm_version ? ' ' . $eumm_version : '' }};
-
 require Eta;
 require 'Theta.pm';
 require "Iota.pm";

t/data/heredoc

@@ -0,0 +1,147 @@
+#
+# 'authentication' should not be found, because it is part of "= <<" block
+twitter_api_method suggestion_categories => (
+    path        => 'users/suggestions',
+    method      => 'GET',
+    params      => [],
+    required    => [],
+    returns     => 'ArrayRef',
+    description => <<''
+Returns the list of suggested user categories. The category slug can be used in
+the C<user_suggestions> API method get the users in that category .  Does not
+require authentication
+package authentication;
+
+);
+
+%hash = (
+    "text" => << 'EOT'
+use and require is a horrible stuff
+package EOT
+EOT
+);
+
+$template = <<EXIT;
+package To::Test;
+use to test
+require should be tested too;
+EXIT
+
+$test = <<''
+package in::test;
+require test should not be found in a text;
+
+
+my $test = <<'@'
+package temp;
+require temp also should not be found in a text
+@
+;
+
+#
+# Dist-Zilla-5.027/lib/Dist/Zilla/Plugin/MakeMaker.pm
+# None of requirement befor last '!' should not be reported
+my $template = q!
+package Template;
+use strict;
+use warnings;
+
+use ExtUtils::MakeMaker{{ defined $eumm_version && 0+$eumm_version ? ' ' . $eumm_version : '' }};
+
+!;
+
+sub note_template {
+  my ($self, $log, $text) = @_;
+  my $diff = _prepend_comment( $self->get_diff($log) );
+  return << "HERE";
+package Use::Template;
+use Template;
+HERE
+}
+
+$pod .= << 'HERE';
+package Simply::Pod;
+use Simply::Pod;
+HERE
+
+push @LIB, <<EOF;
+use push
+EOF
+
+#--------------------------------------------------------------------------
+$ComTab{'c'}=[ 2, 'txt', \&Change,     <<'-X-'                           ]; #ok
+package Comments;
+use Comments;
+{ print <<'TheEnd'; } $doPrint = 0; goto EOS;
+-X-
+
+ok(153, docat_del($file) eq <<'EOM') ;
+use In::Function;
+EOM
+
+my $template = $self->note_template( $log, << "HERE" );
+perldelta: $section [pending]
+use 
+HERE
+
+write_file( File::Spec->catfile( $fulldir, 'bazmarkhian.al' ), <<'EOT' );
+package Foo;
+use Foo;
+1;
+EOT
+
+is (eval <<'END', 1, 'lexical topic compiles') or diag $@;
+  package Experimental
+  ;
+  use experimental 'lexical_topic';
+  my $_ = 1;
+  is($_, 1, '$_ is 1');
+END
+
+
+# Multiple here-docs does not properly. The skipping finish on the first tag
+myfunc(<< "THIS", 23, <<'THAT');
+package THIS;
+use THIS;
+THIS
+package THAT;
+use THAT;
+THAT
+
+print <<< 'test';
+package More::Then::Two::Mark;
+use More::Then::Two::Mark;
+
+print 20 << 20;
+print 20<<20;
+use Bitwise::Operator;
+
+use constant COPYRIGHT_SHORT => <<EOF;
+Test::Unit Version $Test::Unit::VERSION
+(c) 2000-2002, 2005 Christian Lemburg, Brian Ewins, et. al.
+use Heredoc::in::Use;
+EOF
+
+# Should not break test
+if (defined $::RD_TRACE) {
+    Parse::RecDescent::_trace(q{<<'.Parse::RecDescent::_matchtracemessage($self,1).' rule>>},
+    Parse::RecDescent::_tracefirst($_[1]),
+    q{' . $self->{"name"} .'},
+    $tracelevel)
+}
+
+$trase = q!<<TEST help
+   package In::Quoted::Section;
+   use In::Quoted::Section;
+!;
+
+print <<'1234';
+packageNumber::As::Tag;
+use Number::As::Tag;
+1234
+
+# This case should be the last and should be found each time.
+print "<<TEST";
+push @OUT, "return <<'END';\n";
+package Not::In::Heredoc;
+use Not::In::Heredoc;

t/data/list

@@ -11,6 +11,3 @@ use aliased "Some::Crazy::Module";
 # 'ShorterName' should not be found
 use aliased "Another::Crazy::Module" => "ShorterName";
 
-use overload
-    '+' => \&myadd,
-    '-' => \&mysub;

t/data/multiline

@@ -0,0 +1,6 @@
+# Only a module 'overload' should be reported from the file
+use overload
+    '+' => \&myadd,
+    '-' => \&mysub;
+
+use At::The::End