File Coverage

blib/lib/Class/CanBeA.pm

Criterion	Covered	Total	%
statement	24	24	100.0
branch	6	8	75.0
condition	9	12	75.0
subroutine	4	4	100.0
pod	1	1	100.0
total	44	49	89.8

package Class::CanBeA;

use strict;
use warnings;

our $VERSION = '1.4';

sub subclasses {
    no strict 'refs';
    my($superclass, $namespace) = @_;
    die("Need to specify superclass when looking for subclasses\n")
        unless($superclass);
    $namespace = (($namespace) ? $namespace : 'main').'::';
    (my $parent = $namespace)=~ s/^main::$//;
    my @children = ();
    foreach my $child (
        map { s/::$//; $_ }
        grep { $_ ne 'SUPER::' && $_ ne '::' && $_ ne 'main::' && $_ ne '0::' && !/^::/ && /::$/ }
        keys %{$namespace}
    ) {
        push @children, $parent.$child if("$parent$child"->isa($superclass));
        push @children, @{subclasses($superclass, $parent.$child)};
    }
    return [grep { $_ ne $superclass } @children];
}

=head1 NAME

Class::CanBeA - figure out what your class can be.

=head1 SYNOPSIS

    use Class::CanBeA;

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

=head1 DETAILS

This package provides just one function, which it does *not* export, so you
need to call it by its fully qualified name.

=head1 FUNCTIONS

=head2 subclasses

Takes a single argument, which should be a class name.  It returns a
reference to an array of all the classes which are loaded and which are
subclasses of the specified superclass.

Internally it recurses and passes other parameters to that function, but you
don't need to know that, so I haven't mentioned it.  Right?

=head1 BUGS/LIMITATIONS

No attempt is made to deal with circular inheritance.

Will only tell you about loaded and defined classes, obviously.

=head1 AUTHOR

David Cantrell [e-mail]

=head1 FEEDBACK

Please let me know if you find this module useful.  If reporting a bug,
it's helpful to include a minimal code snippet which I can use in the
test suite.

=head1 SEE ALSO

  Class::ISA

=head1 LICENCE

You may use, modify, distribute and have fun with this software under the
same terms as you can with perl itself.  You may even use it as a device
for distracting leopards.

=cut

'false';