namespace-clean-0.24/0000755000175000017500000000000012057500017013740 5ustar rabbitrabbitnamespace-clean-0.24/Changes0000644000175000017500000001105212057477554015255 0ustar rabbitrabbit [0.24] - Properly skip debugger test when optional deps not available - Make sure pure-perl tests pass correctly on space-containing paths (RT#77528) - Remove all the pure-perl fallback code and depend on PP-capable B::H::EOS 0.12 [0.23] - Rely on B::Hooks::EndOfScope version 0.10 to fix issues with new Module::Runtime versions (>= 0.012) on perl 5.10 due to incorrect hook firing due to %^H localisation. - Fix failures on 5.13.6 due to incorrect version number threshold (RT#74683) [0.22] (official fix of all the %^H ickyness) - Simplify the >= 5.10 PP variant even more - move the hook from DESTROY into DELETE - Force explicit callback invocation order on 5.8 PP [0.21_02] - Replace the %^H tie approach with fieldhashes, fixes all known corner cases and caveats on supported perls >= 5.8.1 (FC) - Compile away the debugger fixup on perls >= 5.15.5 (FC) [0.21_01] - More robust handling of the tied %^H in pure perl mode (RT#73402) - Limit the debugger workarounds to perls between 5.8.8 and 5.14, extend debugger support to all perl versions (FC) (RT#69862) - If possible, automatically install (but not load) the debugger workaround libraries on perls between 5.8.8 and 5.14 (RT#72368) - Add back dropped NAME section (RT#70259) [0.21] - When using the tie() fallback ensure we do not obliterate a foreign tie() - Better document how to disable the tie() fallback [0.20_01] (the "mst made me do it" release) - Only invoke the deleted sub stashing if we run udner a debugger (avoid runtime penalty of Sub::Name/Sub::Identify) - Spellfixes (RT#54388) - When B::Hooks::EndOfScope is not available, switch to a simple tie() of %^H. While it can not 100% replace B::H::EOS, it does everything n::c needs [0.20] - Bump Package::Stash dependency to 0.22 to pull in a bugfix in Package::Stash::XS 0.19. [0.19] - Port to the new Package::Stash 0.18 API and depend on it. - Don't rely on package::stash's remove_package_symbol implementation (doy). [0.18] - Make sure we continue working on future Package::Stash versions (doy). [0.17] - Make sure the debugger author test is skipped for non-authors before the debugger is even loaded. [0.16] - Release all changes of 0.15 as part of a stable release. - Convert from Module::Install to Dist::Zilla. [0.15] TRIAL release - Use Package::Stash for the stash manipulation bits (doy). [0.14] Thu Mar 18 11:15:38 CET 2010 - Disable auto_install. - Turn the error prone debugger test into an author test. [0.13] Sun Jan 17 02:40:48 CET 2010 - Skip failing debugger tests on 5.8.8 and older. [0.12] Thu Jan 14 03:22:03 CET 2010 - Stop relying on stash entries always being upgraded into real GVs (Zefram). - Work around $DB::sub (Yuval Kogman). - Fix restoring of non-code symbols when cleaning (Ben Morrows). [0.11] Tue Mar 3 17:34:49 CET 2009 - Added -cleanee option to specify the package to clean (Closes RT#41850). - Added n:c->clean_subroutines($cleanee, @subs). [0.10] Fri Feb 20 14:31:36 CET 2009 - Depend on B::Hooks::EndOfScope 0.07 to avoid segfaults and lost error messages when something goes wrong. [0.09] Wed Oct 22 17:48:49 CEST 2008 - Use B::Hooks::EndOfScope instead of %^H + Scope::Guard. [0.08] Sun Mar 9 22:01:01 CET 2008 - Added explicit cleanup behaviour [0.07] Sun Mar 9 20:13:33 CET 2008 - Switched from Filter::EOF to a much saner implementation via %^H and Scope::Guard. (mst & autobox)++ for this. [0.06] Wed Feb 20 15:09:00 CET 2008 - Fixed 'uninitialized value in ref-to-glob cast' error if unimport was used before. [0.05] Sun Aug 12 18:24:49 CEST 2007 - Minor POD improvements - -except now accepts a single value too [0.04] Sat Mar 17 16:22:10 CET 2007 - Added -except flag - Non-CODE type slots will not be removed [0.03] Sat Feb 24 22:34:55 CET 2007 - Minor comment and POD cleanups - Tried to clarify how the module works [0.02] Tue Feb 20 00:38:24 CET 2007 - Added unimport behaviour [0.01] Sun Feb 18 17:33:18 CET 2007 - Initial Version namespace-clean-0.24/META.json0000644000175000017500000000246112057500017015364 0ustar rabbitrabbit{ "abstract" : "Keep imports and functions out of your namespace", "author" : [ "Robert 'phaylon' Sedlacek , Florian Ragwitz , Jesse Luehrs " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "namespace-clean", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "Test::More" : "0.88" } }, "configure" : { "requires" : { "ExtUtils::CBuilder" : "0.27" } }, "runtime" : { "requires" : { "B::Hooks::EndOfScope" : "0.12", "Package::Stash" : "0.23" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "http://rt.cpan.org/Public/Dist/Display.html?Name=namespace-clean" }, "homepage" : "http://search.cpan.org/dist/namespace-clean", "repository" : { "url" : "git://git.shadowcat.co.uk/p5sagit/namespace-clean.git" } }, "version" : "0.24" } namespace-clean-0.24/Makefile.PL0000644000175000017500000000742212054734460015727 0ustar rabbitrabbituse strict; use warnings; use 5.008001; use ExtUtils::MakeMaker; my $mymeta_works = eval { ExtUtils::MakeMaker->VERSION('6.5707'); 1 }; my $mymeta = $mymeta_works || eval { ExtUtils::MakeMaker->VERSION('6.5702'); 1 }; my %BUILD_DEPS = ( 'Test::More' => '0.88', ); my %RUN_DEPS = ( 'Package::Stash' => '0.23', 'B::Hooks::EndOfScope' => '0.12', ); # these pieces are needed if using the debugger on the perl range my %OPT_RUN_DEPS = ( $] > 5.008_008_9 and $] < 5.013_005_1 and can_xs() ) # when changing versions, also change $sn_ver and $si_ver in namespace/clean.pm ? ( 'Sub::Name' => '0.04', 'Sub::Identify' => '0.04' ) : () ; my %META_BITS = ( resources => { homepage => 'http://search.cpan.org/dist/namespace-clean', # EUMM not supporting nested meta :( #repository => { # type => 'git', # url => 'git://git.shadowcat.co.uk/p5sagit/namespace-clean.git', # web => 'http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit/namespace-clean.git', #} #bugtracker => { # mailto => 'bug-namespace-clean@rt.cpan.org', # web => 'http://rt.cpan.org/Public/Dist/Display.html?Name=namespace-clean', #}, repository => 'git://git.shadowcat.co.uk/p5sagit/namespace-clean.git', bugtracker => 'http://rt.cpan.org/Public/Dist/Display.html?Name=namespace-clean', }, ); my %WriteMakefileArgs = ( 'NAME' => 'namespace::clean', 'VERSION_FROM' => 'lib/namespace/clean.pm', 'ABSTRACT' => 'Keep imports and functions out of your namespace', 'AUTHOR' => 'Robert \'phaylon\' Sedlacek , Florian Ragwitz , Jesse Luehrs ', 'CONFIGURE_REQUIRES' => { 'ExtUtils::CBuilder' => 0.27 }, 'PREREQ_PM' => { %RUN_DEPS, %OPT_RUN_DEPS, $mymeta_works ? () : (%BUILD_DEPS), }, $mymeta_works ? ( # BUILD_REQUIRES makes MYMETA right, requires stops META being wrong 'BUILD_REQUIRES' => \%BUILD_DEPS, 'META_ADD' => { %META_BITS, requires => \%RUN_DEPS, }, ) : ( # META_ADD both to get META right - only Makefile written 'META_ADD' => { %META_BITS, requires => \%RUN_DEPS, build_requires => \%BUILD_DEPS, }, ) , ($mymeta and !$mymeta_works) ? ( 'NO_MYMETA' => 1 ) : (), 'LICENSE' => 'perl', ); unless ( eval { ExtUtils::MakeMaker->VERSION('6.56') } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION('6.52') }; WriteMakefile(%WriteMakefileArgs); # Secondary compile testing via ExtUtils::CBuilder sub can_xs { # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if (! $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return can_cc(); } return ExtUtils::CBuilder->new( quiet => 1 )->have_compiler; } # can we locate a (the) C compiler sub can_cc { my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return can_run("@chunks") || (pop(@chunks), next); } return; } # check if we can run some command sub can_run { my ($cmd) = @_; return $cmd if -x $cmd; if (my $found_cmd = MM->maybe_command($cmd)) { return $found_cmd; } for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } namespace-clean-0.24/MANIFEST0000644000175000017500000000127012057500017015071 0ustar rabbitrabbitChanges lib/namespace/clean.pm Makefile.PL MANIFEST This list of files t/00-basic.t t/01-function-wipeout.t t/02-inheritance.t t/03-unimport.t t/04-except.t t/05-explicit-cleanee.t t/05-syntax-error.t t/06-other-types.t t/07-debugger.t t/08-const-sub.t t/09-fiddle-hinthash.t t/10-pure-perl.t t/lib/CleaneeBridge.pm t/lib/CleaneeBridgeDirect.pm t/lib/CleaneeBridgeExplicit.pm t/lib/CleaneeTarget.pm t/lib/ExporterTest.pm t/lib/FunctionWipeout.pm t/lib/Inheritance.pm t/lib/OtherTypes.pm t/lib/SyntaxError.pm t/lib/Unimport.pm META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) namespace-clean-0.24/META.yml0000644000175000017500000000147412057500017015217 0ustar rabbitrabbit--- abstract: 'Keep imports and functions out of your namespace' author: - "Robert 'phaylon' Sedlacek , Florian Ragwitz , Jesse Luehrs " build_requires: Test::More: 0.88 configure_requires: ExtUtils::CBuilder: 0.27 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: namespace-clean no_index: directory: - t - inc requires: B::Hooks::EndOfScope: 0.12 Package::Stash: 0.23 resources: bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=namespace-clean homepage: http://search.cpan.org/dist/namespace-clean repository: git://git.shadowcat.co.uk/p5sagit/namespace-clean.git version: 0.24 namespace-clean-0.24/lib/0000755000175000017500000000000012057500017014506 5ustar rabbitrabbitnamespace-clean-0.24/lib/namespace/0000755000175000017500000000000012057500017016442 5ustar rabbitrabbitnamespace-clean-0.24/lib/namespace/clean.pm0000644000175000017500000002735112057477463020114 0ustar rabbitrabbitpackage namespace::clean; use warnings; use strict; use Package::Stash; our $VERSION = '0.24'; our $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE'; use B::Hooks::EndOfScope 'on_scope_end'; =head1 NAME namespace::clean - Keep imports and functions out of your namespace =head1 SYNOPSIS package Foo; use warnings; use strict; use Carp qw(croak); # 'croak' will be removed sub bar { 23 } # 'bar' will be removed # remove all previously defined functions use namespace::clean; sub baz { bar() } # 'baz' still defined, 'bar' still bound # begin to collection function names from here again no namespace::clean; sub quux { baz() } # 'quux' will be removed # remove all functions defined after the 'no' unimport use namespace::clean; # Will print: 'No', 'No', 'Yes' and 'No' print +(__PACKAGE__->can('croak') ? 'Yes' : 'No'), "\n"; print +(__PACKAGE__->can('bar') ? 'Yes' : 'No'), "\n"; print +(__PACKAGE__->can('baz') ? 'Yes' : 'No'), "\n"; print +(__PACKAGE__->can('quux') ? 'Yes' : 'No'), "\n"; 1; =head1 DESCRIPTION =head2 Keeping packages clean When you define a function, or import one, into a Perl package, it will naturally also be available as a method. This does not per se cause problems, but it can complicate subclassing and, for example, plugin classes that are included via multiple inheritance by loading them as base classes. The C pragma will remove all previously declared or imported symbols at the end of the current package's compile cycle. Functions called in the package itself will still be bound by their name, but they won't show up as methods on your class or instances. By unimporting via C you can tell C to start collecting functions for the next C specification. You can use the C<-except> flag to tell C that you don't want it to remove a certain function or method. A common use would be a module exporting an C method along with some functions: use ModuleExportingImport; use namespace::clean -except => [qw( import )]; If you just want to C<-except> a single sub, you can pass it directly. For more than one value you have to use an array reference. =head2 Explicitly removing functions when your scope is compiled It is also possible to explicitly tell C what packages to remove when the surrounding scope has finished compiling. Here is an example: package Foo; use strict; # blessed NOT available sub my_class { use Scalar::Util qw( blessed ); use namespace::clean qw( blessed ); # blessed available return blessed shift; } # blessed NOT available =head2 Moose When using C together with L you want to keep the installed C method. So your classes should look like: package Foo; use Moose; use namespace::clean -except => 'meta'; ... Same goes for L. =head2 Cleaning other packages You can tell C that you want to clean up another package instead of the one importing. To do this you have to pass in the C<-cleanee> option like this: package My::MooseX::namespace::clean; use strict; use namespace::clean (); # no cleanup, just load sub import { namespace::clean->import( -cleanee => scalar(caller), -except => 'meta', ); } If you don't care about Cs discover-and-C<-except> logic, and just want to remove subroutines, try L. =head1 METHODS =head2 clean_subroutines This exposes the actual subroutine-removal logic. namespace::clean->clean_subroutines($cleanee, qw( subA subB )); will remove C and C from C<$cleanee>. Note that this will remove the subroutines B and not wait for scope end. If you want to have this effect at a specific time (e.g. C acts on scope compile end) it is your responsibility to make sure it runs at that time. =cut # Constant to optimise away the unused code branches use constant FIXUP_NEEDED => $] < 5.015_005_1; use constant FIXUP_RENAME_SUB => $] > 5.008_008_9 && $] < 5.013_005_1; { no strict; delete ${__PACKAGE__."::"}{FIXUP_NEEDED}; delete ${__PACKAGE__."::"}{FIXUP_RENAME_SUB}; } # Debugger fixup necessary before perl 5.15.5 # # In perl 5.8.9-5.12, it assumes that sub_fullname($sub) can # always be used to find the CV again. # In perl 5.8.8 and 5.14, it assumes that the name of the glob # passed to entersub can be used to find the CV. # since we are deleting the glob where the subroutine was originally # defined, those assumptions no longer hold. # # So in 5.8.9-5.12 we need to move it elsewhere and point the # CV's name to the new glob. # # In 5.8.8 and 5.14 we move it elsewhere and rename the # original glob by assigning the new glob back to it. my $sub_utils_loaded; my $DebuggerFixup = sub { my ($f, $sub, $cleanee_stash, $deleted_stash) = @_; if (FIXUP_RENAME_SUB) { if (! defined $sub_utils_loaded ) { $sub_utils_loaded = do { # when changing version also change in Makefile.PL my $sn_ver = 0.04; eval { require Sub::Name; Sub::Name->VERSION($sn_ver) } or die "Sub::Name $sn_ver required when running under -d or equivalent: $@"; # when changing version also change in Makefile.PL my $si_ver = 0.04; eval { require Sub::Identify; Sub::Identify->VERSION($si_ver) } or die "Sub::Identify $si_ver required when running under -d or equivalent: $@"; 1; } ? 1 : 0; } if ( Sub::Identify::sub_fullname($sub) eq ($cleanee_stash->name . "::$f") ) { my $new_fq = $deleted_stash->name . "::$f"; Sub::Name::subname($new_fq, $sub); $deleted_stash->add_symbol("&$f", $sub); } } else { $deleted_stash->add_symbol("&$f", $sub); } }; my $RemoveSubs = sub { my $cleanee = shift; my $store = shift; my $cleanee_stash = Package::Stash->new($cleanee); my $deleted_stash; SYMBOL: for my $f (@_) { # ignore already removed symbols next SYMBOL if $store->{exclude}{ $f }; my $sub = $cleanee_stash->get_symbol("&$f") or next SYMBOL; my $need_debugger_fixup = FIXUP_NEEDED && $^P && ref(my $globref = \$cleanee_stash->namespace->{$f}) eq 'GLOB' ; if (FIXUP_NEEDED && $need_debugger_fixup) { # convince the Perl debugger to work # see the comment on top of $DebuggerFixup $DebuggerFixup->( $f, $sub, $cleanee_stash, $deleted_stash ||= Package::Stash->new("namespace::clean::deleted::$cleanee"), ); } my @symbols = map { my $name = $_ . $f; my $def = $cleanee_stash->get_symbol($name); defined($def) ? [$name, $def] : () } '$', '@', '%', ''; $cleanee_stash->remove_glob($f); # if this perl needs no renaming trick we need to # rename the original glob after the fact # (see commend of $DebuggerFixup if (FIXUP_NEEDED && !FIXUP_RENAME_SUB && $need_debugger_fixup) { *$globref = $deleted_stash->namespace->{$f}; } $cleanee_stash->add_symbol(@$_) for @symbols; } }; sub clean_subroutines { my ($nc, $cleanee, @subs) = @_; $RemoveSubs->($cleanee, {}, @subs); } =head2 import Makes a snapshot of the current defined functions and installs a L hook in the current scope to invoke the cleanups. =cut sub import { my ($pragma, @args) = @_; my (%args, $is_explicit); ARG: while (@args) { if ($args[0] =~ /^\-/) { my $key = shift @args; my $value = shift @args; $args{ $key } = $value; } else { $is_explicit++; last ARG; } } my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller; if ($is_explicit) { on_scope_end { $RemoveSubs->($cleanee, {}, @args); }; } else { # calling class, all current functions and our storage my $functions = $pragma->get_functions($cleanee); my $store = $pragma->get_class_store($cleanee); my $stash = Package::Stash->new($cleanee); # except parameter can be array ref or single value my %except = map {( $_ => 1 )} ( $args{ -except } ? ( ref $args{ -except } eq 'ARRAY' ? @{ $args{ -except } } : $args{ -except } ) : () ); # register symbols for removal, if they have a CODE entry for my $f (keys %$functions) { next if $except{ $f }; next unless $stash->has_symbol("&$f"); $store->{remove}{ $f } = 1; } # register EOF handler on first call to import unless ($store->{handler_is_installed}) { on_scope_end { $RemoveSubs->($cleanee, $store, keys %{ $store->{remove} }); }; $store->{handler_is_installed} = 1; } return 1; } } =head2 unimport This method will be called when you do a no namespace::clean; It will start a new section of code that defines functions to clean up. =cut sub unimport { my ($pragma, %args) = @_; # the calling class, the current functions and our storage my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller; my $functions = $pragma->get_functions($cleanee); my $store = $pragma->get_class_store($cleanee); # register all unknown previous functions as excluded for my $f (keys %$functions) { next if $store->{remove}{ $f } or $store->{exclude}{ $f }; $store->{exclude}{ $f } = 1; } return 1; } =head2 get_class_store This returns a reference to a hash in a passed package containing information about function names included and excluded from removal. =cut sub get_class_store { my ($pragma, $class) = @_; my $stash = Package::Stash->new($class); my $var = "%$STORAGE_VAR"; $stash->add_symbol($var, {}) unless $stash->has_symbol($var); return $stash->get_symbol($var); } =head2 get_functions Takes a class as argument and returns all currently defined functions in it as a hash reference with the function name as key and a typeglob reference to the symbol as value. =cut sub get_functions { my ($pragma, $class) = @_; my $stash = Package::Stash->new($class); return { map { $_ => $stash->get_symbol("&$_") } $stash->list_all_symbols('CODE') }; } =head1 IMPLEMENTATION DETAILS This module works through the effect that a delete $SomePackage::{foo}; will remove the C symbol from C<$SomePackage> for run time lookups (e.g., method calls) but will leave the entry alive to be called by already resolved names in the package itself. C will restore and therefor in effect keep all glob slots that aren't C. A test file has been added to the perl core to ensure that this behaviour will be stable in future releases. Just for completeness sake, if you want to remove the symbol completely, use C instead. =head1 SEE ALSO L =head1 THANKS Many thanks to Matt S Trout for the inspiration on the whole idea. =head1 AUTHORS =over =item * Robert 'phaylon' Sedlacek =item * Florian Ragwitz =item * Jesse Luehrs =item * Peter Rabbitson =item * Father Chrysostomos =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2011 by L This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut no warnings; 'Danger! Laws of Thermodynamics may not apply.' namespace-clean-0.24/t/0000755000175000017500000000000012057500017014203 5ustar rabbitrabbitnamespace-clean-0.24/t/10-pure-perl.t0000644000175000017500000000223012054734460016526 0ustar rabbitrabbituse strict; use warnings; use Test::More; plan skip_all => "PP tests already executed" if $ENV{NAMESPACE_CLEAN_USE_PP}; eval { require Variable::Magic } or plan skip_all => "PP tests already executed"; $ENV{B_HOOKS_ENDOFSCOPE_IMPLEMENTATION} = 'PP'; require B::Hooks::EndOfScope; ok( ($INC{'B/Hooks/EndOfScope/PP.pm'} && ! $INC{'B/Hooks/EndOfScope/XS.pm'}), 'PP BHEOS loaded properly'); use Config; use FindBin qw($Bin); use IPC::Open2 qw(open2); use File::Glob 'bsd_glob'; # for the $^X-es $ENV{PERL5LIB} = join ($Config{path_sep}, @INC); # rerun the tests under the assumption of pure-perl my $this_file = quotemeta(__FILE__); for my $fn (bsd_glob("$Bin/*.t")) { next if $fn =~ /${this_file}$/; my @cmd = ($^X, $fn); # this is cheating, and may even hang here and there (testing on windows passed fine) # if it does - will have to fix it somehow (really *REALLY* don't want to pull # in IPC::Cmd just for a fucking test) # the alternative would be to have an ENV check in each test to force a subtest open2(my $out, my $in, @cmd); while (my $ln = <$out>) { print " $ln"; } wait; ok (! $?, "Exit $? from: @cmd"); } done_testing; namespace-clean-0.24/t/04-except.t0000644000175000017500000000144111544451264016112 0ustar rabbitrabbit#!/usr/bin/env perl use warnings; use strict; use FindBin; use lib "$FindBin::Bin/lib"; use Test::More tests => 6; { package ExceptWithArray; use ExporterTest qw( foo bar qux ); use namespace::clean -except => [qw( foo bar )]; } ok( ExceptWithArray->can('foo'), 'first of except list still there'); ok( ExceptWithArray->can('bar'), 'second of except list still there'); ok(!ExceptWithArray->can('qux'), 'item not in except list was removed'); { package ExceptWithSingle; use ExporterTest qw( foo bar qux ); use namespace::clean -except => 'qux'; } ok(!ExceptWithSingle->can('foo'), 'first item not in except still there'); ok(!ExceptWithSingle->can('bar'), 'second item not in except still there'); ok( ExceptWithSingle->can('qux'), 'except item was removed'); namespace-clean-0.24/t/00-basic.t0000644000175000017500000000061011544451264015674 0ustar rabbitrabbit#!/usr/bin/env perl use warnings; use strict; use FindBin; use lib "$FindBin::Bin/lib"; use Test::More tests => 4; use ExporterTest qw( foo bar ); BEGIN { ok( main->can('foo'), 'methods are there before cleanup' ); eval { require namespace::clean ;; namespace::clean->import }; ok( !$@, 'module use ok' ); } ok( !main->can($_), "$_ function removed" ) for qw( foo bar ); namespace-clean-0.24/t/09-fiddle-hinthash.t0000644000175000017500000000154411674607532017673 0ustar rabbitrabbituse strict; use warnings; use Test::More 0.88; { package Bar; use sort 'stable'; use namespace::clean; use sort 'stable'; { 1; } Test::More::pass('no segfault'); } { package Foo; BEGIN { $^H{'foo'} = 'bar'; } use namespace::clean; BEGIN { Test::More::is( $^H{'foo'}, 'bar', 'compiletime hinthash intact after n::c' ); } { BEGIN { Test::More::is( $^H{'foo'}, 'bar', 'compile-time hinthash intact in inner scope' ); } 1; } BEGIN { SKIP: { Test::More::skip( 'Tied hinthash values not present in extended caller() on perls older than 5.10' .', regardless of mode (PP or XS)', 1 ) if ($] < 5.010_000); package DB; Test::More::is( ( (caller(0))[10] || {} )->{foo}, 'bar', 'hinthash values visible in caller' ); } } } done_testing; namespace-clean-0.24/t/05-syntax-error.t0000644000175000017500000000033711615146221017274 0ustar rabbitrabbit#!/usr/bin/env perl use warnings; use strict; use FindBin; use lib "$FindBin::Bin/lib"; use Test::More tests => 1; eval { require "SyntaxError.pm" }; like( $@, qr/\Asyntax error at /, 'Syntax Error reported correctly' ); namespace-clean-0.24/t/01-function-wipeout.t0000644000175000017500000000132111615132175020127 0ustar rabbitrabbit#!/usr/bin/env perl use warnings; use strict; use FindBin; use lib "$FindBin::Bin/lib"; use Test::More tests => 9; use_ok('FunctionWipeout'); ok( !FunctionWipeout->can('foo'), 'imported function removed' ); ok( !FunctionWipeout->can('bar'), 'previously declared function removed' ); ok( FunctionWipeout->can('baz'), 'later declared function still exists' ); is( FunctionWipeout->baz, 23, 'removed functions still bound' ); ok( FunctionWipeout->can('qux'), '-except flag keeps import' ); is( FunctionWipeout->qux, 17, 'kept import still works' ); ok( $FunctionWipeout::foo, 'non-code symbol was not removed' ); is( $FunctionWipeout::foo, 777, 'non-code symbol still has correct value' ); namespace-clean-0.24/t/07-debugger.t0000644000175000017500000000125612054734460016414 0ustar rabbitrabbituse Test::More; BEGIN { eval { require Sub::Name } or plan skip_all => "Test requires Sub::Name"; eval { require Sub::Identify } or plan skip_all => "Test requires Sub::Identify"; } BEGIN { # shut up the debugger $ENV{PERLDB_OPTS} = 'NonStop'; # work aroud the regex + P::S::XS buggery on # < 5.8.6 require Package::Stash; } BEGIN { #line 1 #!/usr/bin/perl -d #line 10 } { package Foo; BEGIN { *baz = sub { 42 } } sub foo { 22 } use namespace::clean; sub bar { ::is(baz(), 42); ::is(foo(), 22); } } ok( !Foo->can("foo"), "foo cleaned up" ); ok( !Foo->can("baz"), "baz cleaned up" ); Foo->bar(); done_testing; namespace-clean-0.24/t/08-const-sub.t0000644000175000017500000000025311544451264016543 0ustar rabbitrabbituse strict; use warnings; use Test::More 0.88; use constant CONST => 123; use namespace::clean; my $x = CONST; is $x, 123; ok eval("!defined(&CONST)"); done_testing; namespace-clean-0.24/t/05-explicit-cleanee.t0000644000175000017500000000354211615146221020033 0ustar rabbitrabbit#!/usr/bin/env perl use warnings; use strict; use FindBin; use lib "$FindBin::Bin/lib"; use Test::More tests => 2019; use_ok('CleaneeTarget'); ok CleaneeTarget->can('IGNORED'), 'symbol in exception list still there'; ok CleaneeTarget->can('NOTAWAY'), 'symbol after import call still there'; ok !CleaneeTarget->can('AWAY'), 'normal symbol has disappeared'; ok !CleaneeTarget->can('x_foo'), 'explicitely removed disappeared (1/2)'; ok CleaneeTarget->can('x_bar'), 'not in explicit removal and still there'; ok !CleaneeTarget->can('x_baz'), 'explicitely removed disappeared (2/2)'; ok !CleaneeTarget->can('d_foo'), 'directly removed disappeared (1/2)'; ok CleaneeTarget->can('d_bar'), 'not in direct removal and still there'; ok !CleaneeTarget->can('d_baz'), 'directly removed disappeared (2/2)'; my @values = qw( 23 27 17 XFOO XBAR XBAZ 7 8 9 ); is(CleaneeTarget->summary->[ $_ ], $values[ $_ ], sprintf('testing sub in cleanee (%d/%d)', $_ + 1, scalar @values)) for 0 .. $#values; # some torture SKIP: { skip "This part of the test segfaults perl $] with both tie() and B::H::EOS." . ' Actual code (e.g. DBIx::Class) works fine so did not investigate further', 2000 if $] < 5.008003; local @INC = @INC; my @code; unshift @INC, sub { if ($_[1] =~ /CleaneeTarget\/No(\d+)/) { my @code = ( "package CleaneeTarget::No${1};", "sub x_foo { 'XFOO' }", "sub x_bar { 'XBAR' }", "use CleaneeBridgeExplicit;", "1;", ); return sub { return 0 unless @code; $_ = shift @code; 1; } } else { return (); } }; for (1..1000) { my $pkg = "CleaneeTarget::No${_}"; my @val = require "CleaneeTarget/No${_}.pm"; ok !$pkg->can('x_foo'), 'explicitely removed disappeared'; ok $pkg->can('x_bar'), 'not in explicit removal and still there'; } } namespace-clean-0.24/t/lib/0000755000175000017500000000000012057500017014751 5ustar rabbitrabbitnamespace-clean-0.24/t/lib/Inheritance.pm0000644000175000017500000000041111544451264017545 0ustar rabbitrabbitpackage InheritanceParent; use warnings; use strict; sub foo { 23 } use namespace::clean; sub bar { foo() } package Inheritance; use warnings; use strict; use base 'InheritanceParent'; sub baz { shift->bar } use namespace::clean; sub qux { baz(shift) } 1; namespace-clean-0.24/t/lib/ExporterTest.pm0000644000175000017500000000032011544451264017763 0ustar rabbitrabbitpackage ExporterTest; use warnings; use strict; use base 'Exporter'; use vars qw( @EXPORT_OK $foo ); $foo = 777; @EXPORT_OK = qw( $foo foo bar qux ); sub foo { 23 } sub bar { 12 } sub qux { 17 } 1; namespace-clean-0.24/t/lib/CleaneeTarget.pm0000644000175000017500000000060211544451264020021 0ustar rabbitrabbitpackage CleaneeTarget; use strict; use warnings; sub AWAY { 23 }; sub IGNORED { 27 }; use CleaneeBridge; sub NOTAWAY { 17 }; sub x_foo { 'XFOO' } sub x_bar { 'XBAR' } sub x_baz { 'XBAZ' } use CleaneeBridgeExplicit; sub d_foo { 7 } sub d_bar { 8 } sub d_baz { 9 } sub summary { [AWAY, IGNORED, NOTAWAY, x_foo, x_bar, x_baz, d_foo, d_bar, d_baz] } use CleaneeBridgeDirect; 1; namespace-clean-0.24/t/lib/SyntaxError.pm0000644000175000017500000000007511615146221017613 0ustar rabbitrabbitpackage SyntaxError; use namespace::clean; sub foo { if } 1; namespace-clean-0.24/t/lib/CleaneeBridgeDirect.pm0000644000175000017500000000024311544451264021123 0ustar rabbitrabbitpackage CleaneeBridgeDirect; use strict; use namespace::clean (); sub import { namespace::clean->clean_subroutines(scalar(caller), qw( d_foo d_baz )); } 1; namespace-clean-0.24/t/lib/CleaneeBridge.pm0000644000175000017500000000030711544451264017771 0ustar rabbitrabbitpackage CleaneeBridge; use strict; use warnings; use namespace::clean (); sub import { namespace::clean->import( -cleanee => scalar(caller), -except => 'IGNORED', ); } 1; namespace-clean-0.24/t/lib/FunctionWipeout.pm0000644000175000017500000000026111544451264020461 0ustar rabbitrabbitpackage FunctionWipeout; use warnings; use strict; use ExporterTest qw( foo qux $foo ); sub bar { foo() } use namespace::clean -except => [qw( qux )]; sub baz { bar() } 1; namespace-clean-0.24/t/lib/CleaneeBridgeExplicit.pm0000644000175000017500000000031311544451264021470 0ustar rabbitrabbitpackage CleaneeBridgeExplicit; use strict; use warnings; use namespace::clean (); sub import { namespace::clean->import( -cleanee => scalar(caller), qw( x_foo x_baz ), ); } 1; namespace-clean-0.24/t/lib/Unimport.pm0000644000175000017500000000027511544451264017141 0ustar rabbitrabbitpackage Unimport; use warnings; use strict; sub foo { 23 } use namespace::clean; sub bar { foo() } no namespace::clean; sub baz { bar() } use namespace::clean; sub qux { baz() } 1; namespace-clean-0.24/t/lib/OtherTypes.pm0000644000175000017500000000055411544451264017432 0ustar rabbitrabbitpackage OtherTypes; our $foo = 23; our @foo = "bar"; our %foo = (mouse => "trap"); { no warnings; # perl warns about the bareword foo. If we use *foo instead the # warning goes away, but the *foo{IO} slot doesn't get autoviv'd at # compile time. open foo, "<", $0; } BEGIN { $main::pvio = *foo{IO} } sub foo { 1 } use namespace::clean; 1; namespace-clean-0.24/t/03-unimport.t0000644000175000017500000000073011544451264016476 0ustar rabbitrabbit#!/usr/bin/env perl use warnings; use strict; use FindBin; use lib "$FindBin::Bin/lib"; use Test::More tests => 6; use_ok('Unimport'); ok( !Unimport->can('foo'), 'first function correctly removed' ); ok( Unimport->can('bar'), 'excluded method still in package' ); ok( !Unimport->can('baz'), 'second function correctly removed' ); ok( Unimport->can('qux'), 'last method still in package' ); is( Unimport->qux, 23, 'all functions are still bound' ); namespace-clean-0.24/t/02-inheritance.t0000644000175000017500000000141611615132201017075 0ustar rabbitrabbit#!/usr/bin/env perl use warnings; use strict; use FindBin; use lib "$FindBin::Bin/lib"; use Test::More tests => 10; use_ok('Inheritance'); ok( !InheritanceParent->can('foo'), 'function removed in parent' ); ok( InheritanceParent->can('bar'), 'method still in parent' ); is( InheritanceParent->bar, 23, 'method works, function still bound' ); ok( !Inheritance->can('baz'), 'function removed in subclass' ); ok( Inheritance->can('qux'), 'method still in subclass' ); ok( !Inheritance->can('foo'), 'parent function not available in subclass' ); ok( Inheritance->can('bar'), 'parent method available in subclass' ); is( Inheritance->bar, 23, 'parent method works in subclass' ); is( Inheritance->qux, 23, 'subclass method calls to parent work' ); namespace-clean-0.24/t/06-other-types.t0000644000175000017500000000272111544451264017111 0ustar rabbitrabbit#!/usr/bin/env perl use warnings; use strict; use FindBin; use lib "$FindBin::Bin/lib"; use Test::More tests => 17; our $pvio; use_ok('OtherTypes'); # Since we use use_ok, this is effectively 'compile time'. ok( defined *OtherTypes::foo{SCALAR}, "SCALAR slot intact at compile time" ); ok( defined *OtherTypes::foo{ARRAY}, "ARRAY slot intact at compile time" ); ok( defined *OtherTypes::foo{HASH}, "HASH slot intact at compile time" ); ok( defined *OtherTypes::foo{IO}, "IO slot intact at compile time" ); is( $OtherTypes::foo, 23, "SCALAR slot correct at compile time" ); is( $OtherTypes::foo[0], "bar", "ARRAY slot correct at compile time" ); is( $OtherTypes::foo{mouse}, "trap", "HASH slot correct at compile time" ); is( *OtherTypes::foo{IO}, $pvio, "IO slot correct at compile time" ); eval q{ ok( defined *OtherTypes::foo{SCALAR}, "SCALAR slot intact at run time" ); ok( defined *OtherTypes::foo{ARRAY}, "ARRAY slot intact at run time" ); ok( defined *OtherTypes::foo{HASH}, "HASH slot intact at run time" ); ok( defined *OtherTypes::foo{IO}, "IO slot intact at run time" ); is( $OtherTypes::foo, 23, "SCALAR slot correct at run time" ); is( $OtherTypes::foo[0], "bar", "ARRAY slot correct at run time" ); is( $OtherTypes::foo{mouse}, "trap", "HASH slot correct at run time" ); is( *OtherTypes::foo{IO}, $pvio, "IO slot correct at run time" ); };