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

So, what's a quick and easy way to discover the subclasses of a particular class at run time?

NB: It's probably bad practice for a class to know about its subclasses. But I am hacking in a hurry... and anyway, I think it's an interesting question.

dave hj~

Replies are listed 'Best First'.
Re: subclass discovery at runtime
by adrianh (Chancellor) on Jan 27, 2003 at 13:18 UTC

    Devel::Symdump can do what you want. Something like:

    use Devel::Symdump;

my @subclasses;
foreach (Devel::Symdump->rnew->packages) {
    push @subclasses, $_ if UNIVERSAL::isa($_, $class);
};

    [download]

    should do what you want.

    Actually, it won't since $class->isa($class) is true - it will include the class as a member of its subclasses. The following will return just the subclasses :-)

    sub subclasses_of {
  my $class = shift;
  grep { $_->isa($class) && $_ ne $class} Devel::Symdump->rnew->packag
+es;
};

    [download]
[reply]
[d/l]
[select]
Re: subclass discovery at runtime
by Gilimanjaro (Hermit) on Jan 27, 2003 at 16:06 UTC
    Update; rewritten, now a working solution thanks to Aristotle's help... Old post under read more

    You'll need to (recursively) get all defined namespaces, and then check all of them to see which ones are a subclass of ourselves... The code below seems to work...

    package SuperClass;
sub subclasses {
        return grep {
                UNIVERSAL::isa($_,__PACKAGE__) && 
                $_ ne __PACKAGE__ 
        } main::packages();
}

package SubClass;
@ISA=qw(SuperClass);

package main;
sub packages {
        return packages({},\%main::) unless @_;
        my ($packages,$in) = @_;                        
        while(my ($package,$table) = each %$in) {       
                next unless $package =~ /(.*)::$/;      
                next if exists $packages->{$table};     
                $packages->{$table} = $1;               
                packages($packages,$table);             
        }
        return values %$packages;                       
}

$\=$,="\n";
print SuperClass::subclasses();

    [download]
    Read more... (789 Bytes)
[reply]
[d/l]
[select]
      That will look at @Foo::ISA, but not @Foo::Bar::ISA. The latter can only be found via the Bar:: key in the Foo:: symbol table, so you'd have to change your code to recurse the tables.

      Makeshifts last the longest.

[reply]
        Very true; in fact I've had very little success while experimenting with my own suggestion!

        It seems that UNIVERSAL::isa is not doing at all what I'm expecting it to do... 

        print UNIVERSAL::isa('SubClass','SuperClass') ? 'true' : 'false';

package SuperClass;
package SubClass;
use vars qw(@ISA);
@ISA=qw(SuperClass);

        [download]
        Seems to print false! Does this mean 'isa' only works on objects? Not on class-names?

        I feel like a noob... I'd consider doing a '--' on my own original post, if I could...

        Update: Aristotle got me on track again... Temporary insanity resolved

[reply]
[d/l]

Back to Seekers of Perl Wisdom