Extend API of complex source-code parsing CPAN module

Question

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.

Answer 1

Now all these statements contain strings with prefix PPI::

I know this is true of all things in PPI itself, and its a very popular convention.

But I suspect there are cases where things may enter the Document without actually being =~ /^PPI::/.

Also, it seems to me that what you're optimising for is a less frequent usecase than you should be optimising for:

$x->isa("PPI::Whatever")

Should be more heavily used in real code than

"PPI::Whatever" eq $x->class

Either way, you can do better than

 "Whatever" eq $x->name

You could do

 $x->is_named('Whatever');

But that's still gross because "you're not using @ISA".

 $x->is("Whatever")

This could work, but now you're in a bind:

What happens if $x does not subclass whatever class the is method was added on?

These are all, IME, big annoying problems that your desired approach simply makes more complicated to paper over a minor detail.

Which is especially silly when

$x->isa("PPI::Whatever")

Will work, on everything, both PPI and not.

That doesn't mean a "name" attribute wouldn't be useful, but it needs to be said that you should not be proposing to use it as the prime deciding mechanism, and should probably only be for diagnostics.

Given all of the above, a functional API is going to be much more to your liking.

use PPI::Naming qw( is_named is_an );
# not ISA aware
if ( is_named( $object, 'Whatever' ) ) {
         ....
}
# ISA aware
if ( is_an( $object, 'Whatever' ) ) {

}

is_named would be straight forward:

sub is_named {
  my ( $object, $name ) = @_;

  return undef unless defined blessed( $object );

  # This allows somebody to specify "=Whatever" and have it mean
  # "Whatever.pm" instead of "PPI::Whatever"
  if ( $name =~ /^=(.*$)/ ) {
     return $object->class eq "$1";    
  }
  return $object->class eq 'PPI::' . $name;
}

is_an would be a little more complicated.

use MRO::Compat;
use Scalar::Util qw( blessed );
sub is_an { 
  my ( $object, $name ) = @_;

  my $class = blessed($object);
  return undef unless defined $class;

  # This allows somebody to specify "=Whatever" and have it mean
  # "Whatever.pm" instead of "PPI::Whatever"
  if ( $name =~ /^=(.*$)/ ) {
    return $object->isa("$1");
  }
  for my $parent ( mro::get_linear_isa($class) ){
    return 1 if $parent eq "PPI::" . $name;
  }
}

The biggest benefit of this approach is there's almost no room for error. There's no chance that one of your objects could be missing the magic methods you require.

Related Reading

• MRO::Compat
• Scalar::Util