1 | #!/usr/local/bin/perl
|
---|
2 | # Time-stamp: "2004-12-29 20:01:02 AST" -*-Perl-*-
|
---|
3 |
|
---|
4 | package Class::ISA;
|
---|
5 | require 5;
|
---|
6 | use strict;
|
---|
7 | use vars qw($Debug $VERSION);
|
---|
8 | $VERSION = '0.33';
|
---|
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<[email protected]>
|
---|
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__
|
---|