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 Scope::Guard;
  15
  16 =head1 VERSION
  17
  18 0.08
  19
  20 =cut
  21
  22 $VERSION         = 0.08;
  23 $STORAGE_VAR     = '__NAMESPACE_CLEAN_STORAGE';
  24 $SCOPE_HOOK_KEY  = 'namespace_clean_SCOPING';
  25 $SCOPE_EXPLICIT  = 'namespace_clean_EXPLICIT';
  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 =head1 METHODS
 120
 121 You shouldn't need to call any of these. Just C<use> the package at the
 122 appropriate place.
 123
 124 =cut
 125
 126 =head2 import
 127
 128 Makes a snapshot of the current defined functions and installs a
 129 L<Scope::Guard> in the current scope to invoke the cleanups.
 130
 131 =cut
 132
 133 my $RemoveSubs = sub {
 134     my $cleanee = shift;
 135     my $store   = shift;
 136   SYMBOL:
 137     for my $f (@_) {
 138
 139         # ignore already removed symbols
 140         next SYMBOL if $store->{exclude}{ $f };
 141         no strict 'refs';
 142
 143         # keep original value to restore non-code slots
 144         {   no warnings 'uninitialized';    # fix possible unimports
 145             local *__tmp = *{ ${ "${cleanee}::" }{ $f } };
 146             delete ${ "${cleanee}::" }{ $f };
 147         }
 148
 149       SLOT:
 150         # restore non-code slots to symbol
 151         for my $t (qw( SCALAR ARRAY HASH IO FORMAT )) {
 152             next SLOT unless defined *__tmp{ $t };
 153             *{ "${cleanee}::$f" } = *__tmp{ $t };
 154         }
 155     }
 156 };
 157
 158 sub import {
 159     my ($pragma, @args) = @_;
 160     $^H |= 0x120000;
 161
 162     my (%args, $is_explicit);
 163     if (@args and $args[0] =~ /^\-/) {
 164         %args = @args;
 165         @args = ();
 166     }
 167     elsif (@args) {
 168         $is_explicit++;
 169     }
 170
 171     my $cleanee = caller;
 172     if ($is_explicit) {
 173         $^H{ $SCOPE_EXPLICIT } = Scope::Guard->new(sub {
 174             $RemoveSubs->($cleanee, {}, @args);
 175         });
 176     }
 177     else {
 178
 179         # calling class, all current functions and our storage
 180         my $functions = $pragma->get_functions($cleanee);
 181         my $store     = $pragma->get_class_store($cleanee);
 182
 183         # except parameter can be array ref or single value
 184         my %except = map {( $_ => 1 )} (
 185             $args{ -except }
 186             ? ( ref $args{ -except } eq 'ARRAY' ? @{ $args{ -except } } : $args{ -except } )
 187             : ()
 188         );
 189
 190         # register symbols for removal, if they have a CODE entry
 191         for my $f (keys %$functions) {
 192             next if     $except{ $f };
 193             next unless    $functions->{ $f }
 194                     and *{ $functions->{ $f } }{CODE};
 195             $store->{remove}{ $f } = 1;
 196         }
 197
 198         # register EOF handler on first call to import
 199         unless ($store->{handler_is_installed}) {
 200             $^H{ $SCOPE_HOOK_KEY } = Scope::Guard->new(sub {
 201                 $RemoveSubs->($cleanee, $store, keys %{ $store->{remove} });
 202             });
 203             $store->{handler_is_installed} = 1;
 204         }
 205
 206         return 1;
 207     }
 208 }
 209
 210 =head2 unimport
 211
 212 This method will be called when you do a
 213
 214   no namespace::clean;
 215
 216 It will start a new section of code that defines functions to clean up.
 217
 218 =cut
 219
 220 sub unimport {
 221     my ($pragma) = @_;
 222
 223     # the calling class, the current functions and our storage
 224     my $cleanee   = caller;
 225     my $functions = $pragma->get_functions($cleanee);
 226     my $store     = $pragma->get_class_store($cleanee);
 227
 228     # register all unknown previous functions as excluded
 229     for my $f (keys %$functions) {
 230         next if $store->{remove}{ $f }
 231              or $store->{exclude}{ $f };
 232         $store->{exclude}{ $f } = 1;
 233     }
 234
 235     return 1;
 236 }
 237
 238 =head2 get_class_store
 239
 240 This returns a reference to a hash in a passed package containing
 241 information about function names included and excluded from removal.
 242
 243 =cut
 244
 245 sub get_class_store {
 246     my ($pragma, $class) = @_;
 247     no strict 'refs';
 248     return \%{ "${class}::${STORAGE_VAR}" };
 249 }
 250
 251 =head2 get_functions
 252
 253 Takes a class as argument and returns all currently defined functions
 254 in it as a hash reference with the function name as key and a typeglob
 255 reference to the symbol as value.
 256
 257 =cut
 258
 259 sub get_functions {
 260     my ($pragma, $class) = @_;
 261
 262     return {
 263         map  { @$_ }                                        # key => value
 264         grep { *{ $_->[1] }{CODE} }                         # only functions
 265         map  { [$_, qualify_to_ref( $_, $class )] }         # get globref
 266         grep { $_ !~ /::$/ }                                # no packages
 267         do   { no strict 'refs'; keys %{ "${class}::" } }   # symbol entries
 268     };
 269 }
 270
 271 =head1 IMPLEMENTATION DETAILS
 272
 273 This module works through the effect that a
 274
 275   delete $SomePackage::{foo};
 276
 277 will remove the C<foo> symbol from C<$SomePackage> for run time lookups
 278 (e.g., method calls) but will leave the entry alive to be called by
 279 already resolved names in the package itself. C<namespace::clean> will
 280 restore and therefor in effect keep all glob slots that aren't C<CODE>.
 281
 282 A test file has been added to the perl core to ensure that this behaviour
 283 will be stable in future releases.
 284
 285 Just for completeness sake, if you want to remove the symbol completely,
 286 use C<undef> instead.
 287
 288 =head1 SEE ALSO
 289
 290 L<Scope::Guard>
 291
 292 =head1 AUTHOR AND COPYRIGHT
 293
 294 Robert 'phaylon' Sedlacek C<E<lt>rs@474.atE<gt>>, with many thanks to
 295 Matt S Trout for the inspiration on the whole idea.
 296
 297 =head1 LICENSE
 298
 299 This program is free software; you can redistribute it and/or modify
 300 it under the same terms as perl itself.
 301
 302 =cut
 303
 304 no warnings;
 305 'Danger! Laws of Thermodynamics may not apply.'