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.18;
  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 ($scalar, $array, $hash, $io) = map {
 170             $cleanee_stash->get_symbol($_ . $f)
 171         } '$', '@', '%', '';
 172         $cleanee_stash->remove_glob($f);
 173         for my $var (['$', $scalar], ['@', $array], ['%', $hash], ['', $io]) {
 174             next unless defined $var->[1];
 175             $cleanee_stash->add_symbol($var->[0] . $f, $var->[1]);
 176         }
 177     }
 178 };
 179
 180 sub clean_subroutines {
 181     my ($nc, $cleanee, @subs) = @_;
 182     $RemoveSubs->($cleanee, {}, @subs);
 183 }
 184
 185 =method import
 186
 187 Makes a snapshot of the current defined functions and installs a
 188 L<B::Hooks::EndOfScope> hook in the current scope to invoke the cleanups.
 189
 190 =cut
 191
 192 sub import {
 193     my ($pragma, @args) = @_;
 194
 195     my (%args, $is_explicit);
 196
 197   ARG:
 198     while (@args) {
 199
 200         if ($args[0] =~ /^\-/) {
 201             my $key = shift @args;
 202             my $value = shift @args;
 203             $args{ $key } = $value;
 204         }
 205         else {
 206             $is_explicit++;
 207             last ARG;
 208         }
 209     }
 210
 211     my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
 212     if ($is_explicit) {
 213         on_scope_end {
 214             $RemoveSubs->($cleanee, {}, @args);
 215         };
 216     }
 217     else {
 218
 219         # calling class, all current functions and our storage
 220         my $functions = $pragma->get_functions($cleanee);
 221         my $store     = $pragma->get_class_store($cleanee);
 222         my $stash     = Package::Stash->new($cleanee);
 223
 224         # except parameter can be array ref or single value
 225         my %except = map {( $_ => 1 )} (
 226             $args{ -except }
 227             ? ( ref $args{ -except } eq 'ARRAY' ? @{ $args{ -except } } : $args{ -except } )
 228             : ()
 229         );
 230
 231         # register symbols for removal, if they have a CODE entry
 232         for my $f (keys %$functions) {
 233             next if     $except{ $f };
 234             next unless $stash->has_symbol("&$f");
 235             $store->{remove}{ $f } = 1;
 236         }
 237
 238         # register EOF handler on first call to import
 239         unless ($store->{handler_is_installed}) {
 240             on_scope_end {
 241                 $RemoveSubs->($cleanee, $store, keys %{ $store->{remove} });
 242             };
 243             $store->{handler_is_installed} = 1;
 244         }
 245
 246         return 1;
 247     }
 248 }
 249
 250 =method unimport
 251
 252 This method will be called when you do a
 253
 254   no namespace::clean;
 255
 256 It will start a new section of code that defines functions to clean up.
 257
 258 =cut
 259
 260 sub unimport {
 261     my ($pragma, %args) = @_;
 262
 263     # the calling class, the current functions and our storage
 264     my $cleanee   = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
 265     my $functions = $pragma->get_functions($cleanee);
 266     my $store     = $pragma->get_class_store($cleanee);
 267
 268     # register all unknown previous functions as excluded
 269     for my $f (keys %$functions) {
 270         next if $store->{remove}{ $f }
 271              or $store->{exclude}{ $f };
 272         $store->{exclude}{ $f } = 1;
 273     }
 274
 275     return 1;
 276 }
 277
 278 =method get_class_store
 279
 280 This returns a reference to a hash in a passed package containing
 281 information about function names included and excluded from removal.
 282
 283 =cut
 284
 285 sub get_class_store {
 286     my ($pragma, $class) = @_;
 287     my $stash = Package::Stash->new($class);
 288     my $var = "%$STORAGE_VAR";
 289     $stash->add_symbol($var, {})
 290         unless $stash->has_symbol($var);
 291     return $stash->get_symbol($var);
 292 }
 293
 294 =method get_functions
 295
 296 Takes a class as argument and returns all currently defined functions
 297 in it as a hash reference with the function name as key and a typeglob
 298 reference to the symbol as value.
 299
 300 =cut
 301
 302 sub get_functions {
 303     my ($pragma, $class) = @_;
 304
 305     my $stash = Package::Stash->new($class);
 306     return {
 307         map { $_ => $stash->get_symbol("&$_") }
 308             $stash->list_all_symbols('CODE')
 309     };
 310 }
 311
 312 =head1 IMPLEMENTATION DETAILS
 313
 314 This module works through the effect that a
 315
 316   delete $SomePackage::{foo};
 317
 318 will remove the C<foo> symbol from C<$SomePackage> for run time lookups
 319 (e.g., method calls) but will leave the entry alive to be called by
 320 already resolved names in the package itself. C<namespace::clean> will
 321 restore and therefor in effect keep all glob slots that aren't C<CODE>.
 322
 323 A test file has been added to the perl core to ensure that this behaviour
 324 will be stable in future releases.
 325
 326 Just for completeness sake, if you want to remove the symbol completely,
 327 use C<undef> instead.
 328
 329 =head1 SEE ALSO
 330
 331 L<B::Hooks::EndOfScope>
 332
 333 =head1 THANKS
 334
 335 Many thanks to Matt S Trout for the inspiration on the whole idea.
 336
 337 =cut
 338
 339 no warnings;
 340 'Danger! Laws of Thermodynamics may not apply.'