There is a tiny module that gives a straight answer. Look for Class::CanBeA

Here is an example of how it works:

#!/usr/bin/perl -w
use strict;
use Class::CanBeA;

package Dummy;      sub dummy {}; # not inherited

package Foo;        sub bar {};   # The ultimate parent

package Bar;        use base qw(Foo);
package DeepBar;    use base qw(Bar);
package DeeperBar;  use base qw(DeepBar);


package Pub;        use base qw(Foo);
package DeepPub;    use base qw(Pub);
package DeeperPub;  use base qw(DeepPub);

my @subclasses = @{Class::CanBeA::subclasses('Foo')};

print "@subclasses\n";
[download]

output:
DeepBar Bar DeeperPub Pub DeeperBar DeepPub

 _  _ _  _  
(_|| | |(_|><
 _|   

Code would look a little like

check_pkg("::");

sub check_pkg
{
  my $pkg = shift;

  # ::main:: and :: are the same and we don't want an inifinite loop  
  return if $pkg eq "::main::"; 

  foreach my $sub_pkg (grep /::$/, keys %{$pkg})
  {
    my $full_pkg = "$pkg$sub_pkg";
    print "checking $full_pkg\n";
    print "$full_pkg inherits\n" if check_isa($full_pkg);
    check_pkg($full_pkg);
  }
}

sub check_isa
{
  # check @{$pkg."::ISA"} to see if it inherits
}
[download]

Update: as an aumsement, here's a version that doesn't use recursion

my @to_check = ("::");

while (my $pkg = pop @to_check)
{
  next if $pkg eq "::main::"; # because ::main:: and :: are the same
  foreach my $sub_pkg (grep /::$/, keys %{$pkg})
  {
    my $full_pkg = "$pkg$sub_pkg";
    print "checking $full_pkg\n";
    print "$full_pkg inherits\n" if check_isa($full_pkg);
    push(@to_check, $full_pkg);
  }
}
[download]

It's a dirty rotten hack but someone had to do it:

package Foo;
                                                                      
+          
sub bar {};
                                                                      
+          
1;
                                                                      
+          
package Bar;
                                                                      
+          
use base qw(Foo);
                                                                      
+          
1;
                                                                      
+          
package main;
                                                                      
+          
for my $foo (grep /::/ , keys %:: )
{
   if ( exists %{$foo}->{ISA} )
   {
      print @{%{$foo}->{ISA}},"\n";
   }
}
[download]

/J\

I wrote the following recently for a similar purpose:

sub walk_oo_tree
{
    my $obj = shift;

    my $class = ref $obj ? ref $obj : $obj;

    my @class_list = ();

    unless ($skip_class_map{$class})
    {
        NO_STRICT_REFS_ZONE:
        {
            no strict 'refs';
            @class_list = ($class, map { @{walk_oo_tree($_)} } @{join(
+'::', $class, 'ISA')});
            use strict 'refs';
        }
    }

    return \@class_list;
}
[download]

The %skip_class_map (in my implementation) was global (our) and evaluated to (UNIVERSAL => 1, AUTOLOAD => 1).

Note: you can pass this a class name or an object of the required class.

Finally, to head off comments re the 'NO_STRICT_REFS_ZONE:' block: the label, block and use are not necessary. I prefer defensive programming to surprises.

Regards,

Thanks for the comment, although I have to admit that I'm not clear on what you mean by never classes are not "inherited from" another class. Please clarify.