I am working on a source line parser using PPI
. After working a while, I realized that
it would be nice if the PPI
API had included such and such functionality. As a very simple example, the PPI::Element
contains a class
method that returns the class name of the current element. This method must be called quite often and results in statements like
if ( $elem->class eq 'PPI::Token::Symbol' ) { ... }
Now all these statements contain strings with prefix PPI::
, so it would be nice if there was a an alternative to the class
method that would omit the prefix. For exmple a name
method:
if ( $elem->name eq 'Token::Symbol' ) { ... }
How can this best be achieved? In general, the question is how to extend a complex CPAN module like PPI
with user defined methods? I think sub classing the PPI::Element
method would not work (see example below) since other PPI methods like find
or snext_sibling
would still return PPI::Element
objects (see below example) and not objects of my sub class. Here is what I came up with:
use feature qw(say);
use strict;
use warnings;
BEGIN {
require PPI;
require PPI::Dumper;
require My::PPI::Extensions;
*{PPI::Element::name} = \&My::PPI::Extensions::name;
}
my $line = 'f( $q->{key}[$var + 4] );';
my $doc = PPI::Document->new( \$line );
my $dumper = PPI::Dumper->new( $doc );
$dumper->print;
my $symbols = $doc->find('PPI::Token::Symbol');
my $elem = $symbols->[0];
say "";
say "Start elem: " . $elem->class;
$elem = $elem->snext_sibling;
say "Next elem: " . $elem->class;
# This first test is how it would be done originally,
# here I have to include the "PPI::" prefix
if ( $elem->class eq 'PPI::Token::Operator') {
say "First test ok..";
}
# This second test is to show how it could be done without
# modifying the `PPI::Element` API
if ( is_elem( $elem, name => 'Token::Operator') ) {
say "Second test ok..";
}
# This last test shows the new method "name":
if ( $elem->name eq 'Token::Operator') {
say "Third test ok..";
}
sub is_elem {
my ( $elem, %opt ) = @_;
my $class = $elem->class;
$class =~ s/^PPI:://;
return $class eq $opt{name};
}
where My/PPI/Extensions.pm
is:
package My::PPI::Extensions;
use feature qw(say);
use strict;
use warnings;
sub name {
my $self = shift;
my $name = $self->class;
$name =~ s/^PPI:://;
return $name;
}
1;
Note: the code I am working on might turn into an open source project at some point. It could also become somewhat complex. So it will be important that it will be maintainable in the long run, also by others in addition to myself.
References:
- Chapter 9:
Modifying and Jury-Rigging Modules
of Mastering Perl.
return substr $name, 5
instead of the regex substitution. You're probably going to call that stuff a lot, so it might make a difference, especially since your string won't change. \$\endgroup\$