namespace-clean-0.26/0000755000175000017500000000000012605254711013750 5ustar rabbitrabbitnamespace-clean-0.26/t/0000755000175000017500000000000012605254711014213 5ustar rabbitrabbitnamespace-clean-0.26/t/lib/0000755000175000017500000000000012605254711014761 5ustar rabbitrabbitnamespace-clean-0.26/t/lib/CleaneeBridgeDirect.pm0000644000175000017500000000024312167142262021122 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.26/t/lib/Inheritance.pm0000644000175000017500000000041112305604043017536 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.26/t/lib/FunctionWipeout.pm0000644000175000017500000000026112305604043020452 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.26/t/lib/CleaneeTarget.pm0000644000175000017500000000060212167142262020020 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.26/t/lib/ExporterTest.pm0000644000175000017500000000032012167142262017762 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.26/t/lib/Unimport.pm0000644000175000017500000000027512167142262017140 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.26/t/lib/CleaneeBridge.pm0000644000175000017500000000030712167142262017770 0ustar rabbitrabbitpackage CleaneeBridge; use strict; use warnings; use namespace::clean (); sub import { namespace::clean->import( -cleanee => scalar(caller), -except => 'IGNORED', ); } 1; namespace-clean-0.26/t/lib/OtherTypes.pm0000644000175000017500000000055412167142262017431 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.26/t/lib/SyntaxError.pm0000644000175000017500000000007512167142262017621 0ustar rabbitrabbitpackage SyntaxError; use namespace::clean; sub foo { if } 1; namespace-clean-0.26/t/lib/CleaneeBridgeExplicit.pm0000644000175000017500000000031312167142262021467 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.26/t/00-basic.t0000644000175000017500000000061012167142262015673 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.26/t/02-inheritance.t0000644000175000017500000000141612167142262017112 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.26/t/10-pure-perl.t0000644000175000017500000000361212603127175016534 0ustar rabbitrabbituse strict; use warnings; use Test::More; BEGIN { plan skip_all => "PP tests already executed" if $ENV{NAMESPACE_CLEAN_USE_PP}; plan skip_all => "B::Hooks::EndOfScope ($INC{'B/Hooks/EndOfScope.pm'}) loaded before the test even started >.<" if $INC{'B/Hooks/EndOfScope.pm'}; plan skip_all => "Package::Stash ($INC{'Package/Stash.pm'}) loaded before the test even started >.<" if $INC{'Package/Stash.pm'}; eval { require Variable::Magic } or plan skip_all => "PP tests already executed"; $ENV{B_HOOKS_ENDOFSCOPE_IMPLEMENTATION} = 'PP'; $ENV{PACKAGE_STASH_IMPLEMENTATION} = 'PP'; } use B::Hooks::EndOfScope 0.12; use Package::Stash; ok( ($INC{'B/Hooks/EndOfScope/PP.pm'} && ! $INC{'B/Hooks/EndOfScope/XS.pm'}), 'PP BHEOS loaded properly' ) || diag join "\n", map { sprintf '%s => %s', $_, $INC{"B/Hooks/$_"} || 'undef' } qw|EndOfScope.pm EndOfScope/XS.pm EndOfScope/PP.pm| ; ok( ($INC{'Package/Stash/PP.pm'} && ! $INC{'Package/Stash/XS.pm'}), 'PP Package::Stash loaded properly' ) || diag join "\n", map { sprintf '%s => %s', $_, $INC{"Package/$_"} || 'undef' } qw|Stash.pm Stash/XS.pm Stash/PP.pm| ; 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.26/t/03-unimport.t0000644000175000017500000000073012167142262016475 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.26/t/05-explicit-cleanee.t0000644000175000017500000000354212167142262020041 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.26/t/04-except.t0000644000175000017500000000144112167142262016111 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.26/t/09-fiddle-hinthash.t0000644000175000017500000000154412167142262017665 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.26/t/01-function-wipeout.t0000644000175000017500000000132112305604043020124 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.26/t/05-syntax-error.t0000644000175000017500000000033712167142262017302 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.26/t/06-other-types.t0000644000175000017500000000272112167142262017110 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" ); }; namespace-clean-0.26/t/08-const-sub.t0000644000175000017500000000025312167142262016542 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.26/t/07-debugger.t0000644000175000017500000000120112605132677016410 0ustar rabbitrabbituse Test::More; BEGIN { require namespace::clean; if ( namespace::clean::_Util::DEBUGGER_NEEDS_CV_RENAME() and my $missing_xs = namespace::clean::_Util::_namer_load_error() ) { plan skip_all => $missing_xs; } } BEGIN { # shut up the debugger $ENV{PERLDB_OPTS} = 'NonStop'; } 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.26/lib/0000755000175000017500000000000012605254711014516 5ustar rabbitrabbitnamespace-clean-0.26/lib/namespace/0000755000175000017500000000000012605254711016452 5ustar rabbitrabbitnamespace-clean-0.26/lib/namespace/clean.pm0000644000175000017500000003112312605254670020076 0ustar rabbitrabbitpackage namespace::clean; use warnings; use strict; our $VERSION = '0.26'; $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases our $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE'; use B::Hooks::EndOfScope 'on_scope_end'; # FIXME This is a crock of shit, needs to go away # currently here to work around https://rt.cpan.org/Ticket/Display.html?id=74151 # kill with fire when PS::XS is *finally* fixed BEGIN { my $provider; if ( $] < 5.008007 ) { require Package::Stash::PP; $provider = 'Package::Stash::PP'; } else { require Package::Stash; $provider = 'Package::Stash'; } eval <<"EOS" or die $@; sub stash_for (\$) { $provider->new(\$_[0]); } 1; EOS } use namespace::clean::_Util qw( DEBUGGER_NEEDS_CV_RENAME DEBUGGER_NEEDS_CV_PIVOT ); # Built-in debugger CV-retrieval fixups necessary before perl 5.15.5: # since we are deleting the glob where the subroutine was originally # defined, the assumptions below no longer hold. # # In 5.8.9 ~ 5.13.5 (inclusive) the debugger assumes that a CV can # always be found under sub_fullname($sub) # Workaround: use sub naming to properly name the sub hidden in the package's # deleted-stash # # In the rest of the range ( ... ~ 5.8.8 and 5.13.6 ~ 5.15.4 ) the debugger # assumes the name of the glob passed to entersub can be used to find the CV # Workaround: realias the original glob to the deleted-stash slot # # Can not tie constants to the current value of $^P directly, # as the debugger can be enabled during runtime (kinda dubious) # my $RemoveSubs = sub { my $cleanee = shift; my $store = shift; my $cleanee_stash = stash_for($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 = ( DEBUGGER_NEEDS_CV_RENAME or DEBUGGER_NEEDS_CV_PIVOT ) && $^P && ref(my $globref = \$cleanee_stash->namespace->{$f}) eq 'GLOB' && ( $deleted_stash ||= stash_for("namespace::clean::deleted::$cleanee") ) ; # convince the Perl debugger to work # see the comment on top if ( DEBUGGER_NEEDS_CV_RENAME and $need_debugger_fixup ) { # # Note - both get_subname and set_subname are only compiled when CV_RENAME # is true ( the 5.8.9 ~ 5.12 range ). On other perls this entire block is # constant folded away, and so are the definitions in ::_Util # # Do not be surprised that they are missing without DEBUGGER_NEEDS_CV_RENAME # namespace::clean::_Util::get_subname( $sub ) eq ( $cleanee_stash->name . "::$f" ) and $deleted_stash->add_symbol( "&$f", namespace::clean::_Util::set_subname( $deleted_stash->name . "::$f", $sub ), ); } elsif ( DEBUGGER_NEEDS_CV_PIVOT and $need_debugger_fixup ) { $deleted_stash->add_symbol("&$f", $sub); } 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 DEBUGGER_NEEDS_CV_PIVOT and $need_debugger_fixup and *$globref = $deleted_stash->namespace->{$f}; $cleanee_stash->add_symbol(@$_) for @symbols; } }; sub clean_subroutines { my ($nc, $cleanee, @subs) = @_; $RemoveSubs->($cleanee, {}, @subs); } 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 = stash_for($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; } } 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; } sub get_class_store { my ($pragma, $class) = @_; my $stash = stash_for($class); my $var = "%$STORAGE_VAR"; $stash->add_symbol($var, {}) unless $stash->has_symbol($var); return $stash->get_symbol($var); } sub get_functions { my ($pragma, $class) = @_; my $stash = stash_for($class); return { map { $_ => $stash->get_symbol("&$_") } $stash->list_all_symbols('CODE') }; } 'Danger! Laws of Thermodynamics may not apply.' __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. =head3 Late binding caveat Note that the L relies on perl having resolved all names to actual code references during the compilation of a scope. While this is almost always what the interpreter does, there are some exceptions, notably the L style of the C built-in invocation. The following example will not work, because C does not try to resolve the function name to an actual code reference until B. use MyApp::Utils 'my_sorter'; use namespace::clean; my @sorted = sort my_sorter @list; You need to work around this by forcing a compile-time resolution like so: use MyApp::Utils 'sorter'; use namespace::clean; my $my_sorter_cref = \&sorter; my @sorted = sort $my_sorter_cref @list; =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. =head2 import Makes a snapshot of the current defined functions and installs a L hook in the current scope to invoke the cleanups. =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. =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. =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. =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. namespace-clean-0.26/lib/namespace/clean/0000755000175000017500000000000012605254711017534 5ustar rabbitrabbitnamespace-clean-0.26/lib/namespace/clean/_Util.pm0000644000175000017500000000547212605141356021156 0ustar rabbitrabbit### !!!ACHTUNG!!! # # This module is to be loaded at configure time straight from the Makefile.PL # in order to get access to some of the constants / utils # None of the dependencies will be available yet at this point, so make # sure to never use anything beyond what the minimum supported perl came with # (no, relying on configure_requires is not ok) package # hide from the pauses namespace::clean::_Util; use warnings; use strict; use base 'Exporter'; our @EXPORT_OK = qw( DEBUGGER_NEEDS_CV_RENAME DEBUGGER_NEEDS_CV_PIVOT ); use constant DEBUGGER_NEEDS_CV_RENAME => ( ( $] > 5.008_008 ) and ( $] < 5.013_006 ) ); use constant DEBUGGER_NEEDS_CV_PIVOT => ( ( ! DEBUGGER_NEEDS_CV_RENAME ) and ( $] < 5.015_005 ) ); # FIXME - ideally this needs to be provided by some abstraction lib # but we don't have that yet BEGIN { # # Note - both get_subname and set_subname are only called by one block # which is compiled away unless CV_RENAME is true ( the 5.8.9 ~ 5.12 range ). # Hence we compile/provide the definitions here only when needed # DEBUGGER_NEEDS_CV_RENAME and ( eval <<'EOS' or die $@ ); { my( $sub_name_loaded, $sub_util_loaded ); sub _namer_load_error { return '' if $sub_util_loaded or $sub_name_loaded; # if S::N is loaded first *and* so is B - then go with that, otherwise # prefer Sub::Util as S::U will provide a faster get_subname and will # not need further require() calls # this is rather arbitrary but remember this code exists only perls # between 5.8.9 ~ 5.13.5 # when changing version also change in Makefile.PL my $sn_ver = 0.04; local $@; my $err = ''; ( ! ( $INC{"B.pm"} and $INC{"Sub/Name.pm"} and eval { Sub::Name->VERSION($sn_ver) } ) and eval { require Sub::Util } and # see https://github.com/moose/Moo/commit/dafa5118 defined &Sub::Util::set_subname and $sub_util_loaded = 1 ) or ( eval { require Sub::Name and Sub::Name->VERSION($sn_ver) } and $sub_name_loaded = 1 ) or $err = "When running under -d on this perl $], namespace::clean requires either Sub::Name $sn_ver or Sub::Util to be installed" ; $err; } sub set_subname { if( my $err = _namer_load_error() ) { die $err; } elsif( $sub_name_loaded ) { &Sub::Name::subname; } elsif( $sub_util_loaded ) { &Sub::Util::set_subname; } else { die "How the fuck did we get here? Read source and debug please!"; } } sub get_subname { if( _namer_load_error() or ! $sub_util_loaded ) { require B; my $gv = B::svref_2object( $_[0] )->GV; join '::', $gv->STASH->NAME, $gv->NAME; } else { &Sub::Util::subname; } } } 1; EOS } 1; namespace-clean-0.26/Changes0000644000175000017500000001240512605254653015252 0ustar rabbitrabbit0.26 2015-10-07 17:43 (UTC) - Exclusively use Package::Stash::PP on perls < 5.8.7 until a fixed Package::Stash::XS ships - breakage keeps getting reintroduced ( RT#107343, RT#74151 ) - Explicitly document the late runtime binding of `sort SUBNAME ...` ( RT#101247 ) - No longer rely on Sub::Identify - either use Sub::Util or B ( should solve RT#96945 ) 0.25 2014-03-05 11:27 (UTC) - Fix incorrect ExtUtils::CBuilder detection routine leading to Makefile.PL crashes when EU::CB is not available 0.24 2012-12-04 22:59 (UTC) - 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 2012-03-11 15:06 (UTC) - 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) 2011-12-26 13:04 (UTC) - 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 2011-12-22 11:33 (UTC) - 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 2011-12-21 11:39 (UTC) - 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 2011-08-03 21:51 (UTC) - 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) 2011-07-31 09:26 (UTC) - 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 2011-01-06 18:07 (UTC) - Bump Package::Stash dependency to 0.22 to pull in a bugfix in Package::Stash::XS 0.19. 0.19 2011-01-03 16:36 (UTC) - 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 2010-06-13 17:12 (UTC) - Make sure we continue working on future Package::Stash versions (doy). 0.17 2010-06-05 23:16 (UTC) - Make sure the debugger author test is skipped for non-authors before the debugger is even loaded. 0.16 2010-06-05 20:53 (UTC) - Release all changes of 0.15 as part of a stable release. - Convert from Module::Install to Dist::Zilla. 0.15 TRIAL release 2010-05-14 17:30 (UTC) - Use Package::Stash for the stash manipulation bits (doy). 0.14 2010-03-18 11:15:38 (CET) - Disable auto_install. - Turn the error prone debugger test into an author test. 0.13 2010-01-17 02:40:48 (CET) - Skip failing debugger tests on 5.8.8 and older. 0.12 2010-01-14 03:22:03 (CET) - 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 2009-03-03 17:34:49 (CET) - Added -cleanee option to specify the package to clean (Closes RT#41850). - Added n:c->clean_subroutines($cleanee, @subs). 0.10 2009-02-20 14:31:36 (CET) - Depend on B::Hooks::EndOfScope 0.07 to avoid segfaults and lost error messages when something goes wrong. 0.09 2008-10-22 17:48:49 (CEST) - Use B::Hooks::EndOfScope instead of %^H + Scope::Guard. 0.08 2008-03-09 22:01:01 (CET) - Added explicit cleanup behaviour 0.07 2008-03-09 20:13:33 (CET) - Switched from Filter::EOF to a much saner implementation via %^H and Scope::Guard. (mst & autobox)++ for this. 0.06 2008-02-20 15:09:00 (CET) - Fixed 'uninitialized value in ref-to-glob cast' error if unimport was used before. 0.05 2007-08-12 18:24:49 (CEST) - Minor POD improvements - -except now accepts a single value too 0.04 2007-03-17 16:22:10 (CET) - Added -except flag - Non-CODE type slots will not be removed 0.03 2007-02-24 22:34:55 (CET) - Minor comment and POD cleanups - Tried to clarify how the module works 0.02 2007-02-19 00:38:24 (CET) - Added unimport behaviour 0.01 2007-02-18 17:33:18 (CET) - Initial Version namespace-clean-0.26/MANIFEST0000644000175000017500000000132512605254711015102 0ustar rabbitrabbitChanges lib/namespace/clean.pm lib/namespace/clean/_Util.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.26/Makefile.PL0000644000175000017500000001260212603127175015724 0ustar rabbitrabbituse strict; use warnings; use 5.008001; my %META = ( name => 'namespace::clean', license => 'perl_5', abstract => 'Keep imports and functions out of your namespace', author => [ 'Robert \'phaylon\' Sedlacek ', 'Florian Ragwitz ', 'Jesse Luehrs ', 'Peter Rabbitson ', 'Father Chrysostomos ', ], prereqs => { configure => { requires => { 'ExtUtils::MakeMaker' => 0, 'ExtUtils::CBuilder' => 0.27, } }, runtime => { requires => { 'Package::Stash' => '0.23', 'B::Hooks::EndOfScope' => '0.12', 'perl' => '5.008001', }, }, test => { requires => { 'Test::More' => '0.88', } }, }, resources => { x_IRC => 'irc://irc.perl.org/#toolchain', homepage => 'http://search.cpan.org/dist/namespace-clean', 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', }, }, ); my %MM_ARGS = ( ( # a sub-namer is needed if using the debugger on some perls require 'lib/namespace/clean/_Util.pm' and namespace::clean::_Util::DEBUGGER_NEEDS_CV_RENAME() and namespace::clean::_Util::_namer_load_error() and can_xs() ) # when changing version, also change $sn_ver in namespace/clean/_Util.pm ? ( PREREQ_PM => { 'Sub::Name' => '0.04' } ) : () ); ## BOILERPLATE ############################################################### require ExtUtils::MakeMaker; # have to do this since old EUMM dev releases miss the eval $VERSION line my $eumm_version = eval $ExtUtils::MakeMaker::VERSION; my $mymeta = $eumm_version >= 6.57_02; my $mymeta_broken = $mymeta && $eumm_version < 6.57_07; ($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g; ($MM_ARGS{VERSION_FROM} = "lib/$MM_ARGS{NAME}.pm") =~ s{::}{/}g; $META{license} = [ $META{license} ] if $META{license} && !ref $META{license}; $MM_ARGS{LICENSE} = $META{license}[0] if $META{license} && $eumm_version >= 6.30; $MM_ARGS{NO_MYMETA} = 1 if $mymeta_broken; $MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META } unless -f 'META.yml'; for (qw(configure build test runtime)) { my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; my $r = $MM_ARGS{$key} = { %{$META{prereqs}{$_}{requires} || {}}, %{delete $MM_ARGS{$key} || {}}, }; defined $r->{$_} or delete $r->{$_} for keys %$r; } $MM_ARGS{MIN_PERL_VERSION} = delete $MM_ARGS{PREREQ_PM}{perl} || 0; delete $MM_ARGS{MIN_PERL_VERSION} if $eumm_version < 6.47_01; $MM_ARGS{BUILD_REQUIRES} = {%{$MM_ARGS{BUILD_REQUIRES}}, %{delete $MM_ARGS{TEST_REQUIRES}}} if $eumm_version < 6.63_03; $MM_ARGS{PREREQ_PM} = {%{$MM_ARGS{PREREQ_PM}}, %{delete $MM_ARGS{BUILD_REQUIRES}}} if $eumm_version < 6.55_01; delete $MM_ARGS{CONFIGURE_REQUIRES} if $eumm_version < 6.51_03; ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS); ## END BOILERPLATE ########################################################### # FIXME # Need to replace with EU::HC, but too many changes for this release already ########################################### # 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; } require File::Spec; 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; } # Can our C compiler environment build XS files sub can_xs { # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder; ExtUtils::CBuilder->VERSION(0.27)"; 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(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } namespace-clean-0.26/META.yml0000644000175000017500000000206512605254711015224 0ustar rabbitrabbit--- abstract: 'Keep imports and functions out of your namespace' author: - "Robert 'phaylon' Sedlacek " - 'Florian Ragwitz ' - 'Jesse Luehrs ' - 'Peter Rabbitson ' - 'Father Chrysostomos ' build_requires: Test::More: '0.88' configure_requires: ExtUtils::CBuilder: '0.27' ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.150005' 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' perl: '5.008001' resources: IRC: irc://irc.perl.org/#toolchain 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.26' x_serialization_backend: 'CPAN::Meta::YAML version 0.016' namespace-clean-0.26/META.json0000644000175000017500000000342512605254711015375 0ustar rabbitrabbit{ "abstract" : "Keep imports and functions out of your namespace", "author" : [ "Robert 'phaylon' Sedlacek ", "Florian Ragwitz ", "Jesse Luehrs ", "Peter Rabbitson ", "Father Chrysostomos " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.150005", "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" : {}, "configure" : { "requires" : { "ExtUtils::CBuilder" : "0.27", "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "B::Hooks::EndOfScope" : "0.12", "Package::Stash" : "0.23", "perl" : "5.008001" } }, "test" : { "requires" : { "Test::More" : "0.88" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-namespace-clean@rt.cpan.org", "web" : "http://rt.cpan.org/Public/Dist/Display.html?Name=namespace-clean" }, "homepage" : "http://search.cpan.org/dist/namespace-clean", "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" }, "x_IRC" : "irc://irc.perl.org/#toolchain" }, "version" : "0.26", "x_serialization_backend" : "JSON::PP version 2.27203" }