1 package namespace::clean;
7 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
9 our $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
11 use B::Hooks::EndOfScope 'on_scope_end';
13 use namespace::clean::_Util qw( DEBUGGER_NEEDS_CV_RENAME DEBUGGER_NEEDS_CV_PIVOT );
15 # Built-in debugger CV-retrieval fixups necessary before perl 5.15.5:
16 # since we are deleting the glob where the subroutine was originally
17 # defined, the assumptions below no longer hold.
19 # In 5.8.9 ~ 5.13.5 (inclusive) the debugger assumes that a CV can
20 # always be found under sub_fullname($sub)
21 # Workaround: use sub naming to properly name the sub hidden in the package's
24 # In the rest of the range ( ... ~ 5.8.8 and 5.13.6 ~ 5.15.4 ) the debugger
25 # assumes the name of the glob passed to entersub can be used to find the CV
26 # Workaround: realias the original glob to the deleted-stash slot
28 # While the errors manifest themselves inside perl5db.pl, they are caused by
29 # problems inside the interpreter. If enabled ($^P & 0x01) and existent,
30 # the DB::sub sub will be called by the interpreter for any sub call rather
31 # that call the sub directly. It is provided the real sub to call in $DB::sub,
32 # but the value given has the issues described above. We only have to enable
33 # the workaround if DB::sub will be used.
35 # Can not tie constants to the current value of $^P directly,
36 # as the debugger can be enabled during runtime (kinda dubious)
39 my $RemoveSubs = sub {
42 my $cleanee_stash = \%{"${cleanee}::"};
43 my $deleted_stash_name;
50 # ignore already removed symbols
51 next SYMBOL if $store->{exclude}{ $f };
54 unless exists &{"${cleanee}::$f"};
56 my $sub = \&{"${cleanee}::$f"};
58 my $need_debugger_fixup =
59 ( DEBUGGER_NEEDS_CV_RENAME or DEBUGGER_NEEDS_CV_PIVOT )
65 ref(my $globref = \$cleanee_stash->{$f}) eq 'GLOB'
67 ( $deleted_stash_name ||= "namespace::clean::deleted::$cleanee" )
69 ( $deleted_stash ||= \%{"${deleted_stash_name}::"} )
72 # convince the Perl debugger to work
73 # see the comment on top
74 if ( DEBUGGER_NEEDS_CV_RENAME and $need_debugger_fixup ) {
76 # Note - both get_subname and set_subname are only compiled when CV_RENAME
77 # is true ( the 5.8.9 ~ 5.12 range ). On other perls this entire block is
78 # constant folded away, and so are the definitions in ::_Util
80 # Do not be surprised that they are missing without DEBUGGER_NEEDS_CV_RENAME
82 namespace::clean::_Util::get_subname( $sub ) eq ( $cleanee . "::$f" )
84 *{"${deleted_stash_name}::$f"} =
85 namespace::clean::_Util::set_subname( $deleted_stash_name . "::$f", $sub );
87 elsif ( DEBUGGER_NEEDS_CV_PIVOT and $need_debugger_fixup ) {
88 *{"${deleted_stash_name}::$f"} = $sub;
93 my $glob = *{"${cleanee}::$f"};
96 qw(SCALAR ARRAY HASH IO);
99 delete $cleanee_stash->{$f};
101 # if this perl needs no renaming trick we need to
102 # rename the original glob after the fact
103 DEBUGGER_NEEDS_CV_PIVOT
107 *$globref = $deleted_stash->{$f};
109 *{"${cleanee}::$f"} = $_ for @symbols;
113 sub clean_subroutines {
114 my ($nc, $cleanee, @subs) = @_;
115 $RemoveSubs->($cleanee, {}, @subs);
119 my ($pragma, @args) = @_;
121 my (%args, $is_explicit);
126 if ($args[0] =~ /^\-/) {
127 my $key = shift @args;
128 my $value = shift @args;
129 $args{ $key } = $value;
137 my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
140 $RemoveSubs->($cleanee, {}, @args);
145 # calling class, all current functions and our storage
146 my $functions = $pragma->get_functions($cleanee);
147 my $store = $pragma->get_class_store($cleanee);
149 # except parameter can be array ref or single value
150 my %except = map {( $_ => 1 )} (
152 ? ( ref $args{ -except } eq 'ARRAY' ? @{ $args{ -except } } : $args{ -except } )
156 # register symbols for removal, if they have a CODE entry
157 for my $f (keys %$functions) {
158 next if $except{ $f };
159 next unless exists &{"${cleanee}::$f"};
160 $store->{remove}{ $f } = 1;
164 $RemoveSubs->($cleanee, $store, keys %{ $store->{remove} });
172 my ($pragma, %args) = @_;
174 # the calling class, the current functions and our storage
175 my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
176 my $functions = $pragma->get_functions($cleanee);
177 my $store = $pragma->get_class_store($cleanee);
179 # register all unknown previous functions as excluded
180 for my $f (keys %$functions) {
181 next if $store->{remove}{ $f }
182 or $store->{exclude}{ $f };
183 $store->{exclude}{ $f } = 1;
189 sub get_class_store {
190 my ($pragma, $class) = @_;
192 return \%{"${class}::${STORAGE_VAR}"};
196 my ($pragma, $class) = @_;
200 map +($_ => \&{"${class}::$_"}),
201 grep exists &{"${class}::$_"},
202 sort keys %{"${class}::"}
206 'Danger! Laws of Thermodynamics may not apply.'
212 namespace::clean - Keep imports and functions out of your namespace
220 use Carp qw(croak); # 'croak' will be removed
222 sub bar { 23 } # 'bar' will be removed
224 # remove all previously defined functions
225 use namespace::clean;
227 sub baz { bar() } # 'baz' still defined, 'bar' still bound
229 # begin to collection function names from here again
232 sub quux { baz() } # 'quux' will be removed
234 # remove all functions defined after the 'no' unimport
235 use namespace::clean;
237 # Will print: 'No', 'No', 'Yes' and 'No'
238 print +(__PACKAGE__->can('croak') ? 'Yes' : 'No'), "\n";
239 print +(__PACKAGE__->can('bar') ? 'Yes' : 'No'), "\n";
240 print +(__PACKAGE__->can('baz') ? 'Yes' : 'No'), "\n";
241 print +(__PACKAGE__->can('quux') ? 'Yes' : 'No'), "\n";
247 =head2 Keeping packages clean
249 When you define a function, or import one, into a Perl package, it will
250 naturally also be available as a method. This does not per se cause
251 problems, but it can complicate subclassing and, for example, plugin
252 classes that are included via multiple inheritance by loading them as
255 The C<namespace::clean> pragma will remove all previously declared or
256 imported symbols at the end of the current package's compile cycle.
257 Functions called in the package itself will still be bound by their
258 name, but they won't show up as methods on your class or instances.
260 By unimporting via C<no> you can tell C<namespace::clean> to start
261 collecting functions for the next C<use namespace::clean;> specification.
263 You can use the C<-except> flag to tell C<namespace::clean> that you
264 don't want it to remove a certain function or method. A common use would
265 be a module exporting an C<import> method along with some functions:
267 use ModuleExportingImport;
268 use namespace::clean -except => [qw( import )];
270 If you just want to C<-except> a single sub, you can pass it directly.
271 For more than one value you have to use an array reference.
273 =head3 Late binding caveat
275 Note that the L<technique used by this module|/IMPLEMENTATION DETAILS> relies
276 on perl having resolved all names to actual code references during the
277 compilation of a scope. While this is almost always what the interpreter does,
278 there are some exceptions, notably the L<sort SUBNAME|perlfunc/sort> style of
279 the C<sort> built-in invocation. The following example will not work, because
280 C<sort> does not try to resolve the function name to an actual code reference
283 use MyApp::Utils 'my_sorter';
284 use namespace::clean;
286 my @sorted = sort my_sorter @list;
288 You need to work around this by forcing a compile-time resolution like so:
290 use MyApp::Utils 'my_sorter';
291 use namespace::clean;
293 my $my_sorter_cref = \&my_sorter;
295 my @sorted = sort $my_sorter_cref @list;
297 =head2 Explicitly removing functions when your scope is compiled
299 It is also possible to explicitly tell C<namespace::clean> what packages
300 to remove when the surrounding scope has finished compiling. Here is an
306 # blessed NOT available
309 use Scalar::Util qw( blessed );
310 use namespace::clean qw( blessed );
313 return blessed shift;
316 # blessed NOT available
320 When using C<namespace::clean> together with L<Moose> you want to keep
321 the installed C<meta> method. So your classes should look like:
325 use namespace::clean -except => 'meta';
328 Same goes for L<Moose::Role>.
330 =head2 Cleaning other packages
332 You can tell C<namespace::clean> that you want to clean up another package
333 instead of the one importing. To do this you have to pass in the C<-cleanee>
336 package My::MooseX::namespace::clean;
339 use namespace::clean (); # no cleanup, just load
342 namespace::clean->import(
343 -cleanee => scalar(caller),
348 If you don't care about C<namespace::clean>s discover-and-C<-except> logic, and
349 just want to remove subroutines, try L</clean_subroutines>.
353 =head2 clean_subroutines
355 This exposes the actual subroutine-removal logic.
357 namespace::clean->clean_subroutines($cleanee, qw( subA subB ));
359 will remove C<subA> and C<subB> from C<$cleanee>. Note that this will remove the
360 subroutines B<immediately> and not wait for scope end. If you want to have this
361 effect at a specific time (e.g. C<namespace::clean> acts on scope compile end)
362 it is your responsibility to make sure it runs at that time.
366 Makes a snapshot of the current defined functions and installs a
367 L<B::Hooks::EndOfScope> hook in the current scope to invoke the cleanups.
372 This method will be called when you do a
376 It will start a new section of code that defines functions to clean up.
378 =head2 get_class_store
380 This returns a reference to a hash in a passed package containing
381 information about function names included and excluded from removal.
385 Takes a class as argument and returns all currently defined functions
386 in it as a hash reference with the function name as key and a typeglob
387 reference to the symbol as value.
389 =head1 IMPLEMENTATION DETAILS
391 This module works through the effect that a
393 delete $SomePackage::{foo};
395 will remove the C<foo> symbol from C<$SomePackage> for run time lookups
396 (e.g., method calls) but will leave the entry alive to be called by
397 already resolved names in the package itself. C<namespace::clean> will
398 restore and therefor in effect keep all glob slots that aren't C<CODE>.
400 A test file has been added to the perl core to ensure that this behaviour
401 will be stable in future releases.
403 Just for completeness sake, if you want to remove the symbol completely,
404 use C<undef> instead.
408 L<B::Hooks::EndOfScope>
412 Many thanks to Matt S Trout for the inspiration on the whole idea.
420 Robert 'phaylon' Sedlacek <rs@474.at>
424 Florian Ragwitz <rafl@debian.org>
428 Jesse Luehrs <doy@tozt.net>
432 Peter Rabbitson <ribasushi@cpan.org>
436 Father Chrysostomos <sprout@cpan.org>
440 =head1 COPYRIGHT AND LICENSE
442 This software is copyright (c) 2011 by L</AUTHORS>
444 This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.