lib/Class/ISA.pm

   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__