mirod has asked for the wisdom of the Perl Monks concerning the following question:

I want to subclass a class that I don't really control, as its objects are created by an other class, and I am looking for the best way to do this.

Here is the problem: in XML::Twig you create an XML::Twig object, and use it to parse XML data. During the parsing the XML::Twig object creates objects, in the XML::Twig::Elt class, for each element in the XML. It is easy to subclass XML::Twig, and add methods to it. It is however more difficult to subclass XML::Twig::Elt, as the objects are created within XML::Twig. It would be really convenient though, as you can define handlers on XML elements that are passed the element (in $_).

So I plan to add an elt_class option, that will let you write something like this:

my $t= XML::Twig->new( elt_class => 'my_elt_class',
                       p => sub { $_->cut         # an XML::Twig::Elt 
+method
                                    ->my_process; # a my_elt_class met
+hod
                                }
                     );

package my_elt_class;
BEGIN { @my_elt_class::ISA=('XML::Twig::Elt'); } # to inherit from XML
+::Twig::Elt

sub my_process
  { my $elt= shift;
    # stuff here
  }

[download]

So I have 2 questions: does this make sense? I know I like it, I was getting quite uncomfortable adding methods directly in the XML::Twig::Elt package all the time. And the second part: is the implementation below the best possible?

  # in XML::Twig, every time it needs to create an element
  $self->{elt_class} || 'XML::Twig::Elt';
  my $element=  $elt_class->new;

[download]

Here is a complete example, which creates a default element, then element from classes that redefine the new and print methods, just the print method, and then nothing, inheriting both from XML::Twig::Elt.

#!/usr/bin/perl -w
use strict;

foreach my $elt_class ( '', 'my_elt1', 'my_elt2', 'my_elt3')
  { warn "testing $elt_class";
    my $t= XML::Twig->new( elt_class => $elt_class);
    my $e= $t->add_elt;
    $e->print;
  }

package XML::Twig;

sub new 
  { my $class= shift;
    return bless { @_ }; 
  }

sub add_elt
  { my $self= shift;
    $self->{elt} ||= [];

    # this is where it all happens
    my $elt_class=  $self->{elt_class} || 'XML::Twig::Elt';
    my $e=  $elt_class->new;

    push @{$self->{elt}}, $e;
    return $e;
  }
  
package XML::Twig::Elt;
sub new
  { my $class= shift;
    warn "  new elt $class in XML::Twig::Elt\n";
    return bless { @_ }, $class; 
  }

sub print
  { print "  printing from XML::Twig::Elt\n"; }


# redefines new and print
package my_elt1;

# the BEGIN is needed or @my_elt1::ISA would not actually be initializ
+ed
BEGIN { @my_elt1::ISA= qw(XML::Twig::Elt); }

sub new
  {  my $class= shift;
     warn "  new my_elt1 in my_elt1\n";
     return bless { @_ }, $class; 
  }


sub print 
  { print "  printing from my_elt1\n"; }


# redefines print (new is inherited)
package my_elt2;

BEGIN { @my_elt2::ISA= qw(XML::Twig::Elt); }

sub print 
  { print "  printing from my_elt2\n"; }


# does not redefine anything, both new and print are inherited
package my_elt3;

BEGIN { @my_elt3::ISA= qw(XML::Twig::Elt); }

[download]

Replies are listed 'Best First'.
Re: OO Perl: subclassing a class through an other one
by grantm (Parson) on May 06, 2003 at 10:43 UTC

    I had to solve a similar problem recently and the approach I used was to define a method in the main class for creating the secondary class eg:

    sub new_elt { 
  my $self = shift;

  return XML::Twig::Elt->new(@_);
}

    [download]

    Then if someone wants to subclass XML::Twig::Elt then they first need to override XML::Twig::new_elt() to return an object of the new class. eg:

    sub XML::Twig::new_elt { 
  my $self = shift;

  return my_elt_class->new(@_);
}

    [download]
[reply]
[d/l]
[select]

      Depending on the complexity of the other class it might be even simpler to encode the name of the other class as an overridable method. So in XML::Twig you have:

      sub elt_class { "XML::Twig::Elt" };

# in XML::Twig, every time it needs to create an element
$self->elt_class->new;

      [download]

      Then you just need to document elt_class and have your subclass override it as appropriate.

[reply]
[d/l]
[select]

      Interesting, thanks for the insight.

      I see 2 drawbacks to your method:

      • you have to subclass XML::Twig when what you want to subclass is really XML::Twig::Elt. This is probably better from a pure OO POV (is-it? Would any OO purist care to comment?), but a tad more verbose.
      • I would think it is a little slower too, as you add a layer of method calling instead of just a test on a field of the object. I would have to benchmark the 2 ways and compare them.

      So overall your way probably gets more OO-fu but mine wins for convenience and speed. I wonder if my way can break inheritance in some cases, I don't think so but I am no OO guru either.

[reply]
        you have to subclass XML::Twig when what you want to subclass is really XML::Twig::Elt. This is probably better from a pure OO POV (is-it? Would any OO purist care to comment?), but a tad more verbose.

        I don't think either solution is more or less pure than the other. It depends on how you see people using the feature.

        My immediate feeling was that you would want to subclass XML::Twig since you would want to reuse the parser variant, rather than having to remember to pass the appropriate XML::Twig::Elt subclass in each time. Once And Only Once and all that.

        If you're going to be creating lots of one-off XML::Twig parsers passing the class as you originally proposed would probably be more sensible.

        I would think it is a little slower too, as you add a layer of method calling instead of just a test on a field of the object. I would have to benchmark the 2 ways and compare them.

        It would be trivial to cache the result of the method to reduce it to the hash-lookup case:

        # in XML::Twig::add_elt
my $elt_class = $self->{elt_class} ||= $self->elt_class;
my $e = $elt_class->new ;

        [download]

        There is, of course, nothing stopping you having both mechanisms so you can subclass, or change it on an object-by-object basis. That way everybody's happy :-)

[reply]
[d/l]

Back to Seekers of Perl Wisdom