| Subject: | Code doesn't check for eval'ed q and qq strings |
Hi Thomas,
The module doesn't understand people (like me) who write
eval qq{use Test::Pod};
The attached patch enhances the analysis phase to pull out all variants
of single and double quoted strings evals, simple q/ / and qq+ + style
strings and paired qq< >, q( ) strings.
Were you to apply this patch, I would automatically gain 6 Kwalitee
points! This is not as vain as it sounds: this problem currently affects
File::Path, and I don't want to push out a new version onto CPAN and
also blead for something so trivial, and yet, I wish people to be able
to see that File::Path pays careful attention to Kwalitee (insofar as it
does indeed have POD tests.
If you do apply this patch, I'd be interested to see what other modules
receive improved scores because of it.
The patch also contains tests to exercise the new code. I also made the
analysis more tolerant of whitespace.
Best regards,
David
| Subject: | M-EU.diff |
--- Module-ExtractUse-0.19/lib/Module/ExtractUse.pm Sat Apr 21 16:35:23 2007
+++ Module-ExtractUse-0.19.patched/lib/Module/ExtractUse.pm Thu Nov 1 20:08:35 2007
@@ -46,8 +46,17 @@
$statement=~s/\n+/ /gs;
my $result;
- # check for string eval
- $statement=~s/eval\s["'](.*?)["']/$1;/;
+ # check for string eval in ' ', " " strings
+ if ($statement !~ s/eval\s+(['"])(.*?)\1/$2;/) {
+ # if that didn't work, try q and qq strings
+ if ($statement !~ s/eval\s+qq?(\S)(.*?)\1/$2;/) {
+ # finally try paired delims like qq< >, q( ), ...
+ my %pair = qw| ( ) [ ] { } < > |;
+ while (my ($l, $r) = map {quotemeta} each %pair) {
+ last if $statement =~ s/eval\s+qq?$l(.*?)$r/$1;/;
+ }
+ }
+ }
# now that we've got some code containing 'use' or 'require',
# parse it! (using different entry point to save some more
--- Module-ExtractUse-0.19/t/22_eval.t Sat Apr 21 16:35:23 2007
+++ Module-ExtractUse-0.19.patched/t/22_eval.t Thu Nov 1 19:56:00 2007
@@ -1,4 +1,4 @@
-use Test::More tests => 4;
+use Test::More tests => 9;
use strict;
use warnings;
@@ -21,6 +21,41 @@
ok( $p->used( 'Test::Pod' ) );
}
+{
+ my $qq = "eval qq{use Test::Pod 1.00}";
+ my $p = Module::ExtractUse->new;
+ $p->extract_use( \$qq );
+ ok( $p->used( 'Test::Pod' ), 'qq brace' );
+}
+
+{
+ my $qq = "eval qq+use Test::Pod+";
+ my $p = Module::ExtractUse->new;
+ $p->extract_use( \$qq );
+ ok( $p->used( 'Test::Pod' ), 'qq plus' );
+}
+
+{
+ my $qq = "eval qq(use Test::Pod)";
+ my $p = Module::ExtractUse->new;
+ $p->extract_use( \$qq );
+ ok( $p->used( 'Test::Pod' ), 'qq paren' );
+}
+
+{
+ my $q = "eval q< use Test::Pod>";
+ my $p = Module::ExtractUse->new;
+ $p->extract_use( \$q );
+ ok( $p->used( 'Test::Pod' ), 'q angle' );
+}
+
+{
+ my $q = "eval q/use Test::Pod/";
+ my $p = Module::ExtractUse->new;
+ $p->extract_use( \$q );
+ ok( $p->used( 'Test::Pod' ), 'q slash' );
+}
+
# reported by DAGOLDEN@cpan.org as [rt.cpan.org #19302]
{
my $varversion = q{my $ver=1.22;