Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Finding classes which are inherited from a given class

by sutch (Curate)
on Aug 06, 2004 at 08:18 UTC ( #380475=perlquestion: print w/ replies, xml ) Need Help??
sutch has asked for the wisdom of the Perl Monks concerning the following question:

How can I obtain a list of all classes which are inherited from a specific class in an executing script?

For example, if there a bunch of classes dynamically created and inherited from Class::Tables, how could I go about finding all of these classes (without looking at the database from which Class::Tables generated these classes).

Comment on Finding classes which are inherited from a given class
Re: Finding classes which are inherited from a given class
by fergal (Chaplain) on Aug 06, 2004 at 09:15 UTC
    The hard way is to look inside %:: (or %main:: if you prefer) for keys ending in ::. Let's say that the only package that has been loaded is A::B::C. Look inside %main:: and you will see a variety of things, including a key "A::". This tells you that something has been loaded into the package A. Next you should look at @A::ISA to see if A inherits from your class. Then you look inside %A:: and you will find a key "B::", again check @A::B::ISA, finally you look inside %A::B:: and you will find a key "C::" so check @A::B::C::ISA. When you look inside %A::B::C:: you don't find any keys ending in :: so you're done.

    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 }
    The easy way is to use a module to help with this, I thought there was one but I can't find it!

    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); } }
Re: Finding classes which are inherited from a given class
by gellyfish (Monsignor) on Aug 06, 2004 at 09:16 UTC

    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"; } }
    There are probably modules that do this smarter however.

    /J\

Re: Finding classes which are inherited from a given class
by gmax (Abbot) on Aug 06, 2004 at 10:32 UTC

    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";
    output:
    DeepBar Bar DeeperPub Pub DeeperBar DeepPub
    
     _  _ _  _  
    (_|| | |(_|><
     _|   
    
Re: Finding classes which are inherited from a given class
by Prior Nacre V (Hermit) on Aug 06, 2004 at 12:38 UTC

    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; }

    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,

    PN5

Re: Finding classes which are inherited from a given class
by Anonymous Monk on Aug 06, 2004 at 17:33 UTC
    Child classes "inherit from" a base class, and base classes "are inherited by" child classes, but never classes are not "inherited from" another class. The bad grammar is the reason not all the answers you received are solutions to your problem.
      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.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://380475]
Approved by davido
Front-paged by Caron
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (4)
As of 2014-09-21 17:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (173 votes), past polls