Skip Menu |

Preferred bug tracker

Please visit the preferred bug tracker to report your issue.

This queue is for tickets about the Perl-PrereqScanner CPAN distribution.

Report information
The Basics
Id: 59016
Status: resolved
Priority: 0/
Queue: Perl-PrereqScanner

People
Owner: jquelin [...] cpan.org
Requestors: APOCAL [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



Subject: [FEATURE PATCH] Add support for Moose v1.03 -version declarations
Hello, When I was fooling around with dzil, I brought up that it was counter-intuitive to repeat the module twice just so the prereq scanner could pick up the version. use "Foo::Baz" 2.5; with 'Foo::Baz'; Rafl++ noticed this and immediately made a Moose 1.03 release that added support for declaring versions in the with/extends methods. with 'Foo::Baz' => { -version => 2.5 }; This patch adds support for that, and a bunch of tests :) This was my "first" time trying to do something moderately complicated in PPI, ha! Hope others will find this useful, and thanks again for your excellent work on this! -- ~Apocalypse
Subject: prereqscanner.patch
diff --git a/lib/Perl/PrereqScanner/Scanner.pm b/lib/Perl/PrereqScanner/Scanner.pm index 31240ea..11c7973 100644 --- a/lib/Perl/PrereqScanner/Scanner.pm +++ b/lib/Perl/PrereqScanner/Scanner.pm @@ -24,9 +24,12 @@ requires 'scan_for_prereqs'; # -- rjbs, 2010-04-06 sub _q_contents { my ($self, $token) = @_; - my @contents = $token->isa('PPI::Token::QuoteLike::Words') - ? ( $token->literal ) - : ( $token->string ); + my @contents; + if ( $token->isa('PPI::Token::QuoteLike::Words') || $token->isa('PPI::Token::Number') ) { + @contents = $token->literal; + } else { + @contents = $token->string; + } return @contents; } diff --git a/lib/Perl/PrereqScanner/Scanner/Moose.pm b/lib/Perl/PrereqScanner/Scanner/Moose.pm index 01ce2ef..016d938 100644 --- a/lib/Perl/PrereqScanner/Scanner/Moose.pm +++ b/lib/Perl/PrereqScanner/Scanner/Moose.pm @@ -21,15 +21,72 @@ sub scan_for_prereqs { my ($self, $ppi_doc, $req) = @_; # Moose-based roles / inheritance - my @bases = - map { $self->_q_contents( $_ ) } - grep { $_->isa('PPI::Token::Quote') || $_->isa('PPI::Token::QuoteLike') } - map { $_->children } + my @chunks = + map { [ $_->children ] } grep { $_->child(0)->literal =~ m{\Awith|extends\z} } grep { $_->child(0)->isa('PPI::Token::Word') } @{ $ppi_doc->find('PPI::Statement') || [] }; - $req->add_minimum($_ => 0) for @bases; + foreach my $hunk ( @chunks ) { + # roles/inheritance *WITH* version declaration ( added in Moose 1.03 ) + if ( grep { $_->isa('PPI::Structure::Constructor') } @$hunk ) { + # possibly contains a version declaration! + my( $pkg, $done ); + foreach my $elem ( @$hunk ) { + # Scan for the first quote-like word, which is the package name + if ( $elem->isa('PPI::Token::Quote') || $elem->isa('PPI::Token::QuoteLike') ) { + $pkg = ( $self->_q_contents( $elem ) )[0]; + undef $done; + next; + } + + # skip over the fluff and look for the version block + if ( $pkg and $elem->isa('PPI::Structure::Constructor') ) { + foreach my $subelem ( $elem->children ) { + # skip over the fluff and look for the real version code + if ( $subelem->isa('PPI::Statement') ) { + my $found_ver; + foreach my $code ( $subelem->children ) { + # skip over the fluff until we're sure we saw the version declaration + if ( $code->isa('PPI::Token::Word') and $code->literal eq '-version' ) { + $found_ver++; + next; + } + + if ( $found_ver and ( $code->isa('PPI::Token::Quote') || $code->isa('PPI::Token::QuoteLike') || $code->isa('PPI::Token::Number') ) ) { + $req->add_minimum( $pkg => ( $self->_q_contents( $code ) )[0] ); + $done++; + last; + } + } + + # Did we fail to find the ver? + if ( $found_ver and ! $done ) { + die "Possible internal error!"; + } + } + } + + # Failed to find version-specific stuff + if ( ! $done ) { + $req->add_minimum( $pkg => 0 ); + next; + } + } + } + + # If we found a pkg but no done, this must be the "last" pkg to be declared and it has no version + if ( $pkg and ! $done ) { + $req->add_minimum( $pkg => 0 ); + } + } else { + # regular parse + $req->add_minimum( $_ => 0 ) for + map { $self->_q_contents( $_ ) } + grep { $_->isa('PPI::Token::Quote') || $_->isa('PPI::Token::QuoteLike') } + @$hunk; + } + } } 1; diff --git a/t/autoprereq.t b/t/autoprereq.t index 957738e..acf5eaa 100644 --- a/t/autoprereq.t +++ b/t/autoprereq.t @@ -46,10 +46,29 @@ sub prereq_is { }; } -prereq_is('', { }, '(empty string)'); -prereq_is('use Use::NoVersion;', { 'Use::NoVersion' => 0 }); -prereq_is('use Use::Version 0.50;', { 'Use::Version' => '0.50' }); -prereq_is('require Require;', { Require => 0 }); +# basic sanity tests +prereq_is('', {}, '(empty string)'); + +prereq_is( + 'use Use::NoVersion;', + { + 'Use::NoVersion' => 0, + }, +); + +prereq_is( + 'use Use::Version 0.50;', + { + 'Use::Version' => '0.50', + }, +); + +prereq_is( + 'require Require;', + { + Require => 0, + }, +); prereq_is( 'use Use::Version 0.50; use Use::Version 1.00;', @@ -67,12 +86,34 @@ prereq_is( prereq_is( 'use Import::IgnoreAPI require => 1;', - { 'Import::IgnoreAPI' => 0 }, + { + 'Import::IgnoreAPI' => 0, + }, ); - # Moose features -prereq_is("with 'With::Single';", { 'With::Single' => 0 }); +prereq_is( + 'extends "Foo::Bar";', + { + 'Foo::Bar' => 0, + }, +); + +prereq_is( + 'extends "Foo::Bar"; extends "Foo::Baz";', + { + 'Foo::Bar' => 0, + 'Foo::Baz' => 0, + }, +); + +prereq_is( + "with 'With::Single';", + { + 'With::Single' => 0, + }, +); + prereq_is( "extends 'Extends::List1', 'Extends::List2';", { @@ -113,7 +154,13 @@ prereq_is( }, ); -prereq_is('use base "Base::QQ1";', { 'Base::QQ1' => 0 }); +prereq_is( + 'use base "Base::QQ1";', + { + 'Base::QQ1' => 0, + }, +); + prereq_is( 'use base 10 "Base::QQ1";', { @@ -121,9 +168,13 @@ prereq_is( base => 10, }, ); + prereq_is( 'use base qw{ Base::QW1 Base::QW2 };', - { 'Base::QW1' => 0, 'Base::QW2' => 0 }, + { + 'Base::QW1' => 0, + 'Base::QW2' => 0, + }, ); prereq_is( @@ -190,4 +241,67 @@ prereq_is( q{use strict; use warnings; use lib '.'; use feature ':5.10';}, {}, ); + +# test cases for Moose 1.03 -version extension +prereq_is( + 'extends "Foo::Bar"=>{-version=>"1.1"};', + { + 'Foo::Bar' => '1.1', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => \'1.1\' };', + { + 'Foo::Bar' => '1.1', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => 13.3 };', + { + 'Foo::Bar' => '13.3', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => \'1.1\' }; extends "Foo::Baz" => { -version => 5 };', + { + 'Foo::Bar' => '1.1', + 'Foo::Baz' => 5, + }, +); + +prereq_is( + 'extends "Foo::Bar"=>{-version=>1},"Foo::Baz"=>{-version=>2};', + { + 'Foo::Bar' => 1, + 'Foo::Baz' => 2, + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => "4.3.2" }, "Foo::Baz" => { -version => 2.44894 };', + { + 'Foo::Bar' => '4.3.2', + 'Foo::Baz' => 2.44894, + }, +); + +prereq_is( + 'with "With::Single" => { -excludes => "method", -version => "1.1.1" }, "With::Double";', + { + 'With::Single' => '1.1.1', + 'With::Double' => 0, + }, +); + +prereq_is( + 'with "With::Single" => { -wow => { -wow => { a => b } }, -version => "1.1.1" }, "With::Double";', + { + 'With::Single' => '1.1.1', + 'With::Double' => 0, + }, +); + done_testing;
Hah, here's one testcase I missed, doy++ Sorry for the crap format, I was too lazy to redo the patch :( prereq_is( 'with "With::Single" => { -exclude => "method", -version => "1.1.1" }, "With::Double" => { -exclude => "foo" };', { 'With::Single' => '1.1.1', 'With::Double' => 0, }, ); -- ~Apocalypse
On Thu Jul 01 00:51:09 2010, APOCAL wrote: Show quoted text
> This patch adds support for that, and a bunch of tests :) This was my > "first" time trying to do something moderately complicated in PPI, ha!
thanks for the patch. however, a lot of lines appear in your patch because you seem to have run perltidy on it (cf t/autoprereq.t). ==> would it be possible to get your patch without this, in order to keep it focused to the point? thanks.
Subject: Re: [rt.cpan.org #59016] [FEATURE PATCH] Add support for Moose v1.03 -version declarations
Date: Sat, 04 Dec 2010 14:09:36 -0700
To: bug-Perl-PrereqScanner [...] rt.cpan.org
From: "perl [...] 0ne.us" <perl [...] 0ne.us>
Hello, I was away on a loooong vacation, ha! Sorry for the perlcritic stuff, actually it was my editor, ha! The testfile had several "styles" in it and the editor normalized them... Here's the updated patch which just adds the support and it's against the latest - 0.101891 on CPAN/git commit 227eff4b8d019ac500c24e072fc07754b40d24e2 Please let me know if I need to change anything, thanks again! Jerome Quelin via RT wrote: Show quoted text
> <URL: https://rt.cpan.org/Ticket/Display.html?id=59016 > > > On Thu Jul 01 00:51:09 2010, APOCAL wrote: >
>> This patch adds support for that, and a bunch of tests :) This was my >> "first" time trying to do something moderately complicated in PPI, ha! >>
> > thanks for the patch. however, a lot of lines appear in your patch > because you seem to have run perltidy on it (cf t/autoprereq.t). > > ==> would it be possible to get your patch without this, in order to > keep it focused to the point? > > thanks. >
diff --git a/lib/Perl/PrereqScanner/Scanner.pm b/lib/Perl/PrereqScanner/Scanner.pm index 31240ea..11c7973 100644 --- a/lib/Perl/PrereqScanner/Scanner.pm +++ b/lib/Perl/PrereqScanner/Scanner.pm @@ -24,9 +24,12 @@ requires 'scan_for_prereqs'; # -- rjbs, 2010-04-06 sub _q_contents { my ($self, $token) = @_; - my @contents = $token->isa('PPI::Token::QuoteLike::Words') - ? ( $token->literal ) - : ( $token->string ); + my @contents; + if ( $token->isa('PPI::Token::QuoteLike::Words') || $token->isa('PPI::Token::Number') ) { + @contents = $token->literal; + } else { + @contents = $token->string; + } return @contents; } diff --git a/lib/Perl/PrereqScanner/Scanner/Moose.pm b/lib/Perl/PrereqScanner/Scanner/Moose.pm index 140311d..e22f46d 100644 --- a/lib/Perl/PrereqScanner/Scanner/Moose.pm +++ b/lib/Perl/PrereqScanner/Scanner/Moose.pm @@ -21,11 +21,7 @@ sub scan_for_prereqs { my ($self, $ppi_doc, $req) = @_; # Moose-based roles / inheritance - my @bases = - grep { Params::Util::_CLASS($_) } - map { $self->_q_contents( $_ ) } - grep { $_->isa('PPI::Token::Quote') || $_->isa('PPI::Token::QuoteLike') } - + my @chunks = # This is what we get when someone does: with('Foo'); # The target to get at is the PPI::Token::Quote::Single. # -- rjbs, 2010-09-05 @@ -37,12 +33,72 @@ sub scan_for_prereqs { # PPI::Token::Quote::Single # PPI::Token::Structure - map { $_->children } + map { [ $_->children ] } grep { $_->child(0)->literal =~ m{\Awith|extends\z} } grep { $_->child(0)->isa('PPI::Token::Word') } @{ $ppi_doc->find('PPI::Statement') || [] }; - $req->add_minimum($_ => 0) for @bases; + foreach my $hunk ( @chunks ) { + # roles/inheritance *WITH* version declaration ( added in Moose 1.03 ) + if ( grep { $_->isa('PPI::Structure::Constructor') } @$hunk ) { + # possibly contains a version declaration! + my( $pkg, $done ); + foreach my $elem ( @$hunk ) { + # Scan for the first quote-like word, which is the package name + if ( $elem->isa('PPI::Token::Quote') || $elem->isa('PPI::Token::QuoteLike') ) { + $pkg = ( $self->_q_contents( $elem ) )[0]; + undef $done; + next; + } + + # skip over the fluff and look for the version block + if ( $pkg and $elem->isa('PPI::Structure::Constructor') ) { + foreach my $subelem ( $elem->children ) { + # skip over the fluff and look for the real version code + if ( $subelem->isa('PPI::Statement') ) { + my $found_ver; + foreach my $code ( $subelem->children ) { + # skip over the fluff until we're sure we saw the version declaration + if ( $code->isa('PPI::Token::Word') and $code->literal eq '-version' ) { + $found_ver++; + next; + } + + if ( $found_ver and ( $code->isa('PPI::Token::Quote') || $code->isa('PPI::Token::QuoteLike') || $code->isa('PPI::Token::Number') ) ) { + $req->add_minimum( $pkg => ( $self->_q_contents( $code ) )[0] ); + $done++; + last; + } + } + + # Did we fail to find the ver? + if ( $found_ver and ! $done ) { + die "Possible internal error!"; + } + } + } + + # Failed to find version-specific stuff + if ( ! $done ) { + $req->add_minimum( $pkg => 0 ); + next; + } + } + } + + # If we found a pkg but no done, this must be the "last" pkg to be declared and it has no version + if ( $pkg and ! $done ) { + $req->add_minimum( $pkg => 0 ); + } + } else { + # regular parse + $req->add_minimum( $_ => 0 ) for + grep { Params::Util::_CLASS($_) } + map { $self->_q_contents( $_ ) } + grep { $_->isa('PPI::Token::Quote') || $_->isa('PPI::Token::QuoteLike') } + @$hunk; + } + } } 1; diff --git a/t/autoprereq.t b/t/autoprereq.t index ba9556e..b6a5d4e 100644 --- a/t/autoprereq.t +++ b/t/autoprereq.t @@ -72,6 +72,20 @@ prereq_is( # Moose features +prereq_is( + 'extends "Foo::Bar";', + { + 'Foo::Bar' => 0, + }, +); + +prereq_is( + 'extends "Foo::Bar"; extends "Foo::Baz";', + { + 'Foo::Bar' => 0, + 'Foo::Baz' => 0, + }, +); prereq_is("with 'With::Single';", { 'With::Single' => 0 }); prereq_is( "extends 'Extends::List1', 'Extends::List2';", @@ -213,4 +227,66 @@ prereq_is( }, ); +# test cases for Moose 1.03 -version extension +prereq_is( + 'extends "Foo::Bar"=>{-version=>"1.1"};', + { + 'Foo::Bar' => '1.1', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => \'1.1\' };', + { + 'Foo::Bar' => '1.1', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => 13.3 };', + { + 'Foo::Bar' => '13.3', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => \'1.1\' }; extends "Foo::Baz" => { -version => 5 };', + { + 'Foo::Bar' => '1.1', + 'Foo::Baz' => 5, + }, +); + +prereq_is( + 'extends "Foo::Bar"=>{-version=>1},"Foo::Baz"=>{-version=>2};', + { + 'Foo::Bar' => 1, + 'Foo::Baz' => 2, + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => "4.3.2" }, "Foo::Baz" => { -version => 2.44894 };', + { + 'Foo::Bar' => '4.3.2', + 'Foo::Baz' => 2.44894, + }, +); + +prereq_is( + 'with "With::Single" => { -excludes => "method", -version => "1.1.1" }, "With::Double";', + { + 'With::Single' => '1.1.1', + 'With::Double' => 0, + }, +); + +prereq_is( + 'with "With::Single" => { -wow => { -wow => { a => b } }, -version => "1.1.1" }, "With::Double";', + { + 'With::Single' => '1.1.1', + 'With::Double' => 0, + }, +); + done_testing;
Subject: Re: [rt.cpan.org #59016] [FEATURE PATCH] Add support for Moose v1.03 -version declarations
Date: Sat, 04 Dec 2010 14:14:20 -0700
To: bug-Perl-PrereqScanner [...] rt.cpan.org
From: "perl [...] 0ne.us" <perl [...] 0ne.us>
d0h, I forgot the additional test I posted on RT, the one from doy++ :( Here's the patch with that test included, sorry for the mix-up! Jerome Quelin via RT wrote: Show quoted text
> <URL: https://rt.cpan.org/Ticket/Display.html?id=59016 > > > On Thu Jul 01 00:51:09 2010, APOCAL wrote: >
>> This patch adds support for that, and a bunch of tests :) This was my >> "first" time trying to do something moderately complicated in PPI, ha! >>
> > thanks for the patch. however, a lot of lines appear in your patch > because you seem to have run perltidy on it (cf t/autoprereq.t). > > ==> would it be possible to get your patch without this, in order to > keep it focused to the point? > > thanks. >
diff --git a/lib/Perl/PrereqScanner/Scanner.pm b/lib/Perl/PrereqScanner/Scanner.pm index 31240ea..11c7973 100644 --- a/lib/Perl/PrereqScanner/Scanner.pm +++ b/lib/Perl/PrereqScanner/Scanner.pm @@ -24,9 +24,12 @@ requires 'scan_for_prereqs'; # -- rjbs, 2010-04-06 sub _q_contents { my ($self, $token) = @_; - my @contents = $token->isa('PPI::Token::QuoteLike::Words') - ? ( $token->literal ) - : ( $token->string ); + my @contents; + if ( $token->isa('PPI::Token::QuoteLike::Words') || $token->isa('PPI::Token::Number') ) { + @contents = $token->literal; + } else { + @contents = $token->string; + } return @contents; } diff --git a/lib/Perl/PrereqScanner/Scanner/Moose.pm b/lib/Perl/PrereqScanner/Scanner/Moose.pm index 140311d..e22f46d 100644 --- a/lib/Perl/PrereqScanner/Scanner/Moose.pm +++ b/lib/Perl/PrereqScanner/Scanner/Moose.pm @@ -21,11 +21,7 @@ sub scan_for_prereqs { my ($self, $ppi_doc, $req) = @_; # Moose-based roles / inheritance - my @bases = - grep { Params::Util::_CLASS($_) } - map { $self->_q_contents( $_ ) } - grep { $_->isa('PPI::Token::Quote') || $_->isa('PPI::Token::QuoteLike') } - + my @chunks = # This is what we get when someone does: with('Foo'); # The target to get at is the PPI::Token::Quote::Single. # -- rjbs, 2010-09-05 @@ -37,12 +33,72 @@ sub scan_for_prereqs { # PPI::Token::Quote::Single # PPI::Token::Structure - map { $_->children } + map { [ $_->children ] } grep { $_->child(0)->literal =~ m{\Awith|extends\z} } grep { $_->child(0)->isa('PPI::Token::Word') } @{ $ppi_doc->find('PPI::Statement') || [] }; - $req->add_minimum($_ => 0) for @bases; + foreach my $hunk ( @chunks ) { + # roles/inheritance *WITH* version declaration ( added in Moose 1.03 ) + if ( grep { $_->isa('PPI::Structure::Constructor') } @$hunk ) { + # possibly contains a version declaration! + my( $pkg, $done ); + foreach my $elem ( @$hunk ) { + # Scan for the first quote-like word, which is the package name + if ( $elem->isa('PPI::Token::Quote') || $elem->isa('PPI::Token::QuoteLike') ) { + $pkg = ( $self->_q_contents( $elem ) )[0]; + undef $done; + next; + } + + # skip over the fluff and look for the version block + if ( $pkg and $elem->isa('PPI::Structure::Constructor') ) { + foreach my $subelem ( $elem->children ) { + # skip over the fluff and look for the real version code + if ( $subelem->isa('PPI::Statement') ) { + my $found_ver; + foreach my $code ( $subelem->children ) { + # skip over the fluff until we're sure we saw the version declaration + if ( $code->isa('PPI::Token::Word') and $code->literal eq '-version' ) { + $found_ver++; + next; + } + + if ( $found_ver and ( $code->isa('PPI::Token::Quote') || $code->isa('PPI::Token::QuoteLike') || $code->isa('PPI::Token::Number') ) ) { + $req->add_minimum( $pkg => ( $self->_q_contents( $code ) )[0] ); + $done++; + last; + } + } + + # Did we fail to find the ver? + if ( $found_ver and ! $done ) { + die "Possible internal error!"; + } + } + } + + # Failed to find version-specific stuff + if ( ! $done ) { + $req->add_minimum( $pkg => 0 ); + next; + } + } + } + + # If we found a pkg but no done, this must be the "last" pkg to be declared and it has no version + if ( $pkg and ! $done ) { + $req->add_minimum( $pkg => 0 ); + } + } else { + # regular parse + $req->add_minimum( $_ => 0 ) for + grep { Params::Util::_CLASS($_) } + map { $self->_q_contents( $_ ) } + grep { $_->isa('PPI::Token::Quote') || $_->isa('PPI::Token::QuoteLike') } + @$hunk; + } + } } 1; diff --git a/t/autoprereq.t b/t/autoprereq.t index ba9556e..0e4aec2 100644 --- a/t/autoprereq.t +++ b/t/autoprereq.t @@ -72,6 +72,20 @@ prereq_is( # Moose features +prereq_is( + 'extends "Foo::Bar";', + { + 'Foo::Bar' => 0, + }, +); + +prereq_is( + 'extends "Foo::Bar"; extends "Foo::Baz";', + { + 'Foo::Bar' => 0, + 'Foo::Baz' => 0, + }, +); prereq_is("with 'With::Single';", { 'With::Single' => 0 }); prereq_is( "extends 'Extends::List1', 'Extends::List2';", @@ -213,4 +227,75 @@ prereq_is( }, ); +# test cases for Moose 1.03 -version extension +prereq_is( + 'extends "Foo::Bar"=>{-version=>"1.1"};', + { + 'Foo::Bar' => '1.1', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => \'1.1\' };', + { + 'Foo::Bar' => '1.1', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => 13.3 };', + { + 'Foo::Bar' => '13.3', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => \'1.1\' }; extends "Foo::Baz" => { -version => 5 };', + { + 'Foo::Bar' => '1.1', + 'Foo::Baz' => 5, + }, +); + +prereq_is( + 'extends "Foo::Bar"=>{-version=>1},"Foo::Baz"=>{-version=>2};', + { + 'Foo::Bar' => 1, + 'Foo::Baz' => 2, + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => "4.3.2" }, "Foo::Baz" => { -version => 2.44894 };', + { + 'Foo::Bar' => '4.3.2', + 'Foo::Baz' => 2.44894, + }, +); + +prereq_is( + 'with "With::Single" => { -excludes => "method", -version => "1.1.1" }, "With::Double";', + { + 'With::Single' => '1.1.1', + 'With::Double' => 0, + }, +); + +prereq_is( + 'with "With::Single" => { -wow => { -wow => { a => b } }, -version => "1.1.1" }, "With::Double";', + { + 'With::Single' => '1.1.1', + 'With::Double' => 0, + }, +); + +prereq_is( + 'with "With::Single" => { -exclude => "method", -version => "1.1.1" }, + "With::Double" => { -exclude => "foo" };', + { + 'With::Single' => '1.1.1', + 'With::Double' => 0, + }, +); + done_testing;
Wow, while fiddling around with my code I noticed that I completely missed the "list" case: with( "Foo::Bar" ); PPI treats that *VERY* differently than "with 'Foo::Bar';", argh! Here's the updated patch which adds support for that and also throws in several more tests for good measure :) P.S. Sorry for sorta spamming this ticket... -- ~Apocalypse
Subject: scanner_updated.patch
diff --git a/lib/Perl/PrereqScanner/Scanner.pm b/lib/Perl/PrereqScanner/Scanner.pm index 31240ea..11c7973 100644 --- a/lib/Perl/PrereqScanner/Scanner.pm +++ b/lib/Perl/PrereqScanner/Scanner.pm @@ -24,9 +24,12 @@ requires 'scan_for_prereqs'; # -- rjbs, 2010-04-06 sub _q_contents { my ($self, $token) = @_; - my @contents = $token->isa('PPI::Token::QuoteLike::Words') - ? ( $token->literal ) - : ( $token->string ); + my @contents; + if ( $token->isa('PPI::Token::QuoteLike::Words') || $token->isa('PPI::Token::Number') ) { + @contents = $token->literal; + } else { + @contents = $token->string; + } return @contents; } diff --git a/lib/Perl/PrereqScanner/Scanner/Moose.pm b/lib/Perl/PrereqScanner/Scanner/Moose.pm index 140311d..a5de57d 100644 --- a/lib/Perl/PrereqScanner/Scanner/Moose.pm +++ b/lib/Perl/PrereqScanner/Scanner/Moose.pm @@ -21,11 +21,7 @@ sub scan_for_prereqs { my ($self, $ppi_doc, $req) = @_; # Moose-based roles / inheritance - my @bases = - grep { Params::Util::_CLASS($_) } - map { $self->_q_contents( $_ ) } - grep { $_->isa('PPI::Token::Quote') || $_->isa('PPI::Token::QuoteLike') } - + my @chunks = # This is what we get when someone does: with('Foo'); # The target to get at is the PPI::Token::Quote::Single. # -- rjbs, 2010-09-05 @@ -37,12 +33,91 @@ sub scan_for_prereqs { # PPI::Token::Quote::Single # PPI::Token::Structure - map { $_->children } + map { [ $_->children ] } grep { $_->child(0)->literal =~ m{\Awith|extends\z} } grep { $_->child(0)->isa('PPI::Token::Word') } @{ $ppi_doc->find('PPI::Statement') || [] }; - $req->add_minimum($_ => 0) for @bases; + foreach my $hunk ( @chunks ) { + # roles/inheritance *WITH* version declaration ( added in Moose 1.03 ) + if ( grep { $_->isa('PPI::Structure::Constructor') || $_->isa('PPI::Structure::List') } @$hunk ) { + # hack for List + my @hunkdata = @$hunk; + if ( $hunkdata[0]->isa('PPI::Structure::List') ) { + @hunkdata = $hunkdata[0]->children; + @hunkdata = $hunkdata[1]->children if $hunkdata[0]->isa( 'PPI::Token::Whitespace' ); + } elsif ( $hunkdata[1]->isa('PPI::Structure::List') ) { + @hunkdata = $hunkdata[1]->children; + @hunkdata = $hunkdata[1]->children if $hunkdata[0]->isa( 'PPI::Token::Whitespace' ); + } + if ( $hunkdata[0]->isa('PPI::Statement::Expression') ) { + @hunkdata = $hunkdata[0]->children; + } + + # possibly contains a version declaration! + my( $pkg, $done ); + foreach my $elem ( @hunkdata ) { + # Scan for the first quote-like word, which is the package name + if ( $elem->isa('PPI::Token::Quote') || $elem->isa('PPI::Token::QuoteLike') ) { + # found a new package and the previous one didn't have a version? + if ( defined $pkg ) { + $req->add_minimum( $pkg => 0 ); + } + $pkg = ( $self->_q_contents( $elem ) )[0]; + undef $done; + next; + } + + # skip over the fluff and look for the version block + if ( $pkg and $elem->isa('PPI::Structure::Constructor') ) { + foreach my $subelem ( $elem->children ) { + # skip over the fluff and look for the real version code + if ( $subelem->isa('PPI::Statement') ) { + my $found_ver; + foreach my $code ( $subelem->children ) { + # skip over the fluff until we're sure we saw the version declaration + if ( $code->isa('PPI::Token::Word') and $code->literal eq '-version' ) { + $found_ver++; + next; + } + + if ( $found_ver and ( $code->isa('PPI::Token::Quote') || $code->isa('PPI::Token::QuoteLike') || $code->isa('PPI::Token::Number') ) ) { + $req->add_minimum( $pkg => ( $self->_q_contents( $code ) )[0] ); + $done++; + undef $pkg; + last; + } + } + + # Did we fail to find the ver? + if ( $found_ver and ! $done ) { + die "Possible internal error!"; + } + } + } + + # Failed to find version-specific stuff + if ( ! $done ) { + $req->add_minimum( $pkg => 0 ); + undef $pkg; + next; + } + } + } + + # If we found a pkg but no done, this must be the "last" pkg to be declared and it has no version + if ( $pkg and ! $done ) { + $req->add_minimum( $pkg => 0 ); + } + } else { + # no version or funky blocks in code, yay! + $req->add_minimum( $_ => 0 ) for + grep { Params::Util::_CLASS($_) } + map { $self->_q_contents( $_ ) } + grep { $_->isa('PPI::Token::Quote') || $_->isa('PPI::Token::QuoteLike') } + @$hunk; + } + } } 1; diff --git a/t/autoprereq.t b/t/autoprereq.t index ba9556e..bb0728b 100644 --- a/t/autoprereq.t +++ b/t/autoprereq.t @@ -72,6 +72,20 @@ prereq_is( # Moose features +prereq_is( + 'extends "Foo::Bar";', + { + 'Foo::Bar' => 0, + }, +); + +prereq_is( + 'extends "Foo::Bar"; extends "Foo::Baz";', + { + 'Foo::Bar' => 0, + 'Foo::Baz' => 0, + }, +); prereq_is("with 'With::Single';", { 'With::Single' => 0 }); prereq_is( "extends 'Extends::List1', 'Extends::List2';", @@ -213,4 +227,201 @@ prereq_is( }, ); +# test cases for Moose 1.03 -version extension +prereq_is( + 'extends "Foo::Bar"=>{-version=>"1.1"};', + { + 'Foo::Bar' => '1.1', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => \'1.1\' };', + { + 'Foo::Bar' => '1.1', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => 13.3 };', + { + 'Foo::Bar' => '13.3', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => \'1.1\' }; extends "Foo::Baz" => { -version => 5 };', + { + 'Foo::Bar' => '1.1', + 'Foo::Baz' => 5, + }, +); + +prereq_is( + 'extends "Foo::Bar"=>{-version=>1},"Foo::Baz"=>{-version=>2};', + { + 'Foo::Bar' => 1, + 'Foo::Baz' => 2, + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => "4.3.2" }, "Foo::Baz" => { -version => 2.44894 };', + { + 'Foo::Bar' => '4.3.2', + 'Foo::Baz' => 2.44894, + }, +); + +prereq_is( + 'with "With::Single" => { -excludes => "method", -version => "1.1.1" }, "With::Double";', + { + 'With::Single' => '1.1.1', + 'With::Double' => 0, + }, +); + +prereq_is( + 'with "With::Single" => { -wow => { -wow => { a => b } }, -version => "1.1.1" }, "With::Double";', + { + 'With::Single' => '1.1.1', + 'With::Double' => 0, + }, +); + +prereq_is( + 'with "With::Single" => { -exclude => "method", -version => "1.1.1" }, + "With::Double" => { -exclude => "foo" };', + { + 'With::Single' => '1.1.1', + 'With::Double' => 0, + }, +); + +prereq_is( + 'with("Foo::Bar");', + { + 'Foo::Bar' => 0, + }, +); + +prereq_is( + 'with( "Foo::Bar" );', + { + 'Foo::Bar' => 0, + }, +); + +prereq_is( + 'with( "Foo::Bar", "Bar::Baz" );', + { + 'Foo::Bar' => 0, + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'with( "Foo::Bar" => { -version => "1.1" }, + "Bar::Baz" );', + { + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'with( "Blam::Blam", "Foo::Bar" => { -version => "1.1" }, + "Bar::Baz" );', + { + 'Blam::Blam' => 0, + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'with("Blam::Blam","Foo::Bar"=>{-version=>"1.1"}, + "Bar::Baz" );', + { + 'Blam::Blam' => 0, + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'with("Blam::Blam","Foo::Bar"=>{-version=>"1.1"}, + "Bar::Baz", + "Hoopla" => { -version => 1 } );', + { + 'Blam::Blam' => 0, + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + 'Hoopla' => 1, + } +); + +prereq_is( + 'extends("Foo::Bar");', + { + 'Foo::Bar' => 0, + }, +); + +prereq_is( + 'extends( "Foo::Bar" );', + { + 'Foo::Bar' => 0, + }, +); + +prereq_is( + 'extends( "Foo::Bar", "Bar::Baz" );', + { + 'Foo::Bar' => 0, + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'extends( "Foo::Bar" => { -version => "1.1" }, + "Bar::Baz" );', + { + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'extends( "Blam::Blam", "Foo::Bar" => { -version => "1.1" }, + "Bar::Baz" );', + { + 'Blam::Blam' => 0, + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'extends("Blam::Blam","Foo::Bar"=>{-version=>"1.1"}, + "Bar::Baz" );', + { + 'Blam::Blam' => 0, + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'extends("Blam::Blam","Foo::Bar"=>{-version=>"1.1"}, + "Bar::Baz", + "Hoopla" => { -version => 1 } );', + { + 'Blam::Blam' => 0, + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + 'Hoopla' => 1, + } +); + done_testing;
/me lurks in shame! Another piece of my *apparently* crap code introduced whitespace in unexpected places... Attached is yet another patch that fixes that and adds yet more tests for unexpected whitespaces :) -- ~Apocalypse
Subject: scanner_whitespaces.patch
diff --git a/lib/Perl/PrereqScanner/Scanner.pm b/lib/Perl/PrereqScanner/Scanner.pm index 31240ea..11c7973 100644 --- a/lib/Perl/PrereqScanner/Scanner.pm +++ b/lib/Perl/PrereqScanner/Scanner.pm @@ -24,9 +24,12 @@ requires 'scan_for_prereqs'; # -- rjbs, 2010-04-06 sub _q_contents { my ($self, $token) = @_; - my @contents = $token->isa('PPI::Token::QuoteLike::Words') - ? ( $token->literal ) - : ( $token->string ); + my @contents; + if ( $token->isa('PPI::Token::QuoteLike::Words') || $token->isa('PPI::Token::Number') ) { + @contents = $token->literal; + } else { + @contents = $token->string; + } return @contents; } diff --git a/lib/Perl/PrereqScanner/Scanner/Moose.pm b/lib/Perl/PrereqScanner/Scanner/Moose.pm index 140311d..bc3bf40 100644 --- a/lib/Perl/PrereqScanner/Scanner/Moose.pm +++ b/lib/Perl/PrereqScanner/Scanner/Moose.pm @@ -21,11 +21,7 @@ sub scan_for_prereqs { my ($self, $ppi_doc, $req) = @_; # Moose-based roles / inheritance - my @bases = - grep { Params::Util::_CLASS($_) } - map { $self->_q_contents( $_ ) } - grep { $_->isa('PPI::Token::Quote') || $_->isa('PPI::Token::QuoteLike') } - + my @chunks = # This is what we get when someone does: with('Foo'); # The target to get at is the PPI::Token::Quote::Single. # -- rjbs, 2010-09-05 @@ -37,12 +33,89 @@ sub scan_for_prereqs { # PPI::Token::Quote::Single # PPI::Token::Structure - map { $_->children } + map { [ $_->children ] } grep { $_->child(0)->literal =~ m{\Awith|extends\z} } grep { $_->child(0)->isa('PPI::Token::Word') } @{ $ppi_doc->find('PPI::Statement') || [] }; - $req->add_minimum($_ => 0) for @bases; + foreach my $hunk ( @chunks ) { + # roles/inheritance *WITH* version declaration ( added in Moose 1.03 ) + if ( grep { $_->isa('PPI::Structure::Constructor') || $_->isa('PPI::Structure::List') } @$hunk ) { + # hack for List + my @hunkdata = @$hunk; + while ( $hunkdata[0]->isa('PPI::Token::Whitespace') ) { shift @hunkdata } + if ( $hunkdata[1]->isa('PPI::Structure::List') ) { + @hunkdata = $hunkdata[1]->children; + while ( $hunkdata[0]->isa('PPI::Token::Whitespace') ) { shift @hunkdata } + } + if ( $hunkdata[0]->isa('PPI::Statement::Expression') ) { + @hunkdata = $hunkdata[0]->children; + } + + # possibly contains a version declaration! + my( $pkg, $done ); + foreach my $elem ( @hunkdata ) { + # Scan for the first quote-like word, which is the package name + if ( $elem->isa('PPI::Token::Quote') || $elem->isa('PPI::Token::QuoteLike') ) { + # found a new package and the previous one didn't have a version? + if ( defined $pkg ) { + $req->add_minimum( $pkg => 0 ); + } + $pkg = ( $self->_q_contents( $elem ) )[0]; + undef $done; + next; + } + + # skip over the fluff and look for the version block + if ( $pkg and $elem->isa('PPI::Structure::Constructor') ) { + foreach my $subelem ( $elem->children ) { + # skip over the fluff and look for the real version code + if ( $subelem->isa('PPI::Statement') ) { + my $found_ver; + foreach my $code ( $subelem->children ) { + # skip over the fluff until we're sure we saw the version declaration + if ( $code->isa('PPI::Token::Word') and $code->literal eq '-version' ) { + $found_ver++; + next; + } + + if ( $found_ver and ( $code->isa('PPI::Token::Quote') || $code->isa('PPI::Token::QuoteLike') || $code->isa('PPI::Token::Number') ) ) { + $req->add_minimum( $pkg => ( $self->_q_contents( $code ) )[0] ); + $done++; + undef $pkg; + last; + } + } + + # Did we fail to find the ver? + if ( $found_ver and ! $done ) { + die "Possible internal error!"; + } + } + } + + # Failed to find version-specific stuff + if ( ! $done ) { + $req->add_minimum( $pkg => 0 ); + undef $pkg; + next; + } + } + } + + # If we found a pkg but no done, this must be the "last" pkg to be declared and it has no version + if ( $pkg and ! $done ) { + $req->add_minimum( $pkg => 0 ); + } + } else { + # no version or funky blocks in code, yay! + $req->add_minimum( $_ => 0 ) for + grep { Params::Util::_CLASS($_) } + map { $self->_q_contents( $_ ) } + grep { $_->isa('PPI::Token::Quote') || $_->isa('PPI::Token::QuoteLike') } + @$hunk; + } + } } 1; diff --git a/t/autoprereq.t b/t/autoprereq.t index ba9556e..23d7a36 100644 --- a/t/autoprereq.t +++ b/t/autoprereq.t @@ -72,6 +72,20 @@ prereq_is( # Moose features +prereq_is( + 'extends "Foo::Bar";', + { + 'Foo::Bar' => 0, + }, +); + +prereq_is( + 'extends "Foo::Bar"; extends "Foo::Baz";', + { + 'Foo::Bar' => 0, + 'Foo::Baz' => 0, + }, +); prereq_is("with 'With::Single';", { 'With::Single' => 0 }); prereq_is( "extends 'Extends::List1', 'Extends::List2';", @@ -213,4 +227,272 @@ prereq_is( }, ); +# test cases for Moose 1.03 -version extension +prereq_is( + 'extends "Foo::Bar"=>{-version=>"1.1"};', + { + 'Foo::Bar' => '1.1', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => \'1.1\' };', + { + 'Foo::Bar' => '1.1', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => 13.3 };', + { + 'Foo::Bar' => '13.3', + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => \'1.1\' }; extends "Foo::Baz" => { -version => 5 };', + { + 'Foo::Bar' => '1.1', + 'Foo::Baz' => 5, + }, +); + +prereq_is( + 'extends "Foo::Bar"=>{-version=>1},"Foo::Baz"=>{-version=>2};', + { + 'Foo::Bar' => 1, + 'Foo::Baz' => 2, + }, +); + +prereq_is( + 'extends "Foo::Bar" => { -version => "4.3.2" }, "Foo::Baz" => { -version => 2.44894 };', + { + 'Foo::Bar' => '4.3.2', + 'Foo::Baz' => 2.44894, + }, +); + +prereq_is( + 'with "With::Single" => { -excludes => "method", -version => "1.1.1" }, "With::Double";', + { + 'With::Single' => '1.1.1', + 'With::Double' => 0, + }, +); + +prereq_is( + 'with "With::Single" => { -wow => { -wow => { a => b } }, -version => "1.1.1" }, "With::Double";', + { + 'With::Single' => '1.1.1', + 'With::Double' => 0, + }, +); + +prereq_is( + 'with "With::Single" => { -exclude => "method", -version => "1.1.1" }, + "With::Double" => { -exclude => "foo" };', + { + 'With::Single' => '1.1.1', + 'With::Double' => 0, + }, +); + +prereq_is( + 'with("Foo::Bar");', + { + 'Foo::Bar' => 0, + }, +); + +prereq_is( + 'with( "Foo::Bar" );', + { + 'Foo::Bar' => 0, + }, +); + +prereq_is( + 'with( "Foo::Bar", "Bar::Baz" );', + { + 'Foo::Bar' => 0, + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'with( "Foo::Bar" => { -version => "1.1" }, + "Bar::Baz" );', + { + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'with( "Blam::Blam", "Foo::Bar" => { -version => "1.1" }, + "Bar::Baz" );', + { + 'Blam::Blam' => 0, + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'with("Blam::Blam","Foo::Bar"=>{-version=>"1.1"}, + "Bar::Baz" );', + { + 'Blam::Blam' => 0, + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'with("Blam::Blam","Foo::Bar"=>{-version=>"1.1"}, + "Bar::Baz", + "Hoopla" => { -version => 1 } );', + { + 'Blam::Blam' => 0, + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + 'Hoopla' => 1, + } +); + +prereq_is( + 'extends("Foo::Bar");', + { + 'Foo::Bar' => 0, + }, +); + +prereq_is( + 'extends( "Foo::Bar" );', + { + 'Foo::Bar' => 0, + }, +); + +prereq_is( + 'extends( "Foo::Bar", "Bar::Baz" );', + { + 'Foo::Bar' => 0, + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'extends( "Foo::Bar" => { -version => "1.1" }, + "Bar::Baz" );', + { + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'extends( "Blam::Blam", "Foo::Bar" => { -version => "1.1" }, + "Bar::Baz" );', + { + 'Blam::Blam' => 0, + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'extends("Blam::Blam","Foo::Bar"=>{-version=>"1.1"}, + "Bar::Baz" );', + { + 'Blam::Blam' => 0, + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + } +); + +prereq_is( + 'extends("Blam::Blam","Foo::Bar"=>{-version=>"1.1"}, + "Bar::Baz", + "Hoopla" => { -version => 1 } );', + { + 'Blam::Blam' => 0, + 'Foo::Bar' => '1.1', + 'Bar::Baz' => 0, + 'Hoopla' => 1, + } +); + +prereq_is( + 'with( + \'AAA\' => { -version => \'1\' }, + \'BBB\' => { -version => \'2.1\' }, + \'CCC\' => { + -version => \'4.012345\', + default_finders => [ \':InstallModules\', \':ExecFiles\' ], + }, +);', + { + 'AAA' => 1, + 'BBB' => '2.1', + 'CCC' => '4.012345', + }, +); + +prereq_is( + 'with( + "AAA" + => + { + -version + => + 1 + }, + );', + { + 'AAA' => 1, + }, +); + +prereq_is( + 'with + "AAA" + => + { + -version + => + 1 + };', + { + 'AAA' => 1, + }, +); + +prereq_is( + 'with( + +"Bar" + +);', + { + 'Bar' => 0, + }, +); + +prereq_is( + 'with + +\'Bar\' + +;', + { + 'Bar' => 0, + }, +); + +# invalid code tests +prereq_is( 'with;', {}, ); +prereq_is( 'with foo;', {} ); + done_testing;
thanks, applied & released as 1.000 (note that if you provide a git remote, i'd be able to merge your change directly, which means retaining your name)