diff options
author | Chris Williams <chris@bingosnet.co.uk> | 2009-09-12 17:56:33 +0100 |
---|---|---|
committer | Chris Williams <chris@bingosnet.co.uk> | 2009-09-12 17:56:33 +0100 |
commit | 2451603626893a501c9436409c4aa7e19932c987 (patch) | |
tree | aa8ef92c973bd4113f55ec03514ed374bb5e1279 /lib | |
parent | 97a70a1d348306d3a2e80c4ed8a9b54784b92227 (diff) | |
download | perl-2451603626893a501c9436409c4aa7e19932c987.tar.gz |
Moved Class-ISA from lib/ to ext/
Diffstat (limited to 'lib')
-rw-r--r-- | lib/.gitignore | 1 | ||||
-rw-r--r-- | lib/Class/ISA.pm | 214 | ||||
-rw-r--r-- | lib/Class/ISA/ChangeLog | 24 | ||||
-rw-r--r-- | lib/Class/ISA/t/00_about_verbose.t | 89 | ||||
-rw-r--r-- | lib/Class/ISA/t/01_old_junk.t | 28 |
5 files changed, 1 insertions, 355 deletions
diff --git a/lib/.gitignore b/lib/.gitignore index 9b761c7ded..be06fddce9 100644 --- a/lib/.gitignore +++ b/lib/.gitignore @@ -20,6 +20,7 @@ /Config_git.pl /CGI /CGI.pm +/Class/ISA.pm /CPAN.pm /CPAN /CPAN/API diff --git a/lib/Class/ISA.pm b/lib/Class/ISA.pm deleted file mode 100644 index e1371912e2..0000000000 --- a/lib/Class/ISA.pm +++ /dev/null @@ -1,214 +0,0 @@ -#!/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__ diff --git a/lib/Class/ISA/ChangeLog b/lib/Class/ISA/ChangeLog deleted file mode 100644 index ac18541b1e..0000000000 --- a/lib/Class/ISA/ChangeLog +++ /dev/null @@ -1,24 +0,0 @@ -Revision history for Perl extension Class::ISA - Time-stamp: "2004-12-29 20:00:49 AST" - -2004-12-29 Sean M. Burke sburke@cpan.org - - * Release 0.33 -- just rebundling. No code changes. - - -2000-05-13 Sean M. Burke sburke@cpan.org - - * Release 0.32 -- Just noting my new email address. - - -1999-05-14 Sean M. Burke sburke@netadventure.net - - * Release 0.31 -- release version. - - No changes in functionality -- just changed the core algorithm to - something that should behave the same, but is cleaner and faster. - - -1999-01-23 Sean M. Burke sburke@netadventure.net - - * Release 0.20 -- first release version. diff --git a/lib/Class/ISA/t/00_about_verbose.t b/lib/Class/ISA/t/00_about_verbose.t deleted file mode 100644 index edc3023f84..0000000000 --- a/lib/Class/ISA/t/00_about_verbose.t +++ /dev/null @@ -1,89 +0,0 @@ -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -require 5; -# Time-stamp: "2004-12-29 20:57:15 AST" -# Summary of, well, things. - -use Test; -BEGIN {plan tests => 2}; -ok 1; - -use Class::ISA (); - -#chdir "t" if -e "t"; - -{ - my @out; - push @out, - "\n\nPerl v", - defined($^V) ? sprintf('%vd', $^V) : $], - " under $^O ", - (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber()) - ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (), - (defined $MacPerl::Version) - ? ("(MacPerl version $MacPerl::Version)") : (), - "\n" - ; - - # Ugly code to walk the symbol tables: - my %v; - my @stack = (''); # start out in %:: - my $this; - my $count = 0; - my $pref; - while(@stack) { - $this = shift @stack; - die "Too many packages?" if ++$count > 1000; - next if exists $v{$this}; - next if $this eq 'main'; # %main:: is %:: - - #print "Peeking at $this => ${$this . '::VERSION'}\n"; - - if(defined ${$this . '::VERSION'} ) { - $v{$this} = ${$this . '::VERSION'} - } elsif( - defined *{$this . '::ISA'} or defined &{$this . '::import'} - or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"}) - # If it has an ISA, an import, or any subs... - ) { - # It's a class/module with no version. - $v{$this} = undef; - } else { - # It's probably an unpopulated package. - ## $v{$this} = '...'; - } - - $pref = length($this) ? "$this\::" : ''; - push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'}; - #print "Stack: @stack\n"; - } - push @out, " Modules in memory:\n"; - delete @v{'', '[none]'}; - foreach my $p (sort {lc($a) cmp lc($b)} keys %v) { - $indent = ' ' x (2 + ($p =~ tr/:/:/)); - push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n"; - } - push @out, sprintf "[at %s (local) / %s (GMT)]\n", - scalar(gmtime), scalar(localtime); - my $x = join '', @out; - $x =~ s/^/#/mg; - print $x; -} - -print "# Running", - (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n", - "#\n", -; - -print "# \@INC:\n", map("# [$_]\n", @INC), "#\n#\n"; - -print "# \%INC:\n"; -foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) { - print "# [$x] = [", $INC{$x} || '', "]\n"; -} - -ok 1; - diff --git a/lib/Class/ISA/t/01_old_junk.t b/lib/Class/ISA/t/01_old_junk.t deleted file mode 100644 index 8afe373cd2..0000000000 --- a/lib/Class/ISA/t/01_old_junk.t +++ /dev/null @@ -1,28 +0,0 @@ -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -# Time-stamp: "2004-12-29 19:59:33 AST" - -BEGIN { $| = 1; print "1..2\n"; } -END {print "not ok 1\n" unless $loaded;} -use Class::ISA; -$loaded = 1; -print "ok 1\n"; - - @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; - my @path = Class::ISA::super_path('Food::Fishstick'); - my $flat_path = join ' ', @path; - print "#Food::Fishstick path is:\n# $flat_path\n"; - print - "Food::Fish Food Matter Life::Fungus Life Chemicals" eq $flat_path ? - "ok 2\n" : "fail 2!\n"; |