X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fnamespace%2Fclean.pm;h=5d41c9de630c8e0b164cfce5abd0748398c1909e;hb=39dbc69b27dbf7800719b3e60a9042b9a1ae58f8;hp=f8fcf21309cae8a6dcbf4dfd730c03e9e89dbe7b;hpb=b5f1720124defc02ef78a6639ea9106b646bde76;p=p5sagit%2Fnamespace-clean.git diff --git a/lib/namespace/clean.pm b/lib/namespace/clean.pm index f8fcf21..5d41c9d 100644 --- a/lib/namespace/clean.pm +++ b/lib/namespace/clean.pm @@ -3,176 +3,38 @@ package namespace::clean; use warnings; use strict; -use vars qw( $STORAGE_VAR ); -use Package::Stash; +our $VERSION = '0.25'; +our $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE'; -our $VERSION = '0.21_02'; +use B::Hooks::EndOfScope 'on_scope_end'; -$STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE'; - -# FIXME - all of this buggery will migrate to B::H::EOS soon +# 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 { - # 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_9) { - 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; - 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 + my $provider; - # 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; + if ( $] < 5.008007 ) { + require Package::Stash::PP; + $provider = 'Package::Stash::PP'; } - - # 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', - ); + else { + require Package::Stash; + $provider = 'Package::Stash'; } + eval <<"EOS" or die $@; -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. +sub stash_for (\$) { + $provider->new(\$_[0]); +} -=cut +1; -# 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_006_1; -{ - no strict; - delete ${__PACKAGE__."::"}{FIXUP_NEEDED}; - delete ${__PACKAGE__."::"}{FIXUP_RENAME_SUB}; +EOS } +use namespace::clean::_Util qw( DEBUGGER_NEEDS_CV_RENAME DEBUGGER_NEEDS_CV_PIVOT ); + # Debugger fixup necessary before perl 5.15.5 # # In perl 5.8.9-5.12, it assumes that sub_fullname($sub) can @@ -191,29 +53,20 @@ 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); - } + if (DEBUGGER_NEEDS_CV_RENAME) { + # + # 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 ), + ); } else { $deleted_stash->add_symbol("&$f", $sub); @@ -223,7 +76,7 @@ my $DebuggerFixup = sub { my $RemoveSubs = sub { my $cleanee = shift; my $store = shift; - my $cleanee_stash = Package::Stash->new($cleanee); + my $cleanee_stash = stash_for($cleanee); my $deleted_stash; SYMBOL: @@ -236,21 +89,21 @@ my $RemoveSubs = sub { or next SYMBOL; my $need_debugger_fixup = - FIXUP_NEEDED + ( DEBUGGER_NEEDS_CV_RENAME or DEBUGGER_NEEDS_CV_PIVOT ) && $^P && ref(my $globref = \$cleanee_stash->namespace->{$f}) eq 'GLOB' ; - if (FIXUP_NEEDED && $need_debugger_fixup) { + if ($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"), + $deleted_stash ||= stash_for("namespace::clean::deleted::$cleanee"), ); } @@ -265,7 +118,7 @@ my $RemoveSubs = sub { # 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) { + if (DEBUGGER_NEEDS_CV_PIVOT && $need_debugger_fixup) { *$globref = $deleted_stash->namespace->{$f}; } @@ -278,13 +131,6 @@ sub clean_subroutines { $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) = @_; @@ -315,7 +161,7 @@ sub import { # 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); + my $stash = stash_for($cleanee); # except parameter can be array ref or single value my %except = map {( $_ => 1 )} ( @@ -343,16 +189,6 @@ sub import { } } -=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) = @_; @@ -371,40 +207,184 @@ sub unimport { 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 $stash = stash_for($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); + 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. + +=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 @@ -461,8 +441,3 @@ Father Chrysostomos 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.'