use warnings;
use strict;
-our $VERSION = '0.25';
+our $VERSION = '0.27';
$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:
# 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
#
+# While the errors manifest themselves inside perl5db.pl, they are caused by
+# problems inside the interpreter. If enabled ($^P & 0x01) and existent,
+# the DB::sub sub will be called by the interpreter for any sub call rather
+# that call the sub directly. It is provided the real sub to call in $DB::sub,
+# but the value given has the issues described above. We only have to enable
+# the workaround if DB::sub will be used.
+#
# 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 $cleanee_stash = \%{"${cleanee}::"};
+ my $deleted_stash_name;
my $deleted_stash;
+ no strict 'refs';
SYMBOL:
for my $f (@_) {
# ignore already removed symbols
next SYMBOL if $store->{exclude}{ $f };
- my $sub = $cleanee_stash->get_symbol("&$f")
- or next SYMBOL;
+ next SYMBOL
+ unless exists &{"${cleanee}::$f"};
+
+ my $sub = \&{"${cleanee}::$f"};
my $need_debugger_fixup =
( DEBUGGER_NEEDS_CV_RENAME or DEBUGGER_NEEDS_CV_PIVOT )
&&
- $^P
+ $^P & 0x01
+ &&
+ defined &DB::sub
+ &&
+ ref(my $globref = \$cleanee_stash->{$f}) eq 'GLOB'
&&
- ref(my $globref = \$cleanee_stash->namespace->{$f}) eq 'GLOB'
+ ( $deleted_stash_name ||= "namespace::clean::deleted::$cleanee" )
&&
- ( $deleted_stash ||= stash_for("namespace::clean::deleted::$cleanee") )
+ ( $deleted_stash ||= \%{"${deleted_stash_name}::"} )
;
# convince the Perl debugger to work
#
# Do not be surprised that they are missing without DEBUGGER_NEEDS_CV_RENAME
#
- namespace::clean::_Util::get_subname( $sub ) eq ( $cleanee_stash->name . "::$f" )
+ namespace::clean::_Util::get_subname( $sub ) eq ( $cleanee . "::$f" )
and
- $deleted_stash->add_symbol(
- "&$f",
- namespace::clean::_Util::set_subname( $deleted_stash->name . "::$f", $sub ),
- );
+ *{"${deleted_stash_name}::$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);
+ *{"${deleted_stash_name}::$f"} = $sub;
}
- my @symbols = map {
- my $name = $_ . $f;
- my $def = $cleanee_stash->get_symbol($name);
- defined($def) ? [$name, $def] : ()
- } '$', '@', '%', '';
- $cleanee_stash->remove_glob($f);
+ my @symbols = do {
+ my $glob = *{"${cleanee}::$f"};
+ grep defined,
+ map *{$glob}{$_},
+ qw(SCALAR ARRAY HASH IO);
+ };
+
+ delete $cleanee_stash->{$f};
# if this perl needs no renaming trick we need to
# rename the original glob after the fact
and
$need_debugger_fixup
and
- *$globref = $deleted_stash->namespace->{$f};
+ *$globref = $deleted_stash->{$f};
- $cleanee_stash->add_symbol(@$_) for @symbols;
+ *{"${cleanee}::$f"} = $_ for @symbols;
}
};
# 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 )} (
# 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");
+ next unless exists &{"${cleanee}::$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;
- }
+ on_scope_end {
+ $RemoveSubs->($cleanee, $store, keys %{ $store->{remove} });
+ };
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);
+ no strict 'refs';
+ return \%{"${class}::${STORAGE_VAR}"};
}
sub get_functions {
my ($pragma, $class) = @_;
- my $stash = stash_for($class);
+ no strict 'refs';
return {
- map { $_ => $stash->get_symbol("&$_") }
- $stash->list_all_symbols('CODE')
+ map +($_ => \&{"${class}::$_"}),
+ grep exists &{"${class}::$_"},
+ sort keys %{"${class}::"}
};
}
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<technique used by this module|/IMPLEMENTATION DETAILS> 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<sort SUBNAME|perlfunc/sort> style of
+the C<sort> built-in invocation. The following example will not work, because
+C<sort> does not try to resolve the function name to an actual code reference
+until B<runtime>.
+
+ 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 'my_sorter';
+ use namespace::clean;
+
+ my $my_sorter_cref = \&my_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<namespace::clean> what packages