cpan/Class-ISA/lib/Class/ISA.pm

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