diff --git a/t/02_list.t b/t/02_list.t index a0b8206..e4f1d86 100644 --- a/t/02_list.t +++ b/t/02_list.t @@ -29,6 +29,9 @@ my @expectedrequires = ( "$perl_ns(base)\n", "$perl_ns(parent)\n", "$perl_ns(Theta)\n", + "$perl_ns(Omicron)\n", + "$perl_ns(Xi)\n", + "$perl_ns(WithTrailingComma)\n", "$perl_ns(Kappa::Lambda)\n", "$perl_ns(Mu::Nu)\n", "$perl_ns(Try)\n", @@ -38,6 +41,9 @@ my @expectedrequires = ( "$perl_ns(TARGET_CLASS)\n", "$perl_ns(XML::XQL::Element)\n", "$perl_ns(Class::Accessor::Fast)\n", + "$perl_ns(AfterTab)\n", + "$perl_ns(AfterSpace)\n", + "$perl_ns(AfterNLAndTab)\n", ); is_deeply([ sort @requires ], [ sort @expectedrequires ], "Only expected requires were found."); diff --git a/t/data/list b/t/data/list index 3636e38..1e6a6e4 100644 --- a/t/data/list +++ b/t/data/list @@ -4,6 +4,9 @@ use base qw; use parent 'Epsilon'; use parent qw{Theta}; +use base ("Xi", "Omicron"); +use base ("WithTrailingComma",); + # 'Zeta', 'Iota', 'Not::Require*' should not be found use parent -norequire, qw(Zeta Iota); use parent -norequire, 'Not::Require1', 'Not::Require2'; @@ -40,3 +43,8 @@ use base TARGET_CLASS; # Do not ignore line which contains '->' in a coment use base 'XML::XQL::Element'; # L -> L + +use base qw { + AfterTab AfterSpace + AfterNLAndTab +}; diff --git a/template/bin/perl.req b/template/bin/perl.req index 67a4f7a..cb4f193 100755 --- a/template/bin/perl.req +++ b/template/bin/perl.req @@ -219,6 +219,8 @@ sub process_file { $_ = ; } + my $quoted_list = q/\s*(?:['"][^"'\$]*["']\s*,\s*)*\s*['"][^"'\$]*["']\s*,?\s*/; + if ( # ouch could be in a eval, perhaps we do not want these since we catch @@ -244,38 +246,50 @@ sub process_file { (?:$begin_re\s* ([^)\/"'\$!|}]*?) \s*$end_re| + \s*(\($quoted_list\))| (?:qw<|qq?<)([^>]*?)>|([\w\:]+)|)\s*(.*) /x) ) { - my ($whitespace, $statement, $module, $version, $params, $list, $rest) = ($1, $2, $3, $5, $6, $7 || $8 || $9, $10); + my ($whitespace, $statement, $module, $version, $params, $list, $rest) = ($1, $2, $3, $5, $6, $7 || $8 || $9 || $10, $11); $version = undef if ($version eq ''); # Ignore line which contains direct method calls # use base __PACKAGE__->subroutine(...); $list = "" if ($list =~ /^[^;#]*?->/ || $rest =~ /^[^;#]*?->/); + my @list = split ' ', $list; + # # Executed in case that multiline q{} quoted sections is used for # list of modules if (defined($list) && $list =~ /^q[qxwr]?$/) { $list = ""; if ($rest =~ m/^\s*([{([#|!\/])\s*([^})\]#|!\/]*)$/) { + @list = (); $tag = $1; $list = $2; - chomp($list); $tag =~ tr/{\(\[\#|!\//})]#|!\//; $tag = quotemeta($tag); while () { - my $line = $_; - chomp($line); - if ($line =~ m/^\s*(.*?)$tag/) { - $list .= ' ' . $1 if ($1 ne ''); - last; - } else { $list .= ' ' . $line; } + chomp(my $line = $_); + # If line contains tag, remove it and finish iteration. + my $last = $line =~ s/$tag.*$//; + push(@list, split(' ', $line)); + last if $last; } + $list = ""; } } + # Executed in the case of a standard quoted array in the list of modules. + # use base ("Package1", "Package2"); + if (defined($list) && $list =~ /^\(($quoted_list)\)$/) { + $list = ""; + @list = grep { /\S/ } (split /,/, $1); + # Remove ignored spaces and quotes. + s/^\s*['"]|['"]\s*$//g for @list; + } + # we only consider require statements that are flushed against # the left edge. any other require statements give too many # false positives, as they are usually inside of an if statement @@ -362,17 +376,17 @@ sub process_file { # use aliased qw(Foo::Bar) dependencies if ($statement eq "use" && ($module eq "base" || $module eq "aliased")) { add_require($module, $version); - if (defined($list) && $list ne "") { - add_require($_, undef) for split(' ', $list); + if (@list) { + add_require($_, undef) for @list; } next; } # use parent -norequire, 'No::Version'; # $params == "-norequire," - # use parent qw/-norequire XML::XPath::Node/; # $list == "-norequire XML::XPath::Node" + # use parent qw/-norequire XML::XPath::Node/; # @list == qw(-norequire XML::XPath::Node} if ($statement eq "use" && $module eq "parent") { add_require($module, $version); - if (defined($list) && $list ne "" && $list !~ /-norequire/ && $params !~ /-norequire/) { - add_require($_, undef) for split(' ', $list); + if (@list && !grep(/-norequire/, @list) && $params !~ /-norequire/) { + add_require($_, undef) for @list; } next; } @@ -381,8 +395,8 @@ sub process_file { # Mouse or Mouse::Role will be added if ($statement eq "use" && $module eq "Any::Moose") { add_require($module, $version); - if (defined($list) && $list ne "") { - if (grep { !/^Role$/ } split(' ', $list)) { + if (@list) { + if (grep { !/^Role$/ } @list) { add_require('Mouse::Role', undef); } else { add_require('Mouse', undef);