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<namespace::clean> 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<no> you can tell C<namespace::clean> to start
-collecting functions for the next C<use namespace::clean;> specification.
-
-You can use the C<-except> flag to tell C<namespace::clean> that you
-don't want it to remove a certain function or method. A common use would
-be a module exporting an C<import> 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<namespace::clean> 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<namespace::clean> together with L<Moose> you want to keep
-the installed C<meta> method. So your classes should look like:
-
- package Foo;
- use Moose;
- use namespace::clean -except => 'meta';
- ...
-
-Same goes for L<Moose::Role>.
-
-=head2 Cleaning other packages
-
-You can tell C<namespace::clean> 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 C<namespace::clean>s discover-and-C<-except> logic, and
-just want to remove subroutines, try L</clean_subroutines>.
-
-=head1 METHODS
-
-=head2 clean_subroutines
-
-This exposes the actual subroutine-removal logic.
-
- namespace::clean->clean_subroutines($cleanee, qw( subA subB ));
-
-will remove C<subA> and C<subB> from C<$cleanee>. Note that this will remove the
-subroutines B<immediately> and not wait for scope end. If you want to have this
-effect at a specific time (e.g. C<namespace::clean> 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
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);
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:
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"),
);
}
# 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};
}
$RemoveSubs->($cleanee, {}, @subs);
}
-=head2 import
-
-Makes a snapshot of the current defined functions and installs a
-L<B::Hooks::EndOfScope> hook in the current scope to invoke the cleanups.
-
-=cut
-
sub import {
my ($pragma, @args) = @_;
# 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 )} (
}
}
-=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) = @_;
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<namespace::clean> 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<no> you can tell C<namespace::clean> to start
+collecting functions for the next C<use namespace::clean;> specification.
+
+You can use the C<-except> flag to tell C<namespace::clean> that you
+don't want it to remove a certain function or method. A common use would
+be a module exporting an C<import> 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<namespace::clean> 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<namespace::clean> together with L<Moose> you want to keep
+the installed C<meta> method. So your classes should look like:
+
+ package Foo;
+ use Moose;
+ use namespace::clean -except => 'meta';
+ ...
+
+Same goes for L<Moose::Role>.
+
+=head2 Cleaning other packages
+
+You can tell C<namespace::clean> 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 C<namespace::clean>s discover-and-C<-except> logic, and
+just want to remove subroutines, try L</clean_subroutines>.
+
+=head1 METHODS
+
+=head2 clean_subroutines
+
+This exposes the actual subroutine-removal logic.
+
+ namespace::clean->clean_subroutines($cleanee, qw( subA subB ));
+
+will remove C<subA> and C<subB> from C<$cleanee>. Note that this will remove the
+subroutines B<immediately> and not wait for scope end. If you want to have this
+effect at a specific time (e.g. C<namespace::clean> 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<B::Hooks::EndOfScope> 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
This software is copyright (c) 2011 by L</AUTHORS>
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.'