X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fnamespace%2Fclean.pm;h=8ac93671c766c9bf4e4a9d44565f3bd3b8723355;hb=b927cca7f4a72f6afecaf1e2d0e6bfddad02f043;hp=a2665a6aeff33e5db36e555e59231fc64127676a;hpb=c86d6ae2ab0a20021037915ea4832cf9d3bf98dd;p=p5sagit%2Fnamespace-clean.git diff --git a/lib/namespace/clean.pm b/lib/namespace/clean.pm index a2665a6..8ac9367 100644 --- a/lib/namespace/clean.pm +++ b/lib/namespace/clean.pm @@ -1,17 +1,41 @@ package namespace::clean; -# ABSTRACT: Keep imports and functions out of your namespace use warnings; use strict; use vars qw( $STORAGE_VAR ); -use Sub::Name 0.04 qw(subname); -use Sub::Identify 0.04 qw(sub_fullname); -use Package::Stash 0.18; -use B::Hooks::EndOfScope 0.07; +use Package::Stash; + +our $VERSION = '0.22'; $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE'; +# FIXME - all of this buggery will migrate to B::H::EOS soon +BEGIN { + # when changing also change in Makefile.PL + my $b_h_eos_req = '0.07'; + + if (! $ENV{NAMESPACE_CLEAN_USE_PP} and eval { + require B::Hooks::EndOfScope; + B::Hooks::EndOfScope->VERSION($b_h_eos_req); + 1 + } ) { + B::Hooks::EndOfScope->import('on_scope_end'); + } + elsif ($] < 5.009_003_1) { + require namespace::clean::_PP_OSE_5_8; + *on_scope_end = \&namespace::clean::_PP_OSE_5_8::on_scope_end; + } + else { + require namespace::clean::_PP_OSE; + *on_scope_end = \&namespace::clean::_PP_OSE::on_scope_end; + } +} + +=head1 NAME + +namespace::clean - Keep imports and functions out of your namespace + =head1 SYNOPSIS package Foo; @@ -71,9 +95,9 @@ be a module exporting an C method along with some functions: 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 Explicitely removing functions when your scope is compiled +=head2 Explicitly removing functions when your scope is compiled -It is also possible to explicitely tell C what packages +It is also possible to explicitly tell C what packages to remove when the surrounding scope has finished compiling. Here is an example: @@ -125,7 +149,9 @@ option like this: If you don't care about Cs discover-and-C<-except> logic, and just want to remove subroutines, try L. -=method clean_subroutines +=head1 METHODS + +=head2 clean_subroutines This exposes the actual subroutine-removal logic. @@ -138,42 +164,112 @@ it is your responsibility to make sure it runs at that time. =cut -my $RemoveSubs = sub { +# 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 = Package::Stash->new("namespace::clean::deleted::$cleanee"); + my $deleted_stash; + SYMBOL: for my $f (@_) { - my $variable = "&$f"; + # ignore already removed symbols next SYMBOL if $store->{exclude}{ $f }; - next SYMBOL unless $cleanee_stash->has_symbol($variable); - - if (ref(\$cleanee_stash->namespace->{$f}) eq 'GLOB') { - # convince the Perl debugger to work - # it assumes that sub_fullname($sub) can always be used to find the CV again - # since we are deleting the glob where the subroutine was originally - # defined, that assumption no longer holds, so we need to move it - # elsewhere and point the CV's name to the new glob. - my $sub = $cleanee_stash->get_symbol($variable); - if ( sub_fullname($sub) eq ($cleanee_stash->name . "::$f") ) { - my $new_fq = $deleted_stash->name . "::$f"; - subname($new_fq, $sub); - $deleted_stash->add_symbol($variable, $sub); - } + 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 ($scalar, $array, $hash, $io) = map { - $cleanee_stash->get_symbol($_ . $f) + my @symbols = map { + my $name = $_ . $f; + my $def = $cleanee_stash->get_symbol($name); + defined($def) ? [$name, $def] : () } '$', '@', '%', ''; + $cleanee_stash->remove_glob($f); - for my $var (['$', $scalar], ['@', $array], ['%', $hash], ['', $io]) { - next unless defined $var->[1]; - $cleanee_stash->add_symbol($var->[0] . $f, $var->[1]); + + # 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; } }; @@ -182,7 +278,7 @@ sub clean_subroutines { $RemoveSubs->($cleanee, {}, @subs); } -=method import +=head2 import Makes a snapshot of the current defined functions and installs a L hook in the current scope to invoke the cleanups. @@ -247,7 +343,7 @@ sub import { } } -=method unimport +=head2 unimport This method will be called when you do a @@ -275,7 +371,7 @@ sub unimport { return 1; } -=method get_class_store +=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. @@ -291,7 +387,7 @@ sub get_class_store { return $stash->get_symbol($var); } -=method get_functions +=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 @@ -334,6 +430,38 @@ L 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;