1 package namespace::clean;
7 our $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
9 use B::Hooks::EndOfScope 'on_scope_end';
11 # FIXME This is a crock of shit, needs to go away
12 # currently here to work around https://rt.cpan.org/Ticket/Display.html?id=74151
13 # kill with fire when PS::XS is *finally* fixed
17 if ( $] < 5.008007 ) {
18 require Package::Stash::PP;
19 $provider = 'Package::Stash::PP';
22 require Package::Stash;
23 $provider = 'Package::Stash';
25 eval <<"EOS" or die $@;
28 $provider->new(\$_[0]);
36 use namespace::clean::_Util qw( DEBUGGER_NEEDS_CV_RENAME DEBUGGER_NEEDS_CV_PIVOT );
38 # Built-in debugger CV-retrieval fixups necessary before perl 5.15.5:
39 # since we are deleting the glob where the subroutine was originally
40 # defined, the assumptions below no longer hold.
42 # In 5.8.9 ~ 5.13.5 (inclusive) the debugger assumes that a CV can
43 # always be found under sub_fullname($sub)
44 # Workaround: use sub naming to properly name the sub hidden in the package's
47 # In the rest of the range ( ... ~ 5.8.8 and 5.13.6 ~ 5.15.4 ) the debugger
48 # assumes the name of the glob passed to entersub can be used to find the CV
49 # Workaround: realias the original glob to the deleted-stash slot
51 # Can not tie constants to the current value of $^P directly,
52 # as the debugger can be enabled during runtime (kinda dubious)
55 my $RemoveSubs = sub {
58 my $cleanee_stash = stash_for($cleanee);
64 # ignore already removed symbols
65 next SYMBOL if $store->{exclude}{ $f };
67 my $sub = $cleanee_stash->get_symbol("&$f")
70 my $need_debugger_fixup =
71 ( DEBUGGER_NEEDS_CV_RENAME or DEBUGGER_NEEDS_CV_PIVOT )
75 ref(my $globref = \$cleanee_stash->namespace->{$f}) eq 'GLOB'
77 ( $deleted_stash ||= stash_for("namespace::clean::deleted::$cleanee") )
80 # convince the Perl debugger to work
81 # see the comment on top
82 if ( DEBUGGER_NEEDS_CV_RENAME and $need_debugger_fixup ) {
84 # Note - both get_subname and set_subname are only compiled when CV_RENAME
85 # is true ( the 5.8.9 ~ 5.12 range ). On other perls this entire block is
86 # constant folded away, and so are the definitions in ::_Util
88 # Do not be surprised that they are missing without DEBUGGER_NEEDS_CV_RENAME
90 namespace::clean::_Util::get_subname( $sub ) eq ( $cleanee_stash->name . "::$f" )
92 $deleted_stash->add_symbol(
94 namespace::clean::_Util::set_subname( $deleted_stash->name . "::$f", $sub ),
97 elsif ( DEBUGGER_NEEDS_CV_PIVOT and $need_debugger_fixup ) {
98 $deleted_stash->add_symbol("&$f", $sub);
103 my $def = $cleanee_stash->get_symbol($name);
104 defined($def) ? [$name, $def] : ()
107 $cleanee_stash->remove_glob($f);
109 # if this perl needs no renaming trick we need to
110 # rename the original glob after the fact
111 DEBUGGER_NEEDS_CV_PIVOT
115 *$globref = $deleted_stash->namespace->{$f};
117 $cleanee_stash->add_symbol(@$_) for @symbols;
121 sub clean_subroutines {
122 my ($nc, $cleanee, @subs) = @_;
123 $RemoveSubs->($cleanee, {}, @subs);
127 my ($pragma, @args) = @_;
129 my (%args, $is_explicit);
134 if ($args[0] =~ /^\-/) {
135 my $key = shift @args;
136 my $value = shift @args;
137 $args{ $key } = $value;
145 my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
148 $RemoveSubs->($cleanee, {}, @args);
153 # calling class, all current functions and our storage
154 my $functions = $pragma->get_functions($cleanee);
155 my $store = $pragma->get_class_store($cleanee);
156 my $stash = stash_for($cleanee);
158 # except parameter can be array ref or single value
159 my %except = map {( $_ => 1 )} (
161 ? ( ref $args{ -except } eq 'ARRAY' ? @{ $args{ -except } } : $args{ -except } )
165 # register symbols for removal, if they have a CODE entry
166 for my $f (keys %$functions) {
167 next if $except{ $f };
168 next unless $stash->has_symbol("&$f");
169 $store->{remove}{ $f } = 1;
172 # register EOF handler on first call to import
173 unless ($store->{handler_is_installed}) {
175 $RemoveSubs->($cleanee, $store, keys %{ $store->{remove} });
177 $store->{handler_is_installed} = 1;
185 my ($pragma, %args) = @_;
187 # the calling class, the current functions and our storage
188 my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
189 my $functions = $pragma->get_functions($cleanee);
190 my $store = $pragma->get_class_store($cleanee);
192 # register all unknown previous functions as excluded
193 for my $f (keys %$functions) {
194 next if $store->{remove}{ $f }
195 or $store->{exclude}{ $f };
196 $store->{exclude}{ $f } = 1;
202 sub get_class_store {
203 my ($pragma, $class) = @_;
204 my $stash = stash_for($class);
205 my $var = "%$STORAGE_VAR";
206 $stash->add_symbol($var, {})
207 unless $stash->has_symbol($var);
208 return $stash->get_symbol($var);
212 my ($pragma, $class) = @_;
214 my $stash = stash_for($class);
216 map { $_ => $stash->get_symbol("&$_") }
217 $stash->list_all_symbols('CODE')
221 'Danger! Laws of Thermodynamics may not apply.'
227 namespace::clean - Keep imports and functions out of your namespace
235 use Carp qw(croak); # 'croak' will be removed
237 sub bar { 23 } # 'bar' will be removed
239 # remove all previously defined functions
240 use namespace::clean;
242 sub baz { bar() } # 'baz' still defined, 'bar' still bound
244 # begin to collection function names from here again
247 sub quux { baz() } # 'quux' will be removed
249 # remove all functions defined after the 'no' unimport
250 use namespace::clean;
252 # Will print: 'No', 'No', 'Yes' and 'No'
253 print +(__PACKAGE__->can('croak') ? 'Yes' : 'No'), "\n";
254 print +(__PACKAGE__->can('bar') ? 'Yes' : 'No'), "\n";
255 print +(__PACKAGE__->can('baz') ? 'Yes' : 'No'), "\n";
256 print +(__PACKAGE__->can('quux') ? 'Yes' : 'No'), "\n";
262 =head2 Keeping packages clean
264 When you define a function, or import one, into a Perl package, it will
265 naturally also be available as a method. This does not per se cause
266 problems, but it can complicate subclassing and, for example, plugin
267 classes that are included via multiple inheritance by loading them as
270 The C<namespace::clean> pragma will remove all previously declared or
271 imported symbols at the end of the current package's compile cycle.
272 Functions called in the package itself will still be bound by their
273 name, but they won't show up as methods on your class or instances.
275 By unimporting via C<no> you can tell C<namespace::clean> to start
276 collecting functions for the next C<use namespace::clean;> specification.
278 You can use the C<-except> flag to tell C<namespace::clean> that you
279 don't want it to remove a certain function or method. A common use would
280 be a module exporting an C<import> method along with some functions:
282 use ModuleExportingImport;
283 use namespace::clean -except => [qw( import )];
285 If you just want to C<-except> a single sub, you can pass it directly.
286 For more than one value you have to use an array reference.
288 =head2 Explicitly removing functions when your scope is compiled
290 It is also possible to explicitly tell C<namespace::clean> what packages
291 to remove when the surrounding scope has finished compiling. Here is an
297 # blessed NOT available
300 use Scalar::Util qw( blessed );
301 use namespace::clean qw( blessed );
304 return blessed shift;
307 # blessed NOT available
311 When using C<namespace::clean> together with L<Moose> you want to keep
312 the installed C<meta> method. So your classes should look like:
316 use namespace::clean -except => 'meta';
319 Same goes for L<Moose::Role>.
321 =head2 Cleaning other packages
323 You can tell C<namespace::clean> that you want to clean up another package
324 instead of the one importing. To do this you have to pass in the C<-cleanee>
327 package My::MooseX::namespace::clean;
330 use namespace::clean (); # no cleanup, just load
333 namespace::clean->import(
334 -cleanee => scalar(caller),
339 If you don't care about C<namespace::clean>s discover-and-C<-except> logic, and
340 just want to remove subroutines, try L</clean_subroutines>.
344 =head2 clean_subroutines
346 This exposes the actual subroutine-removal logic.
348 namespace::clean->clean_subroutines($cleanee, qw( subA subB ));
350 will remove C<subA> and C<subB> from C<$cleanee>. Note that this will remove the
351 subroutines B<immediately> and not wait for scope end. If you want to have this
352 effect at a specific time (e.g. C<namespace::clean> acts on scope compile end)
353 it is your responsibility to make sure it runs at that time.
357 Makes a snapshot of the current defined functions and installs a
358 L<B::Hooks::EndOfScope> hook in the current scope to invoke the cleanups.
363 This method will be called when you do a
367 It will start a new section of code that defines functions to clean up.
369 =head2 get_class_store
371 This returns a reference to a hash in a passed package containing
372 information about function names included and excluded from removal.
376 Takes a class as argument and returns all currently defined functions
377 in it as a hash reference with the function name as key and a typeglob
378 reference to the symbol as value.
380 =head1 IMPLEMENTATION DETAILS
382 This module works through the effect that a
384 delete $SomePackage::{foo};
386 will remove the C<foo> symbol from C<$SomePackage> for run time lookups
387 (e.g., method calls) but will leave the entry alive to be called by
388 already resolved names in the package itself. C<namespace::clean> will
389 restore and therefor in effect keep all glob slots that aren't C<CODE>.
391 A test file has been added to the perl core to ensure that this behaviour
392 will be stable in future releases.
394 Just for completeness sake, if you want to remove the symbol completely,
395 use C<undef> instead.
399 L<B::Hooks::EndOfScope>
403 Many thanks to Matt S Trout for the inspiration on the whole idea.
411 Robert 'phaylon' Sedlacek <rs@474.at>
415 Florian Ragwitz <rafl@debian.org>
419 Jesse Luehrs <doy@tozt.net>
423 Peter Rabbitson <ribasushi@cpan.org>
427 Father Chrysostomos <sprout@cpan.org>
431 =head1 COPYRIGHT AND LICENSE
433 This software is copyright (c) 2011 by L</AUTHORS>
435 This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.