From: Steffen Mueller Date: Tue, 22 Sep 2009 11:52:20 +0000 (+0200) Subject: Upgrade to Class::ISA 0.34 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=50b1421987f46bcd844d19a6aac30e5edc340ca8;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Class::ISA 0.34 --- diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 8524b1a..0ba03e2 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -316,7 +316,7 @@ use File::Glob qw(:case); 'Class::ISA' => { 'MAINTAINER' => 'smueller', - 'DISTRIBUTION' => 'SBURKE/Class-ISA-0.33.tar.gz', + 'DISTRIBUTION' => 'SMUELLER/Class-ISA-0.34.tar.gz', 'FILES' => q[ext/Class-ISA], 'CPAN' => 1, 'UPSTREAM' => 'cpan', diff --git a/ext/Class-ISA/ChangeLog b/ext/Class-ISA/ChangeLog index ac18541..4fdc331 100644 --- a/ext/Class-ISA/ChangeLog +++ b/ext/Class-ISA/ChangeLog @@ -1,6 +1,11 @@ Revision history for Perl extension Class::ISA Time-stamp: "2004-12-29 20:00:49 AST" +2009-10-22 Steffen Mueller smueller@cpan.org + + * Release 0.34 -- add core deprecation logic, + some distribution shuffling. No code changes. + 2004-12-29 Sean M. Burke sburke@cpan.org * Release 0.33 -- just rebundling. No code changes. diff --git a/ext/Class-ISA/lib/Class/ISA.pm b/ext/Class-ISA/lib/Class/ISA.pm index d25da58..b5090cf 100644 --- a/ext/Class-ISA/lib/Class/ISA.pm +++ b/ext/Class-ISA/lib/Class/ISA.pm @@ -1,15 +1,86 @@ -#!/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_01'; +$VERSION = '0.34'; $Debug = 0 unless defined $Debug; use if $] >= 5.011, 'deprecate'; +########################################################################### + +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__ + =head1 NAME Class::ISA -- report the search path for a class's ISA tree @@ -128,9 +199,9 @@ 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 +=head1 COPYRIGHT AND LICENSE -Copyright (c) 1999, 2000 Sean M. Burke. All rights reserved. +Copyright (c) 1999-2009 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. @@ -139,78 +210,9 @@ it under the same terms as Perl itself. Sean M. Burke C -=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 = (); +=head1 MAINTAINER - my @in_stack = ($_[0]); - my %seen = ($_[0] => 1); +Maintained by Steffen Mueller C. - 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; +=cut -__END__