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