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