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