| 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 | Class::ISA::BEGIN@8 |
| 1 | 1 | 1 | 13µs | 15µs | Class::ISA::BEGIN@3 |
| 1 | 1 | 1 | 12µs | 51µs | Class::ISA::BEGIN@4 |
| 1 | 1 | 1 | 9µs | 22µs | Class::ISA::BEGIN@13 |
| 1 | 1 | 1 | 7µs | 19µs | Class::ISA::BEGIN@61 |
| 0 | 0 | 0 | 0s | 0s | Class::ISA::self_and_super_path |
| 0 | 0 | 0 | 0s | 0s | Class::ISA::self_and_super_versions |
| 0 | 0 | 0 | 0s | 0s | Class::ISA::super_path |
| 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 |