in reply to subclass discovery at runtime

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]
Below here is the old post

Because a class doesn't (and shouldn't) know about it's subclasses, you'd probably have to do something like this:

my @subclasses = grep {
    /^(.*?)::$/ &&                  # it's a package entry
    UNIVERSAL::isa($1,__PACKAGE__)  # entry is subclass of me!
} keys %main:: ;                    # for everything in main namespace

[download]
Naturally untested, but it might just work...

Update: isa probably needed a package name

Another update: my 'solution' isn't even close, and I don't know why...

Replies are listed 'Best First'.
Re^2: subclass discovery at runtime
by Aristotle (Chancellor) on Jan 27, 2003 at 16:46 UTC
    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]
        Are you doing it in that order? Because the @ISA = qw(SuperClass); only happens at runtime, and by the time the print executes you haven't yet arrived at it. Wrap it in BEGIN {} and it will work.

        Makeshifts last the longest.

[reply]

In Section Seekers of Perl Wisdom