home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _b7be6b077f75556febe925c3e7687bf3 < prev    next >
Text File  |  2004-06-01  |  7KB  |  215 lines
  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__
  215.