| 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<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__ |