diff --git a/lib/PPI.pm b/lib/PPI.pm index b072080e..0d17052e 100644 --- a/lib/PPI.pm +++ b/lib/PPI.pm @@ -24,6 +24,7 @@ use PPI::Document::Normalized (); use PPI::Normal (); use PPI::Tokenizer (); use PPI::Lexer (); +use PPI::Plugin (); # If it is installed, load in PPI::XS die diff --git a/lib/PPI/Document.pm b/lib/PPI/Document.pm index 07e9def8..44572035 100644 --- a/lib/PPI/Document.pm +++ b/lib/PPI/Document.pm @@ -277,6 +277,7 @@ sub _setattr { $document->{feature_mods} = $attr{feature_mods}; $document->{custom_feature_includes} = $attr{custom_feature_includes}; $document->{custom_feature_include_cb} = $attr{custom_feature_include_cb}; + $document->{plugins} = $attr{plugins}; if ( $ENV{PPI_CUSTOM_FEATURE_INCLUDES} ) { my $includes = YAML::PP::Load $ENV{PPI_CUSTOM_FEATURE_INCLUDES}; die "\$ENV{PPI_CUSTOM_FEATURE_INCLUDES} " @@ -431,6 +432,21 @@ sub custom_feature_include_cb { $self->{custom_feature_include_cb} = shift; } +=head2 plugins + + my $plugins = $document->plugins; + +Returns an array reference of L objects registered for this +document, or an empty array reference if none are set. + +=cut + +sub plugins { + my $self = shift; + return $self->{plugins} || [] unless @_; + $self->{plugins} = shift; +} + =pod =head2 save diff --git a/lib/PPI/Lexer.pm b/lib/PPI/Lexer.pm index 5bdeb9de..33603000 100644 --- a/lib/PPI/Lexer.pm +++ b/lib/PPI/Lexer.pm @@ -202,6 +202,11 @@ sub lex_tokenizer { $Tokenizer->_features($feat); } + # Propagate plugins to both Lexer and Tokenizer + my $plugins = $Document->plugins; + $self->{plugins} = $plugins; + $Tokenizer->_plugins($plugins) if @$plugins; + # Lex the token stream into the document $self->{Tokenizer} = $Tokenizer; if ( !eval { $self->_lex_document($Document); 1 } ) { @@ -420,6 +425,12 @@ sub _statement { my $is_lexsub = 0; + # Give plugins first chance to classify the statement + for my $plugin ( @{ $self->{plugins} || [] } ) { + my $pclass = $plugin->statement_class( $Token, $Parent ); + return $pclass if defined $pclass; + } + # Is it a token in our known classes list my $content = $Token->content; my $class = diff --git a/lib/PPI/Plugin.pm b/lib/PPI/Plugin.pm new file mode 100644 index 00000000..90f25d38 --- /dev/null +++ b/lib/PPI/Plugin.pm @@ -0,0 +1,138 @@ +package PPI::Plugin; + +=pod + +=head1 NAME + +PPI::Plugin - Base class for PPI parsing plugins + +=head1 SYNOPSIS + + # Create a plugin that recognizes 'method' as starting an expression + package My::Plugin; + use parent 'PPI::Plugin'; + + sub statement_class { + my ($self, $token, $parent) = @_; + return 'PPI::Statement::Expression' + if $token->isa('PPI::Token::Word') + and $token->content eq 'method'; + return; + } + + # Use it + my $doc = PPI::Document->new(\$source, plugins => [My::Plugin->new]); + +=head1 DESCRIPTION + +C provides an interface for extending PPI's parsing behavior +without modifying PPI's internals. Plugins can hook into the lexer and +tokenizer at well-defined points to influence how Perl source code is +parsed into a PDOM tree. + +Plugins are passed to L via the C parameter +and are propagated through the Lexer and Tokenizer during parsing. + +=head1 METHODS + +=head2 new + + my $plugin = PPI::Plugin->new(%params); + +Creates a new plugin object. The base class constructor accepts any +key/value pairs and stores them as object attributes. Subclasses may +override this to validate or process their parameters. + +=cut + +use strict; + +our $VERSION = '1.292'; + +sub new { + my $class = ref $_[0] ? ref shift : shift; + bless { @_ }, $class; +} + +=pod + +=head2 statement_class $token, $parent + + sub statement_class { + my ($self, $token, $parent) = @_; + return 'PPI::Statement::Sub' if ...; + return; # defer to default behavior + } + +Called by the Lexer when determining which C subclass to +use for a new statement. Receives the first significant token and the +parent node. Return a statement class name to override the default, or +C/empty list to defer to PPI's normal classification. + +=cut + +sub statement_class { return } + +=pod + +=head2 modify_token $token + + sub modify_token { + my ($self, $token) = @_; + $token->{_my_flag} = 1 if $token->content eq 'method'; + return; + } + +Called by the Tokenizer after each token is finalized. Receives the +completed token object. Can modify the token in-place (e.g., set custom +attributes). The return value is ignored. + +B Plugins must not change the token's class or content in ways that +would break round-trip safety. Adding custom attributes (with a leading +underscore by convention) is the intended use. + +=cut + +sub modify_token { return } + +=pod + +=head2 feature_includes $include + + sub feature_includes { + my ($self, $include) = @_; + return { signatures => 1 } + if $include->module eq 'My::Boilerplate'; + return; + } + +Called when the Lexer encounters a C or C statement. Receives +the L object. Return a hashref of features to +enable/disable for the current scope, or C/empty list to defer +to PPI's normal feature detection. + +This hook is called before PPI's built-in feature detection, so plugins +get first chance to claim an include statement. + +=cut + +sub feature_includes { return } + +1; + +=pod + +=head1 WRITING PLUGINS + +Subclass C and override one or more hook methods. All hooks +have safe defaults (return nothing), so you only implement what you need. + +Multiple plugins can be active simultaneously. They are called in order; +the first plugin to return a defined value wins for C and +C. All plugins receive C calls regardless. + +=head1 SEE ALSO + +L, L, L + +=cut diff --git a/lib/PPI/Statement/Include.pm b/lib/PPI/Statement/Include.pm index 56644a29..a8d897c3 100644 --- a/lib/PPI/Statement/Include.pm +++ b/lib/PPI/Statement/Include.pm @@ -264,6 +264,11 @@ sub feature_mods { if ( my $cb_features = $self->_custom_feature_include_cb->($self) ) # { return $cb_features; } + for my $plugin ( @{ $self->_plugins } ) { + my $pfeatures = $plugin->feature_includes($self); + return $pfeatures if $pfeatures; + } + 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 @@ -343,6 +348,13 @@ sub _custom_feature_include_cb { return $document->custom_feature_include_cb || sub { }; } +sub _plugins { + my ($self) = @_; + return unless # + my $document = $self->document; + return $document->plugins; +} + 1; =pod diff --git a/lib/PPI/Tokenizer.pm b/lib/PPI/Tokenizer.pm index 6c688a9f..35ca5435 100644 --- a/lib/PPI/Tokenizer.pm +++ b/lib/PPI/Tokenizer.pm @@ -633,6 +633,13 @@ sub _finalize_token { my $self = shift; return $self->{class} unless defined $self->{token}; + # Let plugins inspect/modify the token + if ( my $plugins = $self->{plugins} ) { + for my $plugin ( @$plugins ) { + $plugin->modify_token( $self->{token} ); + } + } + # Add the token to the token buffer push @{ $self->{tokens} }, $self->{token}; $self->{token} = undef; @@ -858,6 +865,11 @@ sub _features { return $arg ? $self->{feature_set} = $arg : $self->{feature_set} || {}; } +sub _plugins { + my ( $self, $arg ) = @_; + return $arg ? $self->{plugins} = $arg : $self->{plugins} || []; +} + sub _current_token_has_signatures_active { shift->{feature_set}{signatures} } 1; diff --git a/t/ppi_plugin.t b/t/ppi_plugin.t new file mode 100644 index 00000000..e0ed3ee5 --- /dev/null +++ b/t/ppi_plugin.t @@ -0,0 +1,100 @@ +#!/usr/bin/perl + +use lib 't/lib'; +use PPI::Test::pragmas; +use Test::More tests => 12 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 ); + +use PPI (); +use PPI::Dumper; + +PLUGIN_BASE_CLASS: { + require_ok('PPI::Plugin'); + my $plugin = eval { PPI::Plugin->new }; + isa_ok( $plugin, 'PPI::Plugin' ); + can_ok( 'PPI::Plugin', 'statement_class', 'modify_token', 'feature_includes' ); +} + +PLUGIN_PASSED_TO_DOCUMENT: { + my $plugin = PPI::Plugin->new; + my $doc = PPI::Document->new( \"my \$x = 1;", plugins => [$plugin] ); + ok( $doc, "Document created with plugins attribute" ); + my $plugins = $doc->plugins; + is( ref $plugins, 'ARRAY', "plugins accessor returns arrayref" ); + is( scalar @$plugins, 1, "plugins list has one entry" ); +} + +STATEMENT_CLASS_HOOK: { + { + package TestPlugin::StatementClass; + use parent 'PPI::Plugin'; + sub statement_class { + my ( $self, $token, $parent ) = @_; + return 'PPI::Statement::Expression' + if $token->isa('PPI::Token::Word') + and $token->content eq 'method'; + return; + } + } + + my $plugin = TestPlugin::StatementClass->new; + my $doc = PPI::Document->new( + \"method foo { 1 }", + plugins => [$plugin], + ); + ok( $doc, "Document parsed with statement_class plugin" ); + + my $stmts = $doc->find('PPI::Statement::Expression'); + ok( $stmts && @$stmts, "plugin's statement_class hook was invoked" ); +} + +MODIFY_TOKEN_HOOK: { + { + package TestPlugin::ModifyToken; + use parent 'PPI::Plugin'; + sub modify_token { + my ( $self, $token ) = @_; + if ( $token->isa('PPI::Token::Word') + and $token->content eq 'method' ) + { + $token->{_plugin_seen} = 1; + } + return; + } + } + + my $plugin = TestPlugin::ModifyToken->new; + my $doc = PPI::Document->new( + \"method foo { 1 }", + plugins => [$plugin], + ); + ok( $doc, "Document parsed with modify_token plugin" ); + + my $words = $doc->find('PPI::Token::Word'); + my ($method_word) = grep { $_->content eq 'method' } @$words; + ok( $method_word && $method_word->{_plugin_seen}, + "plugin's modify_token hook was called" ); +} + +FEATURE_INCLUDES_HOOK: { + { + package TestPlugin::FeatureIncludes; + use parent 'PPI::Plugin'; + sub feature_includes { + my ( $self, $include ) = @_; + return { signatures => 1 } + if $include->module + and $include->module eq 'MyApp::Signatures'; + return; + } + } + + my $plugin = TestPlugin::FeatureIncludes->new; + my $doc = PPI::Document->new( + \"use MyApp::Signatures;\nsub foo(\$x) {}", + plugins => [$plugin], + ); + ok( $doc, "Document parsed with feature_includes plugin" ); + + my $sigs = $doc->find('PPI::Structure::Signature'); + ok( $sigs && @$sigs, "plugin's feature_includes hook enabled signatures" ); +}