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