RE: Untested libraries update
[p5sagit/p5-mst-13.2.git] / lib / Class / ISA.pm
1 #!/usr/local/bin/perl
2 # Time-stamp: "2000-05-13 20:03:22 MDT" -*-Perl-*-
3
4 package Class::ISA;
5 require 5;
6 use strict;
7 use vars qw($Debug $VERSION);
8 $VERSION = 0.32;
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__