diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Devel/InnerPackage.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Devel/InnerPackage.pm | 129 |
1 files changed, 0 insertions, 129 deletions
diff --git a/Master/tlpkg/tlperl/lib/Devel/InnerPackage.pm b/Master/tlpkg/tlperl/lib/Devel/InnerPackage.pm deleted file mode 100644 index cf285693e2f..00000000000 --- a/Master/tlpkg/tlperl/lib/Devel/InnerPackage.pm +++ /dev/null @@ -1,129 +0,0 @@ -package Devel::InnerPackage; - -use strict; -use base qw(Exporter); -use vars qw($VERSION @EXPORT_OK); - -use if $] > 5.017, 'deprecate'; - -$VERSION = '0.4'; -@EXPORT_OK = qw(list_packages); - -=pod - -=head1 NAME - -Devel::InnerPackage - find all the inner packages of a package - -=head1 SYNOPSIS - - use Foo::Bar; - use Devel::InnerPackage qw(list_packages); - - my @inner_packages = list_packages('Foo::Bar'); - - -=head1 DESCRIPTION - - -Given a file like this - - - package Foo::Bar; - - sub foo {} - - - package Foo::Bar::Quux; - - sub quux {} - - package Foo::Bar::Quirka; - - sub quirka {} - - 1; - -then - - list_packages('Foo::Bar'); - -will return - - Foo::Bar::Quux - Foo::Bar::Quirka - -=head1 METHODS - -=head2 list_packages <package name> - -Return a list of all inner packages of that package. - -=cut - -sub list_packages { - my $pack = shift; $pack .= "::" unless $pack =~ m!::$!; - - no strict 'refs'; - my @packs; - my @stuff = grep !/^(main|)::$/, keys %{$pack}; - for my $cand (grep /::$/, @stuff) - { - $cand =~ s!::$!!; - my @children = list_packages($pack.$cand); - - push @packs, "$pack$cand" unless $cand =~ /^::/ || - !__PACKAGE__->_loaded($pack.$cand); # or @children; - push @packs, @children; - } - return grep {$_ !~ /::(::ISA::CACHE|SUPER)/} @packs; -} - -### XXX this is an inlining of the Class-Inspector->loaded() -### method, but inlined to remove the dependency. -sub _loaded { - my ($class, $name) = @_; - - no strict 'refs'; - - # Handle by far the two most common cases - # This is very fast and handles 99% of cases. - return 1 if defined ${"${name}::VERSION"}; - return 1 if @{"${name}::ISA"}; - - # Are there any symbol table entries other than other namespaces - foreach ( keys %{"${name}::"} ) { - next if substr($_, -2, 2) eq '::'; - return 1 if defined &{"${name}::$_"}; - } - - # No functions, and it doesn't have a version, and isn't anything. - # As an absolute last resort, check for an entry in %INC - my $filename = join( '/', split /(?:'|::)/, $name ) . '.pm'; - return 1 if defined $INC{$filename}; - - ''; -} - - -=head1 AUTHOR - -Simon Wistow <simon@thegestalt.org> - -=head1 COPYING - -Copyright, 2005 Simon Wistow - -Distributed under the same terms as Perl itself. - -=head1 BUGS - -None known. - -=cut - - - - - -1; |