lib/namespace/clean.pm

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