Devel-Symdump-2.11/0000755000175000017500000000000012234126212011371 5ustar kkDevel-Symdump-2.11/lib/0000755000175000017500000000000012234126204012140 5ustar kkDevel-Symdump-2.11/lib/Devel/0000755000175000017500000000000012234126204013177 5ustar kkDevel-Symdump-2.11/lib/Devel/Symdump.pm0000644000175000017500000003022412234123025015172 0ustar kkpackage Devel::Symdump; use 5.003; use Carp (); use strict; use vars qw($Defaults $VERSION *ENTRY $MAX_RECURSION); $VERSION = '2.11'; $MAX_RECURSION = 97; $Defaults = { 'RECURS' => 0, 'AUTOLOAD' => { 'packages' => 1, 'scalars' => 1, 'arrays' => 1, 'hashes' => 1, 'functions' => 1, 'ios' => 1, 'unknowns' => 1, }, 'SEEN' => {}, }; sub rnew { my($class,@packages) = @_; no strict "refs"; my $self = bless {%${"$class\::Defaults"}}, $class; $self->{RECURS}++; $self->_doit(@packages); } sub new { my($class,@packages) = @_; no strict "refs"; my $self = bless {%${"$class\::Defaults"}}, $class; $self->_doit(@packages); } sub _doit { my($self,@packages) = @_; @packages = ("main") unless @packages; $self->{RESULT} = $self->_symdump(@packages); return $self; } sub _symdump { my($self,@packages) = @_ ; my($key,$val,$num,$pack,@todo,$tmp); my $result = {}; foreach $pack (@packages){ no strict; while (($key,$val) = each(%{*{"$pack\::"}})) { my $gotone = 0; local(*ENTRY) = $val; #### SCALAR #### if (defined $val && defined *ENTRY{SCALAR}) { $result->{$pack}{SCALARS}{$key}++; $gotone++; } #### ARRAY #### if (defined $val && defined *ENTRY{ARRAY}) { $result->{$pack}{ARRAYS}{$key}++; $gotone++; } #### HASH #### if (defined $val && defined *ENTRY{HASH} && $key !~ /::/) { $result->{$pack}{HASHES}{$key}++; $gotone++; } #### PACKAGE #### if (defined $val && defined *ENTRY{HASH} && $key =~ /::$/ && $key ne "main::" && $key ne "::") { my($p) = $pack ne "main" ? "$pack\::" : ""; ($p .= $key) =~ s/::$//; $result->{$pack}{PACKAGES}{$p}++; $gotone++; if (++$self->{SEEN}{*$val} > $Devel::Symdump::MAX_RECURSION){ next; } push @todo, $p; } #### FUNCTION #### if (defined $val && defined *ENTRY{CODE}) { $result->{$pack}{FUNCTIONS}{$key}++; $gotone++; } #### IO #### had to change after 5.003_10 if ($] > 5.003_10){ if (defined $val && defined *ENTRY{IO}){ # fileno and telldir... $result->{$pack}{IOS}{$key}++; $gotone++; } } else { #### FILEHANDLE #### if (defined fileno(ENTRY)){ $result->{$pack}{IOS}{$key}++; $gotone++; } elsif (defined telldir(ENTRY)){ #### DIRHANDLE #### $result->{$pack}{IOS}{$key}++; $gotone++; } } #### SOMETHING ELSE #### unless ($gotone) { $result->{$pack}{UNKNOWNS}{$key}++; } } } return (@todo && $self->{RECURS}) ? { %$result, %{$self->_symdump(@todo)} } : $result; } sub _partdump { my($self,$part)=@_; my ($pack, @result); my $prepend = ""; foreach $pack (keys %{$self->{RESULT}}){ $prepend = "$pack\::" unless $part eq 'PACKAGES'; push @result, map {"$prepend$_"} keys %{$self->{RESULT}{$pack}{$part} || {}}; } return @result; } # this is needed so we don't try to AUTOLOAD the DESTROY method sub DESTROY {} sub as_string { my $self = shift; my($type,@m); for $type (sort keys %{$self->{'AUTOLOAD'}}) { push @m, $type; push @m, "\t" . join "\n\t", map { s/([\000-\037\177])/ '^' . pack('c', ord($1) ^ 64) /eg; $_; } sort $self->_partdump(uc $type); } return join "\n", @m; } sub as_HTML { my $self = shift; my($type,@m); push @m, ""; for $type (sort keys %{$self->{'AUTOLOAD'}}) { push @m, ""; push @m, ""; } push @m, "
$type" . join ", ", map { s/([\000-\037\177])/ '^' . pack('c', ord($1) ^ 64) /eg; $_; } sort $self->_partdump(uc $type); push @m, "
"; return join "\n", @m; } sub diff { my($self,$second) = @_; my($type,@m); for $type (sort keys %{$self->{'AUTOLOAD'}}) { my(%first,%second,%all,$symbol); foreach $symbol ($self->_partdump(uc $type)){ $first{$symbol}++; $all{$symbol}++; } foreach $symbol ($second->_partdump(uc $type)){ $second{$symbol}++; $all{$symbol}++; } my(@typediff); foreach $symbol (sort keys %all){ next if $first{$symbol} && $second{$symbol}; push @typediff, "- $symbol" unless $second{$symbol}; push @typediff, "+ $symbol" unless $first{$symbol}; } foreach (@typediff) { s/([\000-\037\177])/ '^' . pack('c', ord($1) ^ 64) /eg; } push @m, $type, @typediff if @typediff; } return join "\n", @m; } sub inh_tree { my($self) = @_; return $self->{INHTREE} if ref $self && defined $self->{INHTREE}; my($inherited_by) = {}; my($m)=""; my(@isa) = grep /\bISA$/, Devel::Symdump->rnew->arrays; my $isa; foreach $isa (sort @isa) { $isa =~ s/::ISA$//; my($isaisa); no strict 'refs'; foreach $isaisa (@{"$isa\::ISA"}){ $inherited_by->{$isaisa}{$isa}++; } } my $item; foreach $item (sort keys %$inherited_by) { $m .= "$item\n"; $m .= _inh_tree($item,$inherited_by); } $self->{INHTREE} = $m if ref $self; $m; } sub _inh_tree { my($package,$href,$depth) = @_; return unless defined $href; $depth ||= 0; $depth++; if ($depth > 100){ warn "Deep recursion in ISA\n"; return; } my($m) = ""; # print "DEBUG: package[$package]depth[$depth]\n"; my $i; foreach $i (sort keys %{$href->{$package}}) { $m .= qq{\t} x $depth; $m .= qq{$i\n}; $m .= _inh_tree($i,$href,$depth); } $m; } sub isa_tree{ my($self) = @_; return $self->{ISATREE} if ref $self && defined $self->{ISATREE}; my(@isa) = grep /\bISA$/, Devel::Symdump->rnew->arrays; my($m) = ""; my($isa); foreach $isa (sort @isa) { $isa =~ s/::ISA$//; $m .= qq{$isa\n}; $m .= _isa_tree($isa) } $self->{ISATREE} = $m if ref $self; $m; } sub _isa_tree{ my($package,$depth) = @_; $depth ||= 0; $depth++; if ($depth > 100){ warn "Deep recursion in ISA\n"; return; } my($m) = ""; # print "DEBUG: package[$package]depth[$depth]\n"; my $isaisa; no strict 'refs'; foreach $isaisa (@{"$package\::ISA"}) { $m .= qq{\t} x $depth; $m .= qq{$isaisa\n}; $m .= _isa_tree($isaisa,$depth); } $m; } AUTOLOAD { my($self,@packages) = @_; unless (ref $self) { $self = $self->new(@packages); } no strict "vars"; (my $auto = $AUTOLOAD) =~ s/.*:://; $auto =~ s/(file|dir)handles/ios/; my $compat = $1; unless ($self->{'AUTOLOAD'}{$auto}) { Carp::croak("invalid Devel::Symdump method: $auto()"); } my @syms = $self->_partdump(uc $auto); if (defined $compat) { no strict 'refs'; local $^W; # bleadperl@26631 introduced an io warning here if ($compat eq "file") { @syms = grep { defined(fileno($_)) } @syms; } else { @syms = grep { defined(telldir($_)) } @syms; } } return @syms; # make sure now it gets context right } 1; __END__ =head1 NAME Devel::Symdump - dump symbol names or the symbol table =head1 SYNOPSIS # Constructor require Devel::Symdump; @packs = qw(some_package another_package); $obj = Devel::Symdump->new(@packs); # no recursion $obj = Devel::Symdump->rnew(@packs); # with recursion # Methods @array = $obj->packages; @array = $obj->scalars; @array = $obj->arrays; @array = $obj->hashes; @array = $obj->functions; @array = $obj->filehandles; # deprecated, use ios instead @array = $obj->dirhandles; # deprecated, use ios instead @array = $obj->ios; @array = $obj->unknowns; # only perl version < 5.003 had some $string = $obj->as_string; $string = $obj->as_HTML; $string = $obj1->diff($obj2); $string = Devel::Symdump->isa_tree; # or $obj->isa_tree $string = Devel::Symdump->inh_tree; # or $obj->inh_tree # Methods with autogenerated objects # all of those call new(@packs) internally @array = Devel::Symdump->packages(@packs); @array = Devel::Symdump->scalars(@packs); @array = Devel::Symdump->arrays(@packs); @array = Devel::Symdump->hashes(@packs); @array = Devel::Symdump->functions(@packs); @array = Devel::Symdump->ios(@packs); @array = Devel::Symdump->unknowns(@packs); =head1 DESCRIPTION This little package serves to access the symbol table of perl. =over 4 =item Crnew(@packages)> returns a symbol table object for all subtrees below @packages. Nested Modules are analyzed recursively. If no package is given as argument, it defaults to C
. That means to get the whole symbol table, just do a C without arguments. The global variable $Devel::Symdump::MAX_RECURSION limits the recursion to prevent contention. The default value is set to 97, just low enough to survive the test suite without a warning about deep recursion. =item Cnew(@packages)> does not go into recursion and only analyzes the packages that are given as arguments. =item packages, scalars, arrays, hashes, functions, ios The methods packages(), scalars(), arrays(), hashes(), functions(), ios(), and (for older perls) unknowns() each return an array of fully qualified symbols of the specified type in all packages that are held within a Devel::Symdump object, but without the leading C<$>, C<@> or C<%>. In a scalar context, they will return the number of such symbols. Unknown symbols are usually either formats or variables that haven't yet got a defined value. Note that scalar symbol table entries are a special case. If a symbol table entry exists at all, presence of a scalar is currently unknowable, due to a feature of Perl described in perlref "Making References" point 7. For example, this package will mark a scalar value C<$foo> as present if any of C<@foo>, C<%foo>, C<&foo> etc. have been declared or used. =item as_string =item as_HTML As_string() and as_HTML() return a simple string/HTML representations of the object. =item diff Diff() prints the difference between two Devel::Symdump objects in human readable form. The format is similar to the one used by the as_string method. =item isa_tree =item inh_tree Isa_tree() and inh_tree() both return a simple string representation of the current inheritance tree. The difference between the two methods is the direction from which the tree is viewed: top-down or bottom-up. As I'm sure, many users will have different expectation about what is top and what is bottom, I'll provide an example what happens when the Socket module is loaded: =item % print Devel::Symdump-Einh_tree AutoLoader DynaLoader Socket DynaLoader Socket Exporter Carp Config Socket The inh_tree method shows on the left hand side a package name and indented to the right the packages that use the former. =item % print Devel::Symdump-Eisa_tree Carp Exporter Config Exporter DynaLoader AutoLoader Socket Exporter DynaLoader AutoLoader The isa_tree method displays from left to right ISA relationships, so Socket IS A DynaLoader and DynaLoader IS A AutoLoader. (Actually, they were at the time this manpage was written) =back You may call both methods, isa_tree() and inh_tree(), with an object. If you do that, the object will store the output and retrieve it when you call the same method again later. The typical usage would be to use them as class methods directly though. =head1 SUBCLASSING The design of this package is intentionally primitive and allows it to be subclassed easily. An example of a (maybe) useful subclass is Devel::Symdump::Export, a package which exports all methods of the Devel::Symdump package and turns them into functions. =head1 SEE ALSO Package::Stash =head1 AUTHORS Andreas Koenig F<< >> and Tom Christiansen F<< >>. Based on the old F by Larry Wall. =head1 COPYRIGHT, LICENSE This module is Copyright (c) 1995, 1997, 2000, 2002, 2005, 2006 Andreas Koenig C<< >>. All rights reserved. This library is free software; you may use, redistribute and/or modify it under the same terms as Perl itself. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # End: Devel-Symdump-2.11/lib/Devel/Symdump/0000755000175000017500000000000012234126204014635 5ustar kkDevel-Symdump-2.11/lib/Devel/Symdump/Export.pm0000644000175000017500000000134312123476116016464 0ustar kkpackage Devel::Symdump::Export; require Devel::Symdump; require Exporter; use Carp; use strict; use vars qw(@ISA @EXPORT_OK $AUTOLOAD); @ISA=('Exporter'); @EXPORT_OK=( 'packages' , 'scalars' , 'arrays' , 'hashes' , 'functions' , 'filehandles' , 'dirhandles' , 'ios' , 'unknowns' , ); my %OK; @OK{@EXPORT_OK}=(1) x @EXPORT_OK; push @EXPORT_OK, "symdump"; # undocumented feature symdump() -- does it save enough typing? sub symdump { my @packages = @_; Devel::Symdump->new(@packages)->as_string; } AUTOLOAD { my @packages = @_; (my $auto = $AUTOLOAD) =~ s/.*:://; confess("Unknown function call $auto") unless $OK{$auto}; my @ret = Devel::Symdump->new->$auto(@packages); return @ret; } 1; Devel-Symdump-2.11/META.json0000644000175000017500000000217312234126204013016 0ustar kk{ "abstract" : "dump symbol names or the symbol table", "author" : [ "Andreas Koenig " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.8, CPAN::Meta::Converter version 2.132830", "keywords" : [ "symbol table inspection" ], "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Devel-Symdump", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Compress::Zlib" : "0", "Test::More" : "0", "perl" : "5.004" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "git://github.com/andk/devel-symdump.git" } }, "version" : "2.11" } Devel-Symdump-2.11/META.yml0000644000175000017500000000122512234126204012643 0ustar kk--- abstract: 'dump symbol names or the symbol table' author: - 'Andreas Koenig ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.8, CPAN::Meta::Converter version 2.132830' keywords: - 'symbol table inspection' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Devel-Symdump no_index: directory: - t - inc requires: Compress::Zlib: 0 Test::More: 0 perl: 5.004 resources: repository: git://github.com/andk/devel-symdump.git version: 2.11 Devel-Symdump-2.11/SIGNATURE0000644000175000017500000000330112234126212012652 0ustar kkThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.73. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 83e958ea60908948be82119cf2fb7d19f783a81f Changes SHA1 1a8c5d596cff0111353e14fa44e6caca7cce8c13 MANIFEST SHA1 390b7ecc4bd159d0a78a34921c4a8942071f2c4c META.json SHA1 f3cae9cb0977b2c88e0904ec02682628ae44ba3f META.yml SHA1 a58477f4ebc16c72b70c3c3bd8981bf808598d70 Makefile.PL SHA1 6cf5689752f21ac49c634e92588ee882b2bca6de README SHA1 a2d8f1b202eb8334375b5abdca09cc9825b6b655 lib/Devel/Symdump.pm SHA1 fef2e4c5ea88bd09f2af618e32a58ee87be965a4 lib/Devel/Symdump/Export.pm SHA1 6fbcf9e39c02e9889a6d8bf9cb2c6444967dc841 t/autogen.t SHA1 ac80cb093bffdce80ea28209197e58ec40b0cdd4 t/diff.t SHA1 6bc8983394b0a72d8ee3234b4788f9f81fbefca1 t/export.t SHA1 2854efb6fa5bd953348c47b156be8618cf10e74e t/glob_to_local_typeglob.t SHA1 835eaa7ac1ac82351bcc0f8fca734ed539459a95 t/pod.t SHA1 61383cc359764b3323e77a07ebf846f215331d34 t/podcover.t SHA1 a3c92f14ca7be245384a8a9f1425f6b99c2f42f1 t/recur.t SHA1 4ec8b0d93adeff78f408ec96ab27007cd09525a8 t/symdump.t SHA1 d7e8e57a5c9676c8fd716b6b0fe13559c83d8711 t/tree.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.15 (GNU/Linux) iEYEARECAAYFAlJwrIQACgkQ7IA58KMXwV0JigCgiUPFEuFMNq0zpTyLKuTFT+vi 6e4AoKn8oWrFjSC9jrmSM4uQQxBu9Esv =5n5O -----END PGP SIGNATURE----- Devel-Symdump-2.11/MANIFEST0000644000175000017500000000067712124502471012537 0ustar kkChanges lib/Devel/Symdump.pm lib/Devel/Symdump/Export.pm Makefile.PL MANIFEST README t/autogen.t t/diff.t t/export.t t/glob_to_local_typeglob.t t/pod.t t/podcover.t t/recur.t t/symdump.t t/tree.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) SIGNATURE Public-key signature (added by MakeMaker) Devel-Symdump-2.11/Makefile.PL0000644000175000017500000001512012124502136013343 0ustar kk#!/usr/bin/perl -w -*- mode: cperl -*- use strict; use vars qw( $VERSION ); use ExtUtils::MakeMaker qw(:DEFAULT); eval { require File::Spec; }; my $HAVE_FILE_SPEC = !$@; my $version_diff = 0; # we'll have to die if this becomes true my $version_from; my $is_trial = 0; my $version; { local $^W; $ExtUtils::MakeMaker::VERSION = eval $ExtUtils::MakeMaker::VERSION; } if ($HAVE_FILE_SPEC) { $version_from = File::Spec->catfile(qw(lib Devel Symdump.pm)); } else { $version_from = q(lib/Devel/Symdump.pm); } unshift @INC, "lib"; require $version_from; $version = $Devel::Symdump::VERSION; if ($is_trial && $version !~ /_/) { $version .= "-TRIAL"; } { my $version_set_manually = 1; # not by SVN if ($ARGV[0] && $ARGV[0] eq "--setversion") { die "Your perl is a bit dated[$]].\nDo not make a release with it\n" if $] < 5.008; die "Your MakeMaker is a bit dated[$ExtUtils::MakeMaker::VERSION].\nDo not make a release with it\n" if $ExtUtils::MakeMaker::VERSION < 6.4502; die "Your MakeMaker doesn't do the sign woodoo" unless MM->can("signature_target"); shift @ARGV; my $st; local $ENV{LANG} = "C"; my $dirty = `git status --porcelain --untracked-files=no`; die "Not everything checked in or out?\n====\n$dirty====\n" if $dirty; if ($version_set_manually) { # we must control that the VERSION in this .pm is the same as in the Makefile open my $fh, "make the-release-name|" or die; my $have_version; while (<$fh>) { next unless /^version\s+([\d\._]+(?:-TRIAL)?)/; $have_version = $1; } die "could not determine current version from Makefile" unless $have_version; eval q{ no warnings "numeric"; my $dsv = $Devel::Symdump::VERSION; if ($dsv != $have_version) { warn "Not equal: D:S:VERSION[$dsv] Makefile version[$have_version]"; $version_diff = 1; } }; die $@ if $@; } exit unless $version_diff; } } my $prereq_pm = { 'Compress::Zlib' => 0, # only for t/glob_to_local_typeglob.t 'Test::More' => 0, }; my @sign = (MM->can("signature_target") ? (SIGN => 1) : ()); WriteMakefile( NAME => "Devel::Symdump", DISTNAME => "Devel-Symdump", VERSION => $version, PREREQ_PM => $prereq_pm, ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? (LICENSE => "perl") : (), ), ($ExtUtils::MakeMaker::VERSION >= 6.48 ? (MIN_PERL_VERSION => '5.004') : (), ), clean => { FILES => '*/*/*~', }, @sign, ($] >= 5.005 ? ( ABSTRACT_FROM => 'lib/Devel/Symdump.pm', # retrieve abstract from module AUTHOR => 'Andreas Koenig ') : (), ), dist => { DIST_DEFAULT => join(" ", # note: order matters! "verify-no-subdir", "verify-changes-date", "verify-changes-version", "Makefile", "setversion", "README", "all", "tardist", ), COMPRESS => 'gzip -9', }, # I took it from RT-CPAN ticket 30098: ($ExtUtils::MakeMaker::VERSION >= 6.4502 ? (META_ADD => { resources => { repository => "git://github.com/andk/devel-symdump.git", }, keywords => ['symbol table inspection'], }) : ()), ); if ($version_diff){ die " ==> I had to update some \$VERSIONs <== ==> Your Makefile has been rebuilt. <== ==> Please rerun the make command. <== "; } package MY; sub distsignature { my($self) = shift; my $ret = $self->SUPER::distsignature_target(@_); $ret =~ s|cpansign|\`dirname \$(PERL)\`/cpansign|g; return $ret; } sub macro { q{ LC_ALL_noexport=en_GB.utf8 YAML_MODULE=YAML::Syck } } sub postamble { q{ # the subdirs on MY OWN BOX are allowed here (only used for make dist!) OKDIRS=benchmark|bin|blib|lib|scripts|t verify-no-subdir: @$(PERL) -e 'my$$s=join",",grep{!/^($(OKDIRS))\z/x&&-d($$_)}glob"*";' \ -e 'die"unexpected dir:$$s"if$$s' verify-changes-date: @$(PERL) -ne 'BEGIN{my@t=(localtime)[5,4,3];$$t[0]+=1900;$$t[1]++;$$t=sprintf"%04d-%02d-%02d",@t}' \ -e '$$ok++,exit if /^$$t\s/; END{die "Alert: did not find <$$t> in Changes file" unless $$ok}' Changes verify-changes-version: @$(PERL) -ne '$$ok++,exit if /\b$(VERSION)\b/; END{die "Alert: did not find <$(VERSION)> in Changes file" unless $$ok}' Changes setversion: $(PERL) Makefile.PL --setversion README: lib/Devel/Symdump.pm Makefile -test -r $@ && chmod +w $@ -$(PERL) -MPod::Text -e 'Pod::Text->new->parse_from_file(\*ARGV)' lib/Devel/Symdump.pm > $@ the-release-name : $(NOECHO) $(ECHO) 'version ' $(VERSION) $(NOECHO) $(ECHO) 'release-name ' $(DISTVNAME).tar$(SUFFIX) release :: disttest git tag -m 'This is $(VERSION)' "$(VERSION)" ls -l $(DISTVNAME).tar$(SUFFIX) rm -rf $(DISTVNAME) $(NOECHO) $(ECHO) '#### Suggested next steps:' $(NOECHO) $(ECHO) ' git push --tags origin master' sign: cpansign -s howto-release: @$(ECHO) manually set version in Symdump.pm, edit ChangeLog @$(ECHO) make ci dist \&\& make release } } sub dist_ci { return qq{ci : svn ci }; } sub dist_test { return q{ # if we depend on $(DISTVNAME).tar$(SUFFIX), then the rest of the # Makefile breaks our intent to NOT remake dist disttest : rm -rf $(DISTVNAME) tar xvzf $(DISTVNAME).tar$(SUFFIX) cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL cd $(DISTVNAME) && $(MAKE) $(PASTHRU) cd $(DISTVNAME) && $(MAKE) test $(PASTHRU) distdir :: touch $(DISTVNAME)/SIGNATURE && $(CP) $(DISTVNAME)/SIGNATURE ./SIGNATURE $(CP) $(DISTVNAME)/META.yml ./META.yml $(CP) $(DISTVNAME)/META.json ./META.json $(CP) $(DISTVNAME)/MANIFEST ./MANIFEST } } sub distdir { my $self = shift; my $out = $self->SUPER::distdir; $out =~ s/distdir :/distdir ::/g; return $out; } # dist_dir was the name in very old MakeMaker as of 5.005_04 sub dist_dir { my $self = shift; my $out = $self->SUPER::dist_dir; $out =~ s/distdir :/distdir ::/g; return $out; } Devel-Symdump-2.11/Changes0000644000175000017500000001457612234123637012711 0ustar kk2013-10-30 k * release 2.11 * v5.19.5-71-gd456e3f stopped producing the %@ hash at startup 2013-03-27 k * release 2.10 * no change to 2.10-TRIAL 2013-03-24 k * release 2.10-TRIAL * release 2.09-TRIAL * address RT#84139: fix test to work with upcoming perl 5.18 (Thanks to ZEFRAM) * fixed the autogen.t test again, this time for perl 5.8.9 2012-05-20 Andreas J. Koenig * release 2.08_53 * apply doc patch by Nick Stokoe from ticket #77102 * declare dependency on Compress::Zlib 2009-03-01 Andreas J. Koenig * release 2.08_51 * added a test by Jason M. Mills to chase down the bug he reports in https://rt.cpan.org/Ticket/Display.html?id=43675 2007-10-11 Andreas J. Koenig * release 2.08 * skip the recurse test on 5.005 2007-01-05 Andreas J. Koenig * release 2.07 * rewrite symdump.t using Test::More * adjust test suite to accept main::- also introduced for named captures 2006-10-08 Andreas J. Koenig * release 2.0604 * adjust test suite to accept main::+ introduced by named captures 2006-09-20 Andreas J. Koenig * relase 2.0603 * add LICENSE field to Makefile.PL to also have it in the META.yml 2006-07-19 Andreas J. Koenig * release 2.0602 * adjust test suite to accept new variable in bleadperl, the hash $main::^H 2006-05-03 Andreas J. Koenig * release 2.0601 * add copyright and license 2006-01-18 Andreas J. Koenig * release 2.06 * New warnings in bleadperl now suppressed; minor pod issues fixed 2006-01-02 Andreas J. Koenig * release 2.05 * fix the testcase for recursion so that it compiles and works also after patch 26370 to perl after which stashes are not autovivified anymore. 2005-12-25 Andreas J. Koenig * release 2.04 * Export.pm now strict clean * Makefile.PL up to date * added ChangeLog.svn * added tests for recursion, pod, podcover * Fixed rt.cpan.org #8766--recursion 2002-03-01 Andreas J. Koenig * lib/Devel/Symdump.pm: perl 5.6.1 introduced a package name of "" to work around a bug if somebody uses the deprecated C without an argument. I believe we need to ignore that symbol completely so that at least we follow the lead of the B:: extensions. Thanks to Sreeji K Das /sreeji_k at yahoo.com/ for the report. 2000-10-31 Andreas J. Koenig * Typo fix: hashs --> hashes. Thanks to Sebastien Blondeel for the report. 2000-06-14 Andreas J. Koenig * Fixed my email address in and made a few tiny editorial changes to the manpage. * Replaced Changes file with this ChangeLog file, appended the full Changes file below. * Fixed the test 6 in t/symdump.t. This test was broken by perl-5.6.0 but not Devel::Symdump itself. 1997-05-16 Andreas Koenig * Release 2.00 * Fixed typos in the manpage, added a test for tree, no functional change, released 2.00. 1997-03-31 Andreas Koenig * 1.99_01 * 1.99_01 is the designated 2.00. * Between 1.20 and 1.23 the method as_HTML was introduced and a few code cleanups happened. * 2.00 switches implementation to use *ENTRY{XXX} internally. This means that we can determine scalarness even for undefined scalars. We don't expect unknowns anymore. * 2.00 introduces the new ios() method which should replace the older filehandles() and dirhandles() methods. For backwards compatibility the old methods continue to work as they used to. * 2.00 comes with isa_tree and inh_tree utility methods for analysing the inheritance tree. Devel::Symdump objects may be used to create snapshots, but their typical use would be as class methods. 1995-08-16 Andreas Koenig * 1.20 * test 7 of t/symdump.t was too capricious. In fact the test was based on wrong assumptions about loaded packages in the perl binary. Static perls and dynamic perls have different symbol tables when they run thetests. So test 7 is gone. * test 4 of t/symdump.t relied on $@ being set like in perl5.001m. This might not be a correct assumption. So test 4 is replaced with a dummy 'print ok' until the $@ problem is sorted out 1995-07-03 Andreas Koenig * 1.19 * Added an as_string method. * Rewrote the test scripts so they output standard test strings "ok nnn". This is dangerous for new perl releases, but will help me do get bug reports early. * Renamed the exporting example package to Devel::Symdump::Export. 1995-05-29 Andreas Koenig * 1.16 * Changed '${pack}::' and relatives back to "$pack\:\:" to make the package "-w" safe. Deleted the debug statement in _doit() after Gurusamy Sarathy fixed the bug in perl5.001, but left a comment there. * Changed the AUTHORS section to plain "Andreas & Tom". * Added this Changes file :) 1995-05-28 Andreas Koenig * 1.14 * After a considerable amount of mail exchange between Tom and me, we now have a unknowns() method for all the rest in the symbol table that we currently don't follow further. new() is renamed to rnew() which stands for recursive new. new() now does not go into recursion which becomes the default behaviour for people calling directly Devel::Symdump->arrays etc. * Added a Devel::Symdump::Exp package for Tom who wanted the methods exported. Tom had tried to add Exporter to the package and to export the undefined methods directly. Andreas didn't trust this trick although it seemed to work fine. So they are still considering if it can be done. 1995-05-27 Andreas Koenig * 1.09 * Drops all prettyprint functionality and becomes a primitiv package after some talk with Tom Christiansen and Gurusamy Sarathy. Moreover, Dean Roehrich's additions to the perlbot manpage gave me (Andreas) some hints about package globals which now get a new dress within the object. 1995-05-xx Andreas Koenig * 1.05 * First release of the formerly Devel::Debug called package. Local Variables: mode: change-log change-log-default-name: "Changes" End: Devel-Symdump-2.11/t/0000755000175000017500000000000012234126204011635 5ustar kkDevel-Symdump-2.11/t/podcover.t0000644000175000017500000000065612123513314013651 0ustar kk# -*- mode: cperl -*- BEGIN { $|++; unless (@ARGV && shift(@ARGV) eq "--doit") { $|=1; print "1..0 # SKIP test only run when called with --doit\n"; eval "require POSIX; 1" and POSIX::_exit(0); exit; } } use Test::More; eval "use Test::Pod::Coverage"; plan skip_all => "Test::Pod::Coverage required for testing pod coverage" if $@; plan tests => 1; pod_coverage_ok( "Devel::Symdump" ); Devel-Symdump-2.11/t/diff.t0000644000175000017500000000211212123476116012735 0ustar kk#!/usr/bin/perl -w use lib 'lib' ; use Devel::Symdump (); BEGIN { $SIG{__WARN__}=sub {return "" if $_[0] =~ /used only once/; print @_;}; } print "1..1\n"; $scalar = 1; @array = 1; %hash = (A=>B); %package::hash = (A=>B); sub package::function {} open FH, ">/dev/null"; opendir DH, "."; my $a = Devel::Symdump->rnew; my($eval) = <<'END'; $scalar2 = 1; undef @array; undef %hash; %hash2 = (A=>B); $package2::scalar3 = 3; close FH; closedir DH; END eval $eval; my $b = Devel::Symdump->rnew; # testing diff is too difficult at the stage between 5.003 and 5.004 # we have new variables and new methods to determine them. Both have # an impact on diff, so we're backing out this test and always say ok if ( 1 || $a->diff($b) eq 'arrays - main::array dirhandles - main::DH filehandles - main::FH hashes - main::hash + main::hash2 packages + package2 scalars + main::scalar2 + package2::scalar3 unknowns + main::DH + main::FH + main::array + main::hash' ){ print "ok 1\n"; } else { print "not ok: a - ", $a->as_string, " b - ", $b->as_string, " diff ---- ", $a->diff($b), "\n"; } Devel-Symdump-2.11/t/export.t0000644000175000017500000000045012123476116013351 0ustar kkprint "1..2\n"; use Devel::Symdump::Export "symdump"; $x = symdump(); if (length($x) > 500){ print "ok 1\n"; } else { print "not ok 1\n", length($x), ":\n$x\n"; } if ($x =~ /arrays.*functions.*hashes.*ios.*packages.*scalars.*unknowns/xs){ print "ok 2\n"; } else { print "not ok 2 $x\n"; } Devel-Symdump-2.11/t/pod.t0000644000175000017500000000057312123513143012610 0ustar kk# -*- mode: cperl -*- BEGIN { $|++; unless (@ARGV && shift(@ARGV) eq "--doit") { $|=1; print "1..0 # SKIP test only run when called with --doit\n"; eval "require POSIX; 1" and POSIX::_exit(0); exit; } } use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Devel-Symdump-2.11/t/autogen.t0000644000175000017500000000153012123522504013463 0ustar kk#!/usr/bin/perl -w BEGIN { unshift @INC, '.' ;} require Devel::Symdump; print "1..8\n"; @p = qw( scalars arrays hashes functions unknowns filehandles dirhandles packages); $i=0; if ($] < 5.010) { # with 5.8.9 just calling a sort() left something behind on the symbol table @x1 = sort (1,2); } for (@p){ @x1 = sort Devel::Symdump->$_(); @x2 = sort Devel::Symdump->new->$_(); unless ("@x1" eq "@x2"){ my %h1 = map {$_=>1} @x1; my %h2 = map {$_=>1} @x2; my %hm; for (@x1,@x2) { $hm{$_}++; } for my $k (sort keys %hm) { next if $hm{$k}==2; if (!exists $h1{$k}) { print "# only in x2 [$k]\n"; } else { print "# only in x1 [$k]\n"; } } print "not "; } print "ok ", ++$i, "\n"; } Devel-Symdump-2.11/t/glob_to_local_typeglob.t0000644000175000017500000000257612123512427016543 0ustar kkBEGIN { $|++; unless (@ARGV && shift(@ARGV) eq "--doit") { $|=1; print "1..0 # SKIP test only run when called with --doit\n"; eval "require POSIX; 1" and POSIX::_exit(0); exit; } } use strict; use warnings; use Test::More 'no_plan'; use English; diag("OS == $^O"); use_ok('Compress::Zlib'); use_ok('Devel::Symdump'); diag('$Devel::Symdump::VERSION == '.$Devel::Symdump::VERSION); diag('$Compress::Zlib::VERSION == '.$Compress::Zlib::VERSION); diag("Perl == $]"); my $glob_ref = eval { no strict 'refs'; ${*{"Compress::Zlib::"}}{GZIP_NULL_BYTE}; }; ok(!$@,'reference assignment'); diag('ref($glob_ref) == "'.ref($glob_ref).'"'); _check_child(sub { local *ENTRY; diag "Checking GLOB assignment to reference..."; *ENTRY = $glob_ref; }); _check_child(sub { diag "Checking Devel::Symdump->rnew->packages..."; Devel::Symdump->rnew->packages; }); sub _check_child { local *CHILD; my $code = shift; my $pid = open(CHILD, "|-"); unless ($pid) { $code->(); exit 0; } else { my $w = waitpid($pid,0); ok($w != -1 && $w == $pid,'waitpid()'); my $e = $? >> 8; my $s = $? & 127; my $c = $? & 128; diag "exit value = $e"; diag "exit with signal = $s"; diag "dumped core? $c"; ok($s != 11,'child did not SEGV'); ok($e == 0 && $s == 0,'child exited properly'); } } # Local Variables: # mode: cperl # cperl-indent-level: 4 # End: Devel-Symdump-2.11/t/tree.t0000644000175000017500000000107312123476116012771 0ustar kk#!/usr/bin/perl -w # tree.t use Devel::Symdump; package Coffee; @ISA = qw(Liquid Black); package Liquid; package Black; package Martini; @ISA = qw(Liquid); package Martini::White; @ISA = qw(Martini); package Martini::Red; @ISA = qw(Martini); print "1..2\n"; my @s = split /\n/, Devel::Symdump->isa_tree; print @s >= 11 ? "ok 1\n" : "not ok [@s]\n"; @s = split /\n/, Devel::Symdump->inh_tree; print @s >= 9 ? "ok 2\n" : "not ok [@s]\n"; # The tests are testing with the > operator, because we never know where # Exporter and Carp (and others) are developing into. Devel-Symdump-2.11/t/symdump.t0000644000175000017500000001144712234122745013535 0ustar kk#!/usr/bin/perl -w BEGIN { unshift @INC, '.' ; $SIG{__WARN__}=sub {return "" if $_[0] =~ /used only once/; print @_;}; } use Devel::Symdump::Export qw(filehandles hashes arrays); use Test::More; plan tests => 13; init(); my %prefices = qw( scalars $ arrays @ hashes % functions & unknowns * ); @prefices{qw(filehandles dirhandles packages)}=("") x 3; format i_am_the_symbol_printing_format_lest_there_be_any_doubt = Got these @* "$t:" ~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $a . $~ = 'i_am_the_symbol_printing_format_lest_there_be_any_doubt'; @a = packsort(filehandles('main')); $t = 'filehandles'; $a = "@a"; # write; ok ( $a eq "main::DATA main::Hmmmm main::STDERR main::STDIN main::STDOUT main::stderr main::stdin main::stdout" || $a eq "main::ARGV main::DATA main::Hmmmm main::STDERR main::STDIN main::STDOUT main::i_am_the_symbol_printing_format_lest_there_be_any_doubt main::stderr main::stdin main::stdout", $a ); @a = packsort(hashes 'main'); $t = 'hashes'; $a = uncontrol("@a"); $a =~ s/main:://g; #write; ok ( $a eq "^H + - @ ENV INC SIG" # + named capture 29682 || $a eq "^H + @ ENV INC SIG" # + named capture 28957 || $a eq "^H @ ENV INC SIG" # ^H hints 27643 (?) || $a eq "^H ENV INC SIG" # v5.19.5-71-gd456e3f || $a eq "@ ENV INC SIG" || $a eq "ENV INC SIG", $a ); @a = packsort(arrays()); $t = 'arrays'; $a = "@a"; #write; like ( $a, "/main::INC.*main::_.*main::a/" ); eval { @a = Devel::Symdump->really_bogus('main'); }; $a = $@ ? $@ : "@a"; like ($a, "/^invalid Devel::Symdump method: really_bogus\(\)/", ); $sob = rnew Devel::Symdump; @m=(); for (active_packages($sob)) { push @m, "$_"; } $a="@m"; like ($a, "/Carp.*Devel.*Devel::Symdump.*Devel::Symdump::Export.*DynaLoader.*Exporter.*Hidden.*big::long::hairy.*funny::little.*strict/"); my %m=(); for (active_modules($sob)) { $m{$_}=undef; } $a = join " ", keys %m; #print "[$a]\n"; ok (exists $m{"Carp"} && exists $m{"Devel::Symdump"} && exists $m{"Devel::Symdump::Export"} && exists $m{"Exporter"} && exists $m{"strict"} && exists $m{"vars"}); # Cannot test on the number of packages and functions because not # every perl is built the same way. Static perls will reveal more # packages and more functions being in them # Testing on >= seems no problem to me, we'll see # (Time passes) Much less unknowns in version 1.22 (perl5.003_10). my %Expect=qw( packages 13 scalars 28 arrays 7 hashes 5 functions 35 filehandles 9 dirhandles 2 unknowns 53 ); #we don't count the unknowns. Newer perls might have different outcomes for $type ( qw{ packages scalars arrays hashes functions filehandles dirhandles }){ next unless @syms = $sob->$type(); if ($I_REALLY_WANT_A_CORE_DUMP) { # if this block execute , mysteriously COREDUMPS at for() below # NOT TRUE anymore (watched by Andreas, 15.6.1995) @vars = ($type eq 'packages') ? sort(@syms) : packsort(@syms); } else { if ($type eq 'packages') { @syms = sort @syms; } else { @syms = packsort(@syms); } } ok (@syms >= $Expect{$type}); } exit; sub active_modules { my $ob = shift; my @modules = (); my($pack); for $pack ("main", $ob->packages) { if ( defined &{ "$pack\::import" } || defined &{ "$pack\::AUTOLOAD" } || defined @{ "$pack\::ISA" } || defined @{ "$pack\::EXPORT" } || defined @{ "$pack\::EXPORT_OK"} ) { push @modules, $pack; } } return sort @modules; } sub active_packages { my $ob = shift; my @modules = (); my $pack; for $pack ($ob->packages) { $pob = new Devel::Symdump $pack; if ( $pob->scalars() || $pob->hashes() || $pob->arrays() || $pob->functions() || $pob->filehandles()|| $pob->dirhandles() ) { push @modules, $pack; } } return sort @modules; } sub uncontrol { local $_ = $_[0]; s/([\200-\377])/ 'M-' . pack('c', ord($1) & 0177 ) /eg; s/([\000-\037\177])/ '^' . pack('c', ord($1) ^ 64 ) /eg; return $_; } sub packsort { my (@vars, @pax, @fullnames); for (@_) { my($pack, $name) = /^(.*::)(.*)$/s; push(@vars, $name); push(@pax, $pack); push(@fullnames, $_); } return @fullnames [ sort { ($pax[$a] ne 'main::') <=> ($pax[$b] ne 'main::') || $pax[$a] cmp $pax[$b] || $vars[$a] cmp $vars[$b] } 0 .. $#fullnames ]; } sub init { $big::long::hairy::thing++; sub Devel::testsub {}; opendir(DOT, '.'); opendir(funny::little::imadir, '/'); $i_am_a_scalar_variable = 1; open(Hmmmm, ">/dev/null"); open(Hidden::FH, ">/dev/null"); } __END__ Devel-Symdump-2.11/t/recur.t0000644000175000017500000000142212123476116013150 0ustar kkBEGIN { $|++; if ($] <= 5.006) { print "1..0 # Skip: this test is known to fail with 5.005xx\n"; # (2007-06-25 akoenig: I have seen it working in the debugger) eval "require POSIX; 1" and POSIX::_exit(0); } } package Acme::Meta; BEGIN { $::Meta::VERSION = $VERSION = 0; # autovivify for perl >= @26370 $Meta::{'Meta::'} = $main::{'Meta::'}; $Acme::Meta::{'Meta::'} = $main::{'Meta::'}; } use strict; require Test::More; my $tests = 3; Test::More->import( tests => $tests ); exit unless $tests; Test::More::ok(1); $Acme::Meta::Meta::Pie = "good"; Test::More::is ($Acme::Meta::Meta::Meta::Meta::Pie, "good"); Test::More::use_ok('Devel::Symdump'); Devel::Symdump->rnew("Acme"); __END__ # Local Variables: # mode: cperl # cperl-indent-level: 2 # End: Devel-Symdump-2.11/README0000644000175000017500000001330212234126203012250 0ustar kkNAME Devel::Symdump - dump symbol names or the symbol table SYNOPSIS # Constructor require Devel::Symdump; @packs = qw(some_package another_package); $obj = Devel::Symdump->new(@packs); # no recursion $obj = Devel::Symdump->rnew(@packs); # with recursion # Methods @array = $obj->packages; @array = $obj->scalars; @array = $obj->arrays; @array = $obj->hashes; @array = $obj->functions; @array = $obj->filehandles; # deprecated, use ios instead @array = $obj->dirhandles; # deprecated, use ios instead @array = $obj->ios; @array = $obj->unknowns; # only perl version < 5.003 had some $string = $obj->as_string; $string = $obj->as_HTML; $string = $obj1->diff($obj2); $string = Devel::Symdump->isa_tree; # or $obj->isa_tree $string = Devel::Symdump->inh_tree; # or $obj->inh_tree # Methods with autogenerated objects # all of those call new(@packs) internally @array = Devel::Symdump->packages(@packs); @array = Devel::Symdump->scalars(@packs); @array = Devel::Symdump->arrays(@packs); @array = Devel::Symdump->hashes(@packs); @array = Devel::Symdump->functions(@packs); @array = Devel::Symdump->ios(@packs); @array = Devel::Symdump->unknowns(@packs); DESCRIPTION This little package serves to access the symbol table of perl. "Devel::Symdump->rnew(@packages)" returns a symbol table object for all subtrees below @packages. Nested Modules are analyzed recursively. If no package is given as argument, it defaults to "main". That means to get the whole symbol table, just do a "rnew" without arguments. The global variable $Devel::Symdump::MAX_RECURSION limits the recursion to prevent contention. The default value is set to 97, just low enough to survive the test suite without a warning about deep recursion. "Devel::Symdump->new(@packages)" does not go into recursion and only analyzes the packages that are given as arguments. packages, scalars, arrays, hashes, functions, ios The methods packages(), scalars(), arrays(), hashes(), functions(), ios(), and (for older perls) unknowns() each return an array of fully qualified symbols of the specified type in all packages that are held within a Devel::Symdump object, but without the leading "$", "@" or "%". In a scalar context, they will return the number of such symbols. Unknown symbols are usually either formats or variables that haven't yet got a defined value. Note that scalar symbol table entries are a special case. If a symbol table entry exists at all, presence of a scalar is currently unknowable, due to a feature of Perl described in perlref "Making References" point 7. For example, this package will mark a scalar value $foo as present if any of @foo, %foo, &foo etc. have been declared or used. as_string as_HTML As_string() and as_HTML() return a simple string/HTML representations of the object. diff Diff() prints the difference between two Devel::Symdump objects in human readable form. The format is similar to the one used by the as_string method. isa_tree inh_tree Isa_tree() and inh_tree() both return a simple string representation of the current inheritance tree. The difference between the two methods is the direction from which the tree is viewed: top-down or bottom-up. As I'm sure, many users will have different expectation about what is top and what is bottom, I'll provide an example what happens when the Socket module is loaded: % print Devel::Symdump->inh_tree AutoLoader DynaLoader Socket DynaLoader Socket Exporter Carp Config Socket The inh_tree method shows on the left hand side a package name and indented to the right the packages that use the former. % print Devel::Symdump->isa_tree Carp Exporter Config Exporter DynaLoader AutoLoader Socket Exporter DynaLoader AutoLoader The isa_tree method displays from left to right ISA relationships, so Socket IS A DynaLoader and DynaLoader IS A AutoLoader. (Actually, they were at the time this manpage was written) You may call both methods, isa_tree() and inh_tree(), with an object. If you do that, the object will store the output and retrieve it when you call the same method again later. The typical usage would be to use them as class methods directly though. SUBCLASSING The design of this package is intentionally primitive and allows it to be subclassed easily. An example of a (maybe) useful subclass is Devel::Symdump::Export, a package which exports all methods of the Devel::Symdump package and turns them into functions. SEE ALSO Package::Stash AUTHORS Andreas Koenig and Tom Christiansen . Based on the old dumpvar.pl by Larry Wall. COPYRIGHT, LICENSE This module is Copyright (c) 1995, 1997, 2000, 2002, 2005, 2006 Andreas Koenig "". All rights reserved. This library is free software; you may use, redistribute and/or modify it under the same terms as Perl itself.