[Summary view] [Print] [Text view]

   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__