File | /usr/local/lib/perl5/5.10.1/Class/ISA.pm |
Statements Executed | 19 |
Statement Execution Time | 372µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 16µs | 26µs | BEGIN@8 | Class::ISA::
1 | 1 | 1 | 13µs | 15µs | BEGIN@3 | Class::ISA::
1 | 1 | 1 | 12µs | 51µs | BEGIN@4 | Class::ISA::
1 | 1 | 1 | 9µs | 22µs | BEGIN@13 | Class::ISA::
1 | 1 | 1 | 7µs | 19µs | BEGIN@61 | Class::ISA::
0 | 0 | 0 | 0s | 0s | self_and_super_path | Class::ISA::
0 | 0 | 0 | 0s | 0s | self_and_super_versions | Class::ISA::
0 | 0 | 0 | 0s | 0s | super_path | Class::ISA::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Class::ISA; | ||||
2 | 1 | 12µs | require 5; | ||
3 | 3 | 28µs | 2 | 18µs | # spent 15µs (13+3) within Class::ISA::BEGIN@3 which was called
# once (13µs+3µs) by DateTime::Locale::Base::BEGIN@6 at line 3 # spent 15µs making 1 call to Class::ISA::BEGIN@3
# spent 3µs making 1 call to strict::import |
4 | 3 | 42µs | 2 | 90µs | # spent 51µs (12+39) within Class::ISA::BEGIN@4 which was called
# once (12µs+39µs) by DateTime::Locale::Base::BEGIN@6 at line 4 # spent 51µs making 1 call to Class::ISA::BEGIN@4
# spent 39µs making 1 call to vars::import |
5 | 1 | 400ns | $VERSION = '0.36'; | ||
6 | 1 | 300ns | $Debug = 0 unless defined $Debug; | ||
7 | |||||
8 | 3 | 32µs | 2 | 33µs | # spent 26µs (16+10) within Class::ISA::BEGIN@8 which was called
# once (16µs+10µs) by DateTime::Locale::Base::BEGIN@6 at line 8 # spent 26µs making 1 call to Class::ISA::BEGIN@8
# spent 6µs making 1 call to if::import |
9 | |||||
10 | ########################################################################### | ||||
11 | |||||
12 | sub self_and_super_versions { | ||||
13 | 3 | 163µs | 2 | 35µs | # spent 22µs (9+13) within Class::ISA::BEGIN@13 which was called
# once (9µs+13µs) by DateTime::Locale::Base::BEGIN@6 at line 13 # spent 22µs making 1 call to Class::ISA::BEGIN@13
# spent 13µs making 1 call to strict::unimport |
14 | map { | ||||
15 | $_ => (defined(${"$_\::VERSION"}) ? ${"$_\::VERSION"} : undef) | ||||
16 | } self_and_super_path($_[0]) | ||||
17 | } | ||||
18 | |||||
19 | # Also consider magic like: | ||||
20 | # no strict 'refs'; | ||||
21 | # my %class2SomeHashr = | ||||
22 | # map { defined(%{"$_\::SomeHash"}) ? ($_ => \%{"$_\::SomeHash"}) : () } | ||||
23 | # Class::ISA::self_and_super_path($class); | ||||
24 | # to get a hash of refs to all the defined (and non-empty) hashes in | ||||
25 | # $class and its superclasses. | ||||
26 | # | ||||
27 | # Or even consider this incantation for doing something like hash-data | ||||
28 | # inheritance: | ||||
29 | # no strict 'refs'; | ||||
30 | # %union_hash = | ||||
31 | # map { defined(%{"$_\::SomeHash"}) ? %{"$_\::SomeHash"}) : () } | ||||
32 | # reverse(Class::ISA::self_and_super_path($class)); | ||||
33 | # Consider that reverse() is necessary because with | ||||
34 | # %foo = ('a', 'wun', 'b', 'tiw', 'a', 'foist'); | ||||
35 | # $foo{'a'} is 'foist', not 'wun'. | ||||
36 | |||||
37 | ########################################################################### | ||||
38 | sub super_path { | ||||
39 | my @ret = &self_and_super_path(@_); | ||||
40 | shift @ret if @ret; | ||||
41 | return @ret; | ||||
42 | } | ||||
43 | |||||
44 | #-------------------------------------------------------------------------- | ||||
45 | sub self_and_super_path { | ||||
46 | # Assumption: searching is depth-first. | ||||
47 | # Assumption: '' (empty string) can't be a class package name. | ||||
48 | # Note: 'UNIVERSAL' is not given any special treatment. | ||||
49 | return () unless @_; | ||||
50 | |||||
51 | my @out = (); | ||||
52 | |||||
53 | my @in_stack = ($_[0]); | ||||
54 | my %seen = ($_[0] => 1); | ||||
55 | |||||
56 | my $current; | ||||
57 | while(@in_stack) { | ||||
58 | next unless defined($current = shift @in_stack) && length($current); | ||||
59 | print "At $current\n" if $Debug; | ||||
60 | push @out, $current; | ||||
61 | 3 | 89µs | 2 | 30µs | # spent 19µs (7+11) within Class::ISA::BEGIN@61 which was called
# once (7µs+11µs) by DateTime::Locale::Base::BEGIN@6 at line 61 # spent 19µs making 1 call to Class::ISA::BEGIN@61
# spent 11µs making 1 call to strict::unimport |
62 | unshift @in_stack, | ||||
63 | map | ||||
64 | { my $c = $_; # copy, to avoid being destructive | ||||
65 | substr($c,0,2) = "main::" if substr($c,0,2) eq '::'; | ||||
66 | # Canonize the :: -> main::, ::foo -> main::foo thing. | ||||
67 | # Should I ever canonize the Foo'Bar = Foo::Bar thing? | ||||
68 | $seen{$c}++ ? () : $c; | ||||
69 | } | ||||
70 | @{"$current\::ISA"} | ||||
71 | ; | ||||
72 | # I.e., if this class has any parents (at least, ones I've never seen | ||||
73 | # before), push them, in order, onto the stack of classes I need to | ||||
74 | # explore. | ||||
75 | } | ||||
76 | |||||
77 | return @out; | ||||
78 | } | ||||
79 | #-------------------------------------------------------------------------- | ||||
80 | 1 | 5µs | 1; | ||
81 | |||||
82 | __END__ | ||||
83 | |||||
84 | =head1 NAME | ||||
85 | |||||
86 | Class::ISA - report the search path for a class's ISA tree | ||||
87 | |||||
88 | =head1 SYNOPSIS | ||||
89 | |||||
90 | # Suppose you go: use Food::Fishstick, and that uses and | ||||
91 | # inherits from other things, which in turn use and inherit | ||||
92 | # from other things. And suppose, for sake of brevity of | ||||
93 | # example, that their ISA tree is the same as: | ||||
94 | |||||
95 | @Food::Fishstick::ISA = qw(Food::Fish Life::Fungus Chemicals); | ||||
96 | @Food::Fish::ISA = qw(Food); | ||||
97 | @Food::ISA = qw(Matter); | ||||
98 | @Life::Fungus::ISA = qw(Life); | ||||
99 | @Chemicals::ISA = qw(Matter); | ||||
100 | @Life::ISA = qw(Matter); | ||||
101 | @Matter::ISA = qw(); | ||||
102 | |||||
103 | use Class::ISA; | ||||
104 | print "Food::Fishstick path is:\n ", | ||||
105 | join(", ", Class::ISA::super_path('Food::Fishstick')), | ||||
106 | "\n"; | ||||
107 | |||||
108 | That prints: | ||||
109 | |||||
110 | Food::Fishstick path is: | ||||
111 | Food::Fish, Food, Matter, Life::Fungus, Life, Chemicals | ||||
112 | |||||
113 | =head1 DESCRIPTION | ||||
114 | |||||
115 | Suppose you have a class (like Food::Fish::Fishstick) that is derived, | ||||
116 | via its @ISA, from one or more superclasses (as Food::Fish::Fishstick | ||||
117 | is from Food::Fish, Life::Fungus, and Chemicals), and some of those | ||||
118 | superclasses may themselves each be derived, via its @ISA, from one or | ||||
119 | more superclasses (as above). | ||||
120 | |||||
121 | When, then, you call a method in that class ($fishstick->calories), | ||||
122 | Perl first searches there for that method, but if it's not there, it | ||||
123 | goes searching in its superclasses, and so on, in a depth-first (or | ||||
124 | maybe "height-first" is the word) search. In the above example, it'd | ||||
125 | first look in Food::Fish, then Food, then Matter, then Life::Fungus, | ||||
126 | then Life, then Chemicals. | ||||
127 | |||||
128 | This library, Class::ISA, provides functions that return that list -- | ||||
129 | the list (in order) of names of classes Perl would search to find a | ||||
130 | method, with no duplicates. | ||||
131 | |||||
132 | =head1 FUNCTIONS | ||||
133 | |||||
134 | =over | ||||
135 | |||||
136 | =item the function Class::ISA::super_path($CLASS) | ||||
137 | |||||
138 | This returns the ordered list of names of classes that Perl would | ||||
139 | search thru in order to find a method, with no duplicates in the list. | ||||
140 | $CLASS is not included in the list. UNIVERSAL is not included -- if | ||||
141 | you need to consider it, add it to the end. | ||||
142 | |||||
143 | |||||
144 | =item the function Class::ISA::self_and_super_path($CLASS) | ||||
145 | |||||
146 | Just like C<super_path>, except that $CLASS is included as the first | ||||
147 | element. | ||||
148 | |||||
149 | =item the function Class::ISA::self_and_super_versions($CLASS) | ||||
150 | |||||
151 | This returns a hash whose keys are $CLASS and its | ||||
152 | (super-)superclasses, and whose values are the contents of each | ||||
153 | class's $VERSION (or undef, for classes with no $VERSION). | ||||
154 | |||||
155 | The code for self_and_super_versions is meant to serve as an example | ||||
156 | for precisely the kind of tasks I anticipate that self_and_super_path | ||||
157 | and super_path will be used for. You are strongly advised to read the | ||||
158 | source for self_and_super_versions, and the comments there. | ||||
159 | |||||
160 | =back | ||||
161 | |||||
162 | =head1 CAUTIONARY NOTES | ||||
163 | |||||
164 | * Class::ISA doesn't export anything. You have to address the | ||||
165 | functions with a "Class::ISA::" on the front. | ||||
166 | |||||
167 | * Contrary to its name, Class::ISA isn't a class; it's just a package. | ||||
168 | Strange, isn't it? | ||||
169 | |||||
170 | * Say you have a loop in the ISA tree of the class you're calling one | ||||
171 | of the Class::ISA functions on: say that Food inherits from Matter, | ||||
172 | but Matter inherits from Food (for sake of argument). If Perl, while | ||||
173 | searching for a method, actually discovers this cyclicity, it will | ||||
174 | throw a fatal error. The functions in Class::ISA effectively ignore | ||||
175 | this cyclicity; the Class::ISA algorithm is "never go down the same | ||||
176 | path twice", and cyclicities are just a special case of that. | ||||
177 | |||||
178 | * The Class::ISA functions just look at @ISAs. But theoretically, I | ||||
179 | suppose, AUTOLOADs could bypass Perl's ISA-based search mechanism and | ||||
180 | do whatever they please. That would be bad behavior, tho; and I try | ||||
181 | not to think about that. | ||||
182 | |||||
183 | * If Perl can't find a method anywhere in the ISA tree, it then looks | ||||
184 | in the magical class UNIVERSAL. This is rarely relevant to the tasks | ||||
185 | that I expect Class::ISA functions to be put to, but if it matters to | ||||
186 | you, then instead of this: | ||||
187 | |||||
188 | @supers = Class::Tree::super_path($class); | ||||
189 | |||||
190 | do this: | ||||
191 | |||||
192 | @supers = (Class::Tree::super_path($class), 'UNIVERSAL'); | ||||
193 | |||||
194 | And don't say no-one ever told ya! | ||||
195 | |||||
196 | * When you call them, the Class::ISA functions look at @ISAs anew -- | ||||
197 | that is, there is no memoization, and so if ISAs change during | ||||
198 | runtime, you get the current ISA tree's path, not anything memoized. | ||||
199 | However, changing ISAs at runtime is probably a sign that you're out | ||||
200 | of your mind! | ||||
201 | |||||
202 | =head1 COPYRIGHT AND LICENSE | ||||
203 | |||||
204 | Copyright (c) 1999-2009 Sean M. Burke. All rights reserved. | ||||
205 | |||||
206 | This library is free software; you can redistribute it and/or modify | ||||
207 | it under the same terms as Perl itself. | ||||
208 | |||||
209 | =head1 AUTHOR | ||||
210 | |||||
211 | Sean M. Burke C<sburke@cpan.org> | ||||
212 | |||||
213 | =head1 MAINTAINER | ||||
214 | |||||
215 | Maintained by Steffen Mueller C<smueller@cpan.org>. | ||||
216 | |||||
217 | =cut | ||||
218 |