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