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


line stmt bran cond sub pod time code
1             package Class::CanBeA;
2              
3 1     1   608 use strict;
  1         1  
  1         26  
4 1     1   4 use warnings;
  1         1  
  1         39  
5              
6             our $VERSION = '1.3';
7              
8             sub subclasses {
9 1     1   4 no strict 'refs';
  1         4  
  1         263  
10 352     352 1 556 my($superclass, $namespace) = @_;
11 352 50       564 die("Need to specify superclass when looking for subclasses\n")
12             unless($superclass);
13 352 100       500 $namespace = (($namespace) ? $namespace : 'main').'::';
14 352         445 (my $parent = $namespace)=~ s/^main::$//;
15 352         393 my @children = ();
16 352         313 foreach my $child (
  350         684  
17 350 50 66     522 map { s/::$//; $_ }
  6412   100     70435  
      66        
      66        
18 352         2673 grep { $_ ne 'SUPER::' && $_ ne '::' && $_ ne 'main::' && $_ ne '0::' && !/^::/ && /::$/ }
19             keys %{$namespace}
20             ) {
21 350 100       2509 push @children, $parent.$child
22             if(UNIVERSAL::isa($parent.$child, $superclass));
23 350         413 push @children, @{subclasses($superclass, $parent.$child)};
  350         713  
24             }
25 352         1525 return [grep { $_ ne $superclass } @children];
  17         44  
26             }
27              
28             =head1 NAME
29              
30             Class::CanBeA - figure out what your class can be.
31              
32             =head1 SYNOPSIS
33              
34             use Class::CanBeA;
35              
36             my @subclasses = @{Class::CanBeA::subclasses('My::Class')};
37              
38             =head1 DETAILS
39              
40             This package provides just one function, which it does *not* export, so you
41             need to call it by its fully qualified name.
42              
43             =head1 FUNCTIONS
44              
45             =head2 subclasses
46              
47             Takes a single argument, which should be a class name. It returns a
48             reference to an array of all the classes which are loaded and which are
49             subclasses of the specified superclass.
50              
51             Internally it recurses and passes other parameters to that function, but you
52             don't need to know that, so I haven't mentioned it. Right?
53              
54             =head1 BUGS/LIMITATIONS
55              
56             No attempt is made to deal with circular inheritance.
57              
58             Will only tell you about loaded and defined classes, obviously.
59              
60             =head1 AUTHOR
61              
62             David Cantrell Edavid@cantrell.org.ukE
63              
64             =head1 FEEDBACK
65              
66             Please let me know if you find this module useful. If reporting a bug,
67             it's helpful to include a minimal code snippet which I can use in the
68             test suite.
69              
70             =head1 SEE ALSO
71              
72             Class::ISA
73              
74             =head1 LICENCE
75              
76             You may use, modify, distribute and have fun with this software under the
77             same terms as you can with perl itself. You may even use it as a device
78             for distracting leopards.
79              
80             =cut
81              
82             'false';