diff --git a/Changes b/Changes index d6c89ed1..00d158b0 100644 --- a/Changes +++ b/Changes @@ -10,6 +10,8 @@ Revision history for Perl extension PPI - `use feature` in code - `use $Common::CPAN::Module` in code - PPI::Document->new( feature_mods => ... ) + - PPI::Document->new( custom_feature_includes => ... ) + - PPI::Document->new( custom_feature_include_cb => ... ) - Added ability to parse features: - signatures, as PPI::Structure::Signature - try catch, as PPI::Statement::Compound diff --git a/lib/PPI/Document.pm b/lib/PPI/Document.pm index e3db96cf..a6f37df7 100644 --- a/lib/PPI/Document.pm +++ b/lib/PPI/Document.pm @@ -145,6 +145,32 @@ Setting feature_mods with a hashref allows defining perl parsing features to be enabled for the whole document. (e.g. when the code is assumed to be run as a oneliner) +=head3 custom_feature_includes + + custom_feature_includes => + { strEct => { signatures => "Syntax::Keyword::Try" } } + +Setting custom_feature_includes with a hashref allows defining include names +which act like pragmas that enable parsing features within their scope. + +This is mostly useful when your work project has its own boilerplate module. + +=head3 custom_feature_include_cb + + custom_feature_include_cb => sub { + my ($statement) = @_; + return $statement->module eq "strEct" ? { signatures => "perl" } : (); + }, + +Setting custom_feature_include_cb with a code reference causes all inspections +on includes to call that sub before doing any other inspections. The sub can +decide to either return a hashref of features to be enabled or disabled, which +will be used for the scope the include was called in, or undef to continue with +the default inspections. The argument to the sub will be the +L object. + +This can be useful when your work project has a complex boilerplate module. + =cut sub new { @@ -235,6 +261,8 @@ sub _setattr { $document->{readonly} = !! $attr{readonly}; $document->{filename} = $attr{filename}; $document->{feature_mods} = $attr{feature_mods}; + $document->{custom_feature_includes} = $attr{custom_feature_includes}; + $document->{custom_feature_include_cb} = $attr{custom_feature_include_cb}; return $document; } @@ -360,6 +388,26 @@ sub feature_mods { $self->{feature_mods} = shift; } +=head2 custom_feature_includes { module_name => { feature_name => $provider } } + +=cut + +sub custom_feature_includes { + my $self = shift; + return $self->{custom_feature_includes} unless @_; + $self->{custom_feature_includes} = shift; +} + +=head2 custom_feature_include_cb sub { ... } + +=cut + +sub custom_feature_include_cb { + my $self = shift; + return $self->{custom_feature_include_cb} unless @_; + $self->{custom_feature_include_cb} = shift; +} + =pod =head2 save diff --git a/lib/PPI/Statement/Include.pm b/lib/PPI/Statement/Include.pm index 75f4424a..614256b1 100644 --- a/lib/PPI/Statement/Include.pm +++ b/lib/PPI/Statement/Include.pm @@ -259,6 +259,9 @@ sub feature_mods { my ($self) = @_; return if $self->type eq "require"; + if ( my $cb_features = $self->_custom_feature_include_cb->($self) ) # + { return $cb_features; } + if ( my $perl_version = $self->version ) { ## tried using feature.pm, but it is impossible to install future ## versions of it, so e.g. a 5.20 install cannot know about @@ -283,9 +286,26 @@ sub feature_mods { return { try => "Syntax::Keyword::Try" } if $self->module eq "Syntax::Keyword::Try"; + if ( my $custom = $self->_custom_feature_includes->{ $self->module } ) # + { return $custom; } + return; } +sub _custom_feature_includes { + my ($self) = @_; + return unless # + my $document = $self->document; + return $document->custom_feature_includes || {}; +} + +sub _custom_feature_include_cb { + my ($self) = @_; + return unless # + my $document = $self->document; + return $document->custom_feature_include_cb || sub { }; +} + 1; =pod diff --git a/t/feature_tracking.t b/t/feature_tracking.t index 1e8c1992..71f8b389 100644 --- a/t/feature_tracking.t +++ b/t/feature_tracking.t @@ -2,7 +2,7 @@ use lib 't/lib'; use PPI::Test::pragmas; -use Test::More tests => 6 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 ); +use Test::More tests => 8 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 ); use B 'perlstring'; @@ -198,6 +198,97 @@ END_PERL "core try"; } +HOMEBREW_ARGS: { + test_document + [ custom_feature_includes => { strEct => { signatures => 1 } } ], + <<'END_PERL', + use strEct; + sub meep($) {} + sub marp($left, $right) {} +END_PERL + [ + 'PPI::Statement::Include', 'use strEct;', + 'PPI::Token::Word', 'use', + 'PPI::Token::Word', 'strEct', + 'PPI::Token::Structure', ';', + 'PPI::Statement::Sub', 'sub meep($) {}', + 'PPI::Token::Word', 'sub', + 'PPI::Token::Word', 'meep', + 'PPI::Structure::Signature', '($)', + 'PPI::Token::Structure', '(', + 'PPI::Statement::Expression', '$', + 'PPI::Token::Symbol', '$', + 'PPI::Token::Structure', ')', + 'PPI::Structure::Block', '{}', + 'PPI::Token::Structure', '{', + 'PPI::Token::Structure', '}', + 'PPI::Statement::Sub', 'sub marp($left, $right) {}', + 'PPI::Token::Word', 'sub', + 'PPI::Token::Word', 'marp', + 'PPI::Structure::Signature', '($left, $right)', + 'PPI::Token::Structure', '(', + 'PPI::Statement::Expression', '$left, $right', + 'PPI::Token::Symbol', '$left', + 'PPI::Token::Operator', ',', + 'PPI::Token::Symbol', '$right', + 'PPI::Token::Structure', ')', + 'PPI::Structure::Block', '{}', + 'PPI::Token::Structure', '{', + 'PPI::Token::Structure', '}', + ], + "simple custom boilerplate modules"; +} + +HOMEBREW_CB: { + test_document # + [ + custom_feature_include_cb => sub { + my ($inc) = @_; + my ($arg) = $inc->arguments; + return ( $inc->module eq "strEct" and $arg->string eq "sigg" ) + ? { signatures => 1 } + : (); + } + ], + <<'END_PERL', + use strEct "sigg"; + sub meep($) {} + sub marp($left, $right) {} +END_PERL + [ + 'PPI::Statement::Include', 'use strEct "sigg";', + 'PPI::Token::Word', 'use', + 'PPI::Token::Word', 'strEct', + 'PPI::Token::Quote::Double', '"sigg"', + 'PPI::Token::Structure', ';', + 'PPI::Statement::Sub', 'sub meep($) {}', + 'PPI::Token::Word', 'sub', + 'PPI::Token::Word', 'meep', + 'PPI::Structure::Signature', '($)', + 'PPI::Token::Structure', '(', + 'PPI::Statement::Expression', '$', + 'PPI::Token::Symbol', '$', + 'PPI::Token::Structure', ')', + 'PPI::Structure::Block', '{}', + 'PPI::Token::Structure', '{', + 'PPI::Token::Structure', '}', + 'PPI::Statement::Sub', 'sub marp($left, $right) {}', + 'PPI::Token::Word', 'sub', + 'PPI::Token::Word', 'marp', + 'PPI::Structure::Signature', '($left, $right)', + 'PPI::Token::Structure', '(', + 'PPI::Statement::Expression', '$left, $right', + 'PPI::Token::Symbol', '$left', + 'PPI::Token::Operator', ',', + 'PPI::Token::Symbol', '$right', + 'PPI::Token::Structure', ')', + 'PPI::Structure::Block', '{}', + 'PPI::Token::Structure', '{', + 'PPI::Token::Structure', '}', + ], + "callback for complex custom boilerplate modules"; +} + ### TODO from ppi_token_unknown.t , deduplicate sub one_line_explain {