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