lib/Class/ISA.pm

#!/usr/local/bin/perl
# Time-stamp: "2004-12-29 20:01:02 AST" -*-Perl-*-

package Class::ISA;
require 5;
use strict;
use vars qw($Debug $VERSION);
$VERSION = '0.33';
$Debug = 0 unless defined $Debug;

=head1 NAME

Class::ISA -- report the search path for a class's ISA tree

=head1 SYNOPSIS

  # Suppose you go: use Food::Fishstick, and that uses and
  # inherits from other things, which in turn use and inherit
  # from other things.  And suppose, for sake of brevity of
  # example, that their ISA tree is the same as:

  @Food::Fishstick::ISA = qw(Food::Fish  Life::Fungus  Chemicals);
  @Food::Fish::ISA = qw(Food);
  @Food::ISA = qw(Matter);
  @Life::Fungus::ISA = qw(Life);
  @Chemicals::ISA = qw(Matter);
  @Life::ISA = qw(Matter);
  @Matter::ISA = qw();

  use Class::ISA;
  print "Food::Fishstick path is:\n ",
        join(", ", Class::ISA::super_path('Food::Fishstick')),
        "\n";

That prints:

  Food::Fishstick path is:
   Food::Fish, Food, Matter, Life::Fungus, Life, Chemicals

=head1 DESCRIPTION

Suppose you have a class (like Food::Fish::Fishstick) that is derived,
via its @ISA, from one or more superclasses (as Food::Fish::Fishstick
is from Food::Fish, Life::Fungus, and Chemicals), and some of those
superclasses may themselves each be derived, via its @ISA, from one or
more superclasses (as above).

When, then, you call a method in that class ($fishstick->calories),
Perl first searches there for that method, but if it's not there, it
goes searching in its superclasses, and so on, in a depth-first (or
maybe "height-first" is the word) search.  In the above example, it'd
first look in Food::Fish, then Food, then Matter, then Life::Fungus,
then Life, then Chemicals.

This library, Class::ISA, provides functions that return that list --
the list (in order) of names of classes Perl would search to find a
method, with no duplicates.

=head1 FUNCTIONS

=over

=item the function Class::ISA::super_path($CLASS)

This returns the ordered list of names of classes that Perl would
search thru in order to find a method, with no duplicates in the list.
$CLASS is not included in the list.  UNIVERSAL is not included -- if
you need to consider it, add it to the end.


=item the function Class::ISA::self_and_super_path($CLASS)

Just like C<super_path>, except that $CLASS is included as the first
element.

=item the function Class::ISA::self_and_super_versions($CLASS)

This returns a hash whose keys are $CLASS and its
(super-)superclasses, and whose values are the contents of each
class's $VERSION (or undef, for classes with no $VERSION).

The code for self_and_super_versions is meant to serve as an example
for precisely the kind of tasks I anticipate that self_and_super_path
and super_path will be used for.  You are strongly advised to read the
source for self_and_super_versions, and the comments there.

=back

=head1 CAUTIONARY NOTES

* Class::ISA doesn't export anything.  You have to address the
functions with a "Class::ISA::" on the front.

* Contrary to its name, Class::ISA isn't a class; it's just a package.
Strange, isn't it?

* Say you have a loop in the ISA tree of the class you're calling one
of the Class::ISA functions on: say that Food inherits from Matter,
but Matter inherits from Food (for sake of argument).  If Perl, while
searching for a method, actually discovers this cyclicity, it will
throw a fatal error.  The functions in Class::ISA effectively ignore
this cyclicity; the Class::ISA algorithm is "never go down the same
path twice", and cyclicities are just a special case of that.

* The Class::ISA functions just look at @ISAs.  But theoretically, I
suppose, AUTOLOADs could bypass Perl's ISA-based search mechanism and
do whatever they please.  That would be bad behavior, tho; and I try
not to think about that.

* If Perl can't find a method anywhere in the ISA tree, it then looks
in the magical class UNIVERSAL.  This is rarely relevant to the tasks
that I expect Class::ISA functions to be put to, but if it matters to
you, then instead of this:

  @supers = Class::Tree::super_path($class);

do this:

  @supers = (Class::Tree::super_path($class), 'UNIVERSAL');

And don't say no-one ever told ya!

* When you call them, the Class::ISA functions look at @ISAs anew --
that is, there is no memoization, and so if ISAs change during
runtime, you get the current ISA tree's path, not anything memoized.
However, changing ISAs at runtime is probably a sign that you're out
of your mind!

=head1 COPYRIGHT

Copyright (c) 1999, 2000 Sean M. Burke. All rights reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

Sean M. Burke C<sburke@cpan.org>

=cut

###########################################################################

sub self_and_super_versions {
  no strict 'refs';
  map {
        $_ => (defined(${"$_\::VERSION"}) ? ${"$_\::VERSION"} : undef)
      } self_and_super_path($_[0])
}

# Also consider magic like:
#   no strict 'refs';
#   my %class2SomeHashr =
#     map { defined(%{"$_\::SomeHash"}) ? ($_ => \%{"$_\::SomeHash"}) : () }
#         Class::ISA::self_and_super_path($class);
# to get a hash of refs to all the defined (and non-empty) hashes in
# $class and its superclasses.
#
# Or even consider this incantation for doing something like hash-data
# inheritance:
#   no strict 'refs';
#   %union_hash = 
#     map { defined(%{"$_\::SomeHash"}) ? %{"$_\::SomeHash"}) : () }
#         reverse(Class::ISA::self_and_super_path($class));
# Consider that reverse() is necessary because with
#   %foo = ('a', 'wun', 'b', 'tiw', 'a', 'foist');
# $foo{'a'} is 'foist', not 'wun'.

###########################################################################
sub super_path {
  my @ret = &self_and_super_path(@_);
  shift @ret if @ret;
  return @ret;
}

#--------------------------------------------------------------------------
sub self_and_super_path {
  # Assumption: searching is depth-first.
  # Assumption: '' (empty string) can't be a class package name.
  # Note: 'UNIVERSAL' is not given any special treatment.
  return () unless @_;

  my @out = ();

  my @in_stack = ($_[0]);
  my %seen = ($_[0] => 1);

  my $current;
  while(@in_stack) {
    next unless defined($current = shift @in_stack) && length($current);
    print "At $current\n" if $Debug;
    push @out, $current;
    no strict 'refs';
    unshift @in_stack,
      map
        { my $c = $_; # copy, to avoid being destructive
          substr($c,0,2) = "main::" if substr($c,0,2) eq '::';
           # Canonize the :: -> main::, ::foo -> main::foo thing.
           # Should I ever canonize the Foo'Bar = Foo::Bar thing? 
          $seen{$c}++ ? () : $c;
        }
        @{"$current\::ISA"}
    ;
    # I.e., if this class has any parents (at least, ones I've never seen
    # before), push them, in order, onto the stack of classes I need to
    # explore.
  }

  return @out;
}
#--------------------------------------------------------------------------
1;

__END__
Revision:	1.1
Committed:	Thu Jun 30 14:27:10 2005 UTC (21 years, 4 months ago) by root
Branch:	MAIN
CVS Tags:	PERL-5-8-7, HEAD
Branch point for:	PERL
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.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__