Get a list of classes derived from given base class in Perl-CodePudding

Given a base class and a list of classes derived from it:

package base
{
    # ...
}

package foo
{
    our @ISA = 'base';
    # ...
}

package bar
{
    our @ISA = 'base';
    # ...
}

Is there a runtime way to get a list of classes which have base as parent?

I know I could easily work around this by adding their names to a list manually, but I was wondering if base itself could tell me who inherited from it.

CodePudding user response：

In the code you've provided, you could use the @ISA array to get a list of classes that have base as a parent. The @ISA array contains the names of the parent classes for a given class, so you could iterate through the @ISA arrays of all classes and check if base is included in any of them. Here's an example of how you could do this:

# Define a list of all classes
my @classes = qw( foo bar );

# Define an empty list to store the names of classes that have 'base' as a parent
my @derived_classes;

# Iterate through the list of classes
for my $class (@classes) {
    # Use the 'isa' function to check if the current class has 'base' as a parent
    if ($class->isa('base')) {
        # If the current class has 'base' as a parent, add its name to the list of derived classes
        push @derived_classes, $class;
    }
}

# Print the list of derived classes
print "Derived classes: @derived_classes\n";

Note that this code assumes that the classes have already been loaded and that the @ISA arrays have been initialized properly. If this is not the case, you will need to load the classes and initialize their @ISA arrays before attempting to check which classes have base as a parent.

CodePudding user response：

If you don't know the names of all the "potential" classes, you can recursively iterate through the complete "namespace".

sub inspect {
    my ($package, $search_for) = @_;
    my @result;
    my $keys = 'sort keys (%' . $package . '::)';
    $package=~ s/main:://;
    my @keys = eval $keys;
    foreach my $lookup (@keys) {
        $lookup =~ s/main:://;
        if ($lookup =~ /(.*)::$/) {
            push @result, inspect($package.'::'.$1, $search_for);
        }
    }
    push @result, $package
         if $package->isa($search_for);
    return @result;
}

so in your example:

print "Number of derived classes: " . (inspect('main', 'base') -1) .  "\n";

we have to extract one, as the class is an instance of its own.

AFAIK base doesn't store the "class-tree" anywhere.