1 package namespace::clean;
2 # ABSTRACT: Keep imports and functions out of your namespace
7 use vars qw( $STORAGE_VAR );
10 our $VERSION = '0.21';
12 $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
19 # when changing also change in Makefile.PL
20 my $b_h_eos_req = '0.07';
23 require B::Hooks::EndOfScope;
24 B::Hooks::EndOfScope->VERSION($b_h_eos_req);
27 B::Hooks::EndOfScope->import('on_scope_end');
30 eval <<'PP' or die $@;
35 package namespace::clean::_TieHintHash;
40 use base 'Tie::ExtraHash';
44 package namespace::clean::_ScopeGuard;
49 sub arm { bless [ $_[1] ] }
51 sub DESTROY { $_[0]->[0]->() }
55 sub on_scope_end (&) {
58 if( my $stack = tied( %^H ) ) {
59 if ( (my $c = ref $stack) ne 'namespace::clean::_TieHintHash') {
61 ========================================================================
62 !!! F A T A L E R R O R !!!
64 foreign tie() of %^H detected
65 ========================================================================
67 namespace::clean is currently operating in pure-perl fallback mode, because
68 your system is lacking the necessary dependency B::Hooks::EndOfScope $b_h_eos_req.
69 In this mode namespace::clean expects to be able to tie() the hinthash %^H,
70 however it is apparently already tied by means unknown to the tie-class
73 Since this is a no-win situation execution will abort here and now. Please
74 try to find out which other module is relying on hinthash tie() ability,
75 and file a bug for both the perpetrator and namespace::clean, so that the
76 authors can figure out an acceptable way of moving forward.
80 push @$stack, namespace::clean::_ScopeGuard->arm(shift);
83 tie( %^H, 'namespace::clean::_TieHintHash', namespace::clean::_ScopeGuard->arm(shift) );
96 namespace::clean - Keep imports and functions out of your namespace
104 use Carp qw(croak); # 'croak' will be removed
106 sub bar { 23 } # 'bar' will be removed
108 # remove all previously defined functions
109 use namespace::clean;
111 sub baz { bar() } # 'baz' still defined, 'bar' still bound
113 # begin to collection function names from here again
116 sub quux { baz() } # 'quux' will be removed
118 # remove all functions defined after the 'no' unimport
119 use namespace::clean;
121 # Will print: 'No', 'No', 'Yes' and 'No'
122 print +(__PACKAGE__->can('croak') ? 'Yes' : 'No'), "\n";
123 print +(__PACKAGE__->can('bar') ? 'Yes' : 'No'), "\n";
124 print +(__PACKAGE__->can('baz') ? 'Yes' : 'No'), "\n";
125 print +(__PACKAGE__->can('quux') ? 'Yes' : 'No'), "\n";
131 =head2 Keeping packages clean
133 When you define a function, or import one, into a Perl package, it will
134 naturally also be available as a method. This does not per se cause
135 problems, but it can complicate subclassing and, for example, plugin
136 classes that are included via multiple inheritance by loading them as
139 The C<namespace::clean> pragma will remove all previously declared or
140 imported symbols at the end of the current package's compile cycle.
141 Functions called in the package itself will still be bound by their
142 name, but they won't show up as methods on your class or instances.
144 By unimporting via C<no> you can tell C<namespace::clean> to start
145 collecting functions for the next C<use namespace::clean;> specification.
147 You can use the C<-except> flag to tell C<namespace::clean> that you
148 don't want it to remove a certain function or method. A common use would
149 be a module exporting an C<import> method along with some functions:
151 use ModuleExportingImport;
152 use namespace::clean -except => [qw( import )];
154 If you just want to C<-except> a single sub, you can pass it directly.
155 For more than one value you have to use an array reference.
157 =head2 Explicitly removing functions when your scope is compiled
159 It is also possible to explicitly tell C<namespace::clean> what packages
160 to remove when the surrounding scope has finished compiling. Here is an
166 # blessed NOT available
169 use Scalar::Util qw( blessed );
170 use namespace::clean qw( blessed );
173 return blessed shift;
176 # blessed NOT available
180 When using C<namespace::clean> together with L<Moose> you want to keep
181 the installed C<meta> method. So your classes should look like:
185 use namespace::clean -except => 'meta';
188 Same goes for L<Moose::Role>.
190 =head2 Cleaning other packages
192 You can tell C<namespace::clean> that you want to clean up another package
193 instead of the one importing. To do this you have to pass in the C<-cleanee>
196 package My::MooseX::namespace::clean;
199 use namespace::clean (); # no cleanup, just load
202 namespace::clean->import(
203 -cleanee => scalar(caller),
208 If you don't care about C<namespace::clean>s discover-and-C<-except> logic, and
209 just want to remove subroutines, try L</clean_subroutines>.
213 =head2 clean_subroutines
215 This exposes the actual subroutine-removal logic.
217 namespace::clean->clean_subroutines($cleanee, qw( subA subB ));
219 will remove C<subA> and C<subB> from C<$cleanee>. Note that this will remove the
220 subroutines B<immediately> and not wait for scope end. If you want to have this
221 effect at a specific time (e.g. C<namespace::clean> acts on scope compile end)
222 it is your responsibility to make sure it runs at that time.
226 # Constant to optimise away the unused code branches
227 use constant RENAME_SUB => $] > 5.008_008_9 && $] < 5.013_006_1;
228 { no strict; delete ${__PACKAGE__."::"}{RENAME_SUB} }
230 # In perl 5.8.9-5.12, it assumes that sub_fullname($sub) can
231 # always be used to find the CV again.
232 # In perl 5.8.8 and 5.14, it assumes that the name of the glob
233 # passed to entersub can be used to find the CV.
234 # since we are deleting the glob where the subroutine was originally
235 # defined, those assumptions no longer hold.
237 # So in 5.8.9-5.12 we need to move it elsewhere and point the
238 # CV's name to the new glob.
240 # In 5.8.8 and 5.14 we move it elsewhere and rename the
241 # original glob by assigning the new glob back to it.
242 my $sub_utils_loaded;
243 my $DebuggerFixup = sub {
244 my ($f, $sub, $cleanee_stash, $deleted_stash) = @_;
247 if (! defined $sub_utils_loaded ) {
248 $sub_utils_loaded = do {
250 eval { require Sub::Name; Sub::Name->VERSION($sn_ver) }
251 or die "Sub::Name $sn_ver required when running under -d or equivalent: $@";
254 eval { require Sub::Identify; Sub::Identify->VERSION($si_ver) }
255 or die "Sub::Identify $si_ver required when running under -d or equivalent: $@";
261 if ( Sub::Identify::sub_fullname($sub) eq ($cleanee_stash->name . "::$f") ) {
262 my $new_fq = $deleted_stash->name . "::$f";
263 Sub::Name::subname($new_fq, $sub);
264 $deleted_stash->add_symbol("&$f", $sub);
268 $deleted_stash->add_symbol("&$f", $sub);
272 my $RemoveSubs = sub {
275 my $cleanee_stash = Package::Stash->new($cleanee);
281 # ignore already removed symbols
282 next SYMBOL if $store->{exclude}{ $f };
284 my $sub = $cleanee_stash->get_symbol("&$f")
287 my $need_debugger_fixup =
290 ref(my $globref = \$cleanee_stash->namespace->{$f}) eq 'GLOB'
293 if ($need_debugger_fixup) {
294 # convince the Perl debugger to work
295 # see the comment on top of $DebuggerFixup
300 $deleted_stash ||= Package::Stash->new("namespace::clean::deleted::$cleanee"),
306 my $def = $cleanee_stash->get_symbol($name);
307 defined($def) ? [$name, $def] : ()
310 $cleanee_stash->remove_glob($f);
312 # if this perl needs no renaming trick we need to
313 # rename the original glob after the fact
314 # (see commend of $DebuggerFixup
315 if (!RENAME_SUB && $need_debugger_fixup) {
316 *$globref = $deleted_stash->namespace->{$f};
319 $cleanee_stash->add_symbol(@$_) for @symbols;
323 sub clean_subroutines {
324 my ($nc, $cleanee, @subs) = @_;
325 $RemoveSubs->($cleanee, {}, @subs);
330 Makes a snapshot of the current defined functions and installs a
331 L<B::Hooks::EndOfScope> hook in the current scope to invoke the cleanups.
336 my ($pragma, @args) = @_;
338 my (%args, $is_explicit);
343 if ($args[0] =~ /^\-/) {
344 my $key = shift @args;
345 my $value = shift @args;
346 $args{ $key } = $value;
354 my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
357 $RemoveSubs->($cleanee, {}, @args);
362 # calling class, all current functions and our storage
363 my $functions = $pragma->get_functions($cleanee);
364 my $store = $pragma->get_class_store($cleanee);
365 my $stash = Package::Stash->new($cleanee);
367 # except parameter can be array ref or single value
368 my %except = map {( $_ => 1 )} (
370 ? ( ref $args{ -except } eq 'ARRAY' ? @{ $args{ -except } } : $args{ -except } )
374 # register symbols for removal, if they have a CODE entry
375 for my $f (keys %$functions) {
376 next if $except{ $f };
377 next unless $stash->has_symbol("&$f");
378 $store->{remove}{ $f } = 1;
381 # register EOF handler on first call to import
382 unless ($store->{handler_is_installed}) {
384 $RemoveSubs->($cleanee, $store, keys %{ $store->{remove} });
386 $store->{handler_is_installed} = 1;
395 This method will be called when you do a
399 It will start a new section of code that defines functions to clean up.
404 my ($pragma, %args) = @_;
406 # the calling class, the current functions and our storage
407 my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
408 my $functions = $pragma->get_functions($cleanee);
409 my $store = $pragma->get_class_store($cleanee);
411 # register all unknown previous functions as excluded
412 for my $f (keys %$functions) {
413 next if $store->{remove}{ $f }
414 or $store->{exclude}{ $f };
415 $store->{exclude}{ $f } = 1;
421 =head2 get_class_store
423 This returns a reference to a hash in a passed package containing
424 information about function names included and excluded from removal.
428 sub get_class_store {
429 my ($pragma, $class) = @_;
430 my $stash = Package::Stash->new($class);
431 my $var = "%$STORAGE_VAR";
432 $stash->add_symbol($var, {})
433 unless $stash->has_symbol($var);
434 return $stash->get_symbol($var);
439 Takes a class as argument and returns all currently defined functions
440 in it as a hash reference with the function name as key and a typeglob
441 reference to the symbol as value.
446 my ($pragma, $class) = @_;
448 my $stash = Package::Stash->new($class);
450 map { $_ => $stash->get_symbol("&$_") }
451 $stash->list_all_symbols('CODE')
455 =head1 IMPLEMENTATION DETAILS
457 This module works through the effect that a
459 delete $SomePackage::{foo};
461 will remove the C<foo> symbol from C<$SomePackage> for run time lookups
462 (e.g., method calls) but will leave the entry alive to be called by
463 already resolved names in the package itself. C<namespace::clean> will
464 restore and therefor in effect keep all glob slots that aren't C<CODE>.
466 A test file has been added to the perl core to ensure that this behaviour
467 will be stable in future releases.
469 Just for completeness sake, if you want to remove the symbol completely,
470 use C<undef> instead.
474 This module is fully functional in a pure-perl environment, where
475 L<B::Hooks::EndOfScope> (with the XS dependency L<Variable::Magic>), may
476 not be available. However in this case this module falls back to a
477 L<tie()|perlfunc/tie> of L<%^H|perlvar/%^H> which may or may not interfere
478 with some crack you may be doing independently of namespace::clean.
480 If you want to ensure that your codebase is protected from this unlikely
481 clash, you need to explicitly depend on L<B::Hooks::EndOfScope>.
485 L<B::Hooks::EndOfScope>
489 Many thanks to Matt S Trout for the inspiration on the whole idea.
497 Robert 'phaylon' Sedlacek <rs@474.at>
501 Florian Ragwitz <rafl@debian.org>
505 Jesse Luehrs <doy@tozt.net>
509 Peter Rabbitson <ribasushi@cpan.org>
513 =head1 COPYRIGHT AND LICENSE
515 This software is copyright (c) 2011 by Robert 'phaylon' Sedlacek.
517 This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.
522 'Danger! Laws of Thermodynamics may not apply.'