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