lib/namespace/clean.pm

   1 package namespace::clean;
   2 # ABSTRACT: Keep imports and functions out of your namespace
   3
   4 use warnings;
   5 use strict;
   6
   7 use vars qw( $STORAGE_VAR );
   8 use Sub::Name 0.04 qw(subname);
   9 use Sub::Identify 0.04 qw(sub_fullname);
  10 use Package::Stash 0.22;
  11 use B::Hooks::EndOfScope 0.07;
  12
  13 $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
  14
  15 =head1 SYNOPSIS
  16
  17   package Foo;
  18   use warnings;
  19   use strict;
  20
  21   use Carp qw(croak);   # 'croak' will be removed
  22
  23   sub bar { 23 }        # 'bar' will be removed
  24
  25   # remove all previously defined functions
  26   use namespace::clean;
  27
  28   sub baz { bar() }     # 'baz' still defined, 'bar' still bound
  29
  30   # begin to collection function names from here again
  31   no namespace::clean;
  32
  33   sub quux { baz() }    # 'quux' will be removed
  34
  35   # remove all functions defined after the 'no' unimport
  36   use namespace::clean;
  37
  38   # Will print: 'No', 'No', 'Yes' and 'No'
  39   print +(__PACKAGE__->can('croak') ? 'Yes' : 'No'), "\n";
  40   print +(__PACKAGE__->can('bar')   ? 'Yes' : 'No'), "\n";
  41   print +(__PACKAGE__->can('baz')   ? 'Yes' : 'No'), "\n";
  42   print +(__PACKAGE__->can('quux')  ? 'Yes' : 'No'), "\n";
  43
  44   1;
  45
  46 =head1 DESCRIPTION
  47
  48 =head2 Keeping packages clean
  49
  50 When you define a function, or import one, into a Perl package, it will
  51 naturally also be available as a method. This does not per se cause
  52 problems, but it can complicate subclassing and, for example, plugin
  53 classes that are included via multiple inheritance by loading them as
  54 base classes.
  55
  56 The C<namespace::clean> pragma will remove all previously declared or
  57 imported symbols at the end of the current package's compile cycle.
  58 Functions called in the package itself will still be bound by their
  59 name, but they won't show up as methods on your class or instances.
  60
  61 By unimporting via C<no> you can tell C<namespace::clean> to start
  62 collecting functions for the next C<use namespace::clean;> specification.
  63
  64 You can use the C<-except> flag to tell C<namespace::clean> that you
  65 don't want it to remove a certain function or method. A common use would
  66 be a module exporting an C<import> method along with some functions:
  67
  68   use ModuleExportingImport;
  69   use namespace::clean -except => [qw( import )];
  70
  71 If you just want to C<-except> a single sub, you can pass it directly.
  72 For more than one value you have to use an array reference.
  73
  74 =head2 Explicitely removing functions when your scope is compiled
  75
  76 It is also possible to explicitely tell C<namespace::clean> what packages
  77 to remove when the surrounding scope has finished compiling. Here is an
  78 example:
  79
  80   package Foo;
  81   use strict;
  82
  83   # blessed NOT available
  84
  85   sub my_class {
  86       use Scalar::Util qw( blessed );
  87       use namespace::clean qw( blessed );
  88
  89       # blessed available
  90       return blessed shift;
  91   }
  92
  93   # blessed NOT available
  94
  95 =head2 Moose
  96
  97 When using C<namespace::clean> together with L<Moose> you want to keep
  98 the installed C<meta> method. So your classes should look like:
  99
 100   package Foo;
 101   use Moose;
 102   use namespace::clean -except => 'meta';
 103   ...
 104
 105 Same goes for L<Moose::Role>.
 106
 107 =head2 Cleaning other packages
 108
 109 You can tell C<namespace::clean> that you want to clean up another package
 110 instead of the one importing. To do this you have to pass in the C<-cleanee>
 111 option like this:
 112
 113   package My::MooseX::namespace::clean;
 114   use strict;
 115
 116   use namespace::clean (); # no cleanup, just load
 117
 118   sub import {
 119       namespace::clean->import(
 120         -cleanee => scalar(caller),
 121         -except  => 'meta',
 122       );
 123   }
 124
 125 If you don't care about C<namespace::clean>s discover-and-C<-except> logic, and
 126 just want to remove subroutines, try L</clean_subroutines>.
 127
 128 =method clean_subroutines
 129
 130 This exposes the actual subroutine-removal logic.
 131
 132   namespace::clean->clean_subroutines($cleanee, qw( subA subB ));
 133
 134 will remove C<subA> and C<subB> from C<$cleanee>. Note that this will remove the
 135 subroutines B<immediately> and not wait for scope end. If you want to have this
 136 effect at a specific time (e.g. C<namespace::clean> acts on scope compile end)
 137 it is your responsibility to make sure it runs at that time.
 138
 139 =cut
 140
 141 my $RemoveSubs = sub {
 142
 143     my $cleanee = shift;
 144     my $store   = shift;
 145     my $cleanee_stash = Package::Stash->new($cleanee);
 146     my $deleted_stash = Package::Stash->new("namespace::clean::deleted::$cleanee");
 147   SYMBOL:
 148     for my $f (@_) {
 149         my $variable = "&$f";
 150         # ignore already removed symbols
 151         next SYMBOL if $store->{exclude}{ $f };
 152
 153         next SYMBOL unless $cleanee_stash->has_symbol($variable);
 154
 155         if (ref(\$cleanee_stash->namespace->{$f}) eq 'GLOB') {
 156             # convince the Perl debugger to work
 157             # it assumes that sub_fullname($sub) can always be used to find the CV again
 158             # since we are deleting the glob where the subroutine was originally
 159             # defined, that assumption no longer holds, so we need to move it
 160             # elsewhere and point the CV's name to the new glob.
 161             my $sub = $cleanee_stash->get_symbol($variable);
 162             if ( sub_fullname($sub) eq ($cleanee_stash->name . "::$f") ) {
 163                 my $new_fq = $deleted_stash->name . "::$f";
 164                 subname($new_fq, $sub);
 165                 $deleted_stash->add_symbol($variable, $sub);
 166             }
 167         }
 168
 169         my @symbols = map {
 170             my $name = $_ . $f;
 171             my $def = $cleanee_stash->get_symbol($name);
 172             defined($def) ? [$name, $def] : ()
 173         } '$', '@', '%', '';
 174
 175         $cleanee_stash->remove_glob($f);
 176
 177         $cleanee_stash->add_symbol(@$_) for @symbols;
 178     }
 179 };
 180
 181 sub clean_subroutines {
 182     my ($nc, $cleanee, @subs) = @_;
 183     $RemoveSubs->($cleanee, {}, @subs);
 184 }
 185
 186 =method import
 187
 188 Makes a snapshot of the current defined functions and installs a
 189 L<B::Hooks::EndOfScope> hook in the current scope to invoke the cleanups.
 190
 191 =cut
 192
 193 sub import {
 194     my ($pragma, @args) = @_;
 195
 196     my (%args, $is_explicit);
 197
 198   ARG:
 199     while (@args) {
 200
 201         if ($args[0] =~ /^\-/) {
 202             my $key = shift @args;
 203             my $value = shift @args;
 204             $args{ $key } = $value;
 205         }
 206         else {
 207             $is_explicit++;
 208             last ARG;
 209         }
 210     }
 211
 212     my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
 213     if ($is_explicit) {
 214         on_scope_end {
 215             $RemoveSubs->($cleanee, {}, @args);
 216         };
 217     }
 218     else {
 219
 220         # calling class, all current functions and our storage
 221         my $functions = $pragma->get_functions($cleanee);
 222         my $store     = $pragma->get_class_store($cleanee);
 223         my $stash     = Package::Stash->new($cleanee);
 224
 225         # except parameter can be array ref or single value
 226         my %except = map {( $_ => 1 )} (
 227             $args{ -except }
 228             ? ( ref $args{ -except } eq 'ARRAY' ? @{ $args{ -except } } : $args{ -except } )
 229             : ()
 230         );
 231
 232         # register symbols for removal, if they have a CODE entry
 233         for my $f (keys %$functions) {
 234             next if     $except{ $f };
 235             next unless $stash->has_symbol("&$f");
 236             $store->{remove}{ $f } = 1;
 237         }
 238
 239         # register EOF handler on first call to import
 240         unless ($store->{handler_is_installed}) {
 241             on_scope_end {
 242                 $RemoveSubs->($cleanee, $store, keys %{ $store->{remove} });
 243             };
 244             $store->{handler_is_installed} = 1;
 245         }
 246
 247         return 1;
 248     }
 249 }
 250
 251 =method unimport
 252
 253 This method will be called when you do a
 254
 255   no namespace::clean;
 256
 257 It will start a new section of code that defines functions to clean up.
 258
 259 =cut
 260
 261 sub unimport {
 262     my ($pragma, %args) = @_;
 263
 264     # the calling class, the current functions and our storage
 265     my $cleanee   = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
 266     my $functions = $pragma->get_functions($cleanee);
 267     my $store     = $pragma->get_class_store($cleanee);
 268
 269     # register all unknown previous functions as excluded
 270     for my $f (keys %$functions) {
 271         next if $store->{remove}{ $f }
 272              or $store->{exclude}{ $f };
 273         $store->{exclude}{ $f } = 1;
 274     }
 275
 276     return 1;
 277 }
 278
 279 =method get_class_store
 280
 281 This returns a reference to a hash in a passed package containing
 282 information about function names included and excluded from removal.
 283
 284 =cut
 285
 286 sub get_class_store {
 287     my ($pragma, $class) = @_;
 288     my $stash = Package::Stash->new($class);
 289     my $var = "%$STORAGE_VAR";
 290     $stash->add_symbol($var, {})
 291         unless $stash->has_symbol($var);
 292     return $stash->get_symbol($var);
 293 }
 294
 295 =method get_functions
 296
 297 Takes a class as argument and returns all currently defined functions
 298 in it as a hash reference with the function name as key and a typeglob
 299 reference to the symbol as value.
 300
 301 =cut
 302
 303 sub get_functions {
 304     my ($pragma, $class) = @_;
 305
 306     my $stash = Package::Stash->new($class);
 307     return {
 308         map { $_ => $stash->get_symbol("&$_") }
 309             $stash->list_all_symbols('CODE')
 310     };
 311 }
 312
 313 =head1 IMPLEMENTATION DETAILS
 314
 315 This module works through the effect that a
 316
 317   delete $SomePackage::{foo};
 318
 319 will remove the C<foo> symbol from C<$SomePackage> for run time lookups
 320 (e.g., method calls) but will leave the entry alive to be called by
 321 already resolved names in the package itself. C<namespace::clean> will
 322 restore and therefor in effect keep all glob slots that aren't C<CODE>.
 323
 324 A test file has been added to the perl core to ensure that this behaviour
 325 will be stable in future releases.
 326
 327 Just for completeness sake, if you want to remove the symbol completely,
 328 use C<undef> instead.
 329
 330 =head1 SEE ALSO
 331
 332 L<B::Hooks::EndOfScope>
 333
 334 =head1 THANKS
 335
 336 Many thanks to Matt S Trout for the inspiration on the whole idea.
 337
 338 =cut
 339
 340 no warnings;
 341 'Danger! Laws of Thermodynamics may not apply.'