1#!/usr/local/bin/perl 2# Time-stamp: "2000-05-13 20:03:22 MDT" -*-Perl-*- 3 4package Class::ISA; 5require 5; 6use strict; 7use vars qw($Debug $VERSION); 8$VERSION = 0.32; 9$Debug = 0 unless defined $Debug; 10 11=head1 NAME 12 13Class::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 35That prints: 36 37 Food::Fishstick path is: 38 Food::Fish, Food, Matter, Life::Fungus, Life, Chemicals 39 40=head1 DESCRIPTION 41 42Suppose you have a class (like Food::Fish::Fishstick) that is derived, 43via its @ISA, from one or more superclasses (as Food::Fish::Fishstick 44is from Food::Fish, Life::Fungus, and Chemicals), and some of those 45superclasses may themselves each be derived, via its @ISA, from one or 46more superclasses (as above). 47 48When, then, you call a method in that class ($fishstick->calories), 49Perl first searches there for that method, but if it's not there, it 50goes searching in its superclasses, and so on, in a depth-first (or 51maybe "height-first" is the word) search. In the above example, it'd 52first look in Food::Fish, then Food, then Matter, then Life::Fungus, 53then Life, then Chemicals. 54 55This library, Class::ISA, provides functions that return that list -- 56the list (in order) of names of classes Perl would search to find a 57method, with no duplicates. 58 59=head1 FUNCTIONS 60 61=over 62 63=item the function Class::ISA::super_path($CLASS) 64 65This returns the ordered list of names of classes that Perl would 66search 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 68you need to consider it, add it to the end. 69 70 71=item the function Class::ISA::self_and_super_path($CLASS) 72 73Just like C<super_path>, except that $CLASS is included as the first 74element. 75 76=item the function Class::ISA::self_and_super_versions($CLASS) 77 78This returns a hash whose keys are $CLASS and its 79(super-)superclasses, and whose values are the contents of each 80class's $VERSION (or undef, for classes with no $VERSION). 81 82The code for self_and_super_versions is meant to serve as an example 83for precisely the kind of tasks I anticipate that self_and_super_path 84and super_path will be used for. You are strongly advised to read the 85source 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 92functions with a "Class::ISA::" on the front. 93 94* Contrary to its name, Class::ISA isn't a class; it's just a package. 95Strange, isn't it? 96 97* Say you have a loop in the ISA tree of the class you're calling one 98of the Class::ISA functions on: say that Food inherits from Matter, 99but Matter inherits from Food (for sake of argument). If Perl, while 100searching for a method, actually discovers this cyclicity, it will 101throw a fatal error. The functions in Class::ISA effectively ignore 102this cyclicity; the Class::ISA algorithm is "never go down the same 103path twice", and cyclicities are just a special case of that. 104 105* The Class::ISA functions just look at @ISAs. But theoretically, I 106suppose, AUTOLOADs could bypass Perl's ISA-based search mechanism and 107do whatever they please. That would be bad behavior, tho; and I try 108not to think about that. 109 110* If Perl can't find a method anywhere in the ISA tree, it then looks 111in the magical class UNIVERSAL. This is rarely relevant to the tasks 112that I expect Class::ISA functions to be put to, but if it matters to 113you, then instead of this: 114 115 @supers = Class::Tree::super_path($class); 116 117do this: 118 119 @supers = (Class::Tree::super_path($class), 'UNIVERSAL'); 120 121And don't say no-one ever told ya! 122 123* When you call them, the Class::ISA functions look at @ISAs anew -- 124that is, there is no memoization, and so if ISAs change during 125runtime, you get the current ISA tree's path, not anything memoized. 126However, changing ISAs at runtime is probably a sign that you're out 127of your mind! 128 129=head1 COPYRIGHT 130 131Copyright (c) 1999, 2000 Sean M. Burke. All rights reserved. 132 133This library is free software; you can redistribute it and/or modify 134it under the same terms as Perl itself. 135 136=head1 AUTHOR 137 138Sean M. Burke C<sburke@cpan.org> 139 140=cut 141 142########################################################################### 143 144sub 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########################################################################### 170sub super_path { 171 my @ret = &self_and_super_path(@_); 172 shift @ret if @ret; 173 return @ret; 174} 175 176#-------------------------------------------------------------------------- 177sub 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#-------------------------------------------------------------------------- 2121; 213 214__END__ 215