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