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 );
  13 use Symbol            qw( qualify_to_ref );
  14 use Filter::EOF;
  15
  16 =head1 VERSION
  17
  18 0.04
  19
  20 =cut
  21
  22 $VERSION     = 0.04;
  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 When you define a function, or import one, into a Perl package, it will
  59 naturally also be available as a method. This does not per se cause
  60 problems, but it can complicate subclassing and, for example, plugin
  61 classes that are included via multiple inheritance by loading them as
  62 base classes.
  63
  64 The C<namespace::clean> pragma will remove all previously declared or
  65 imported symbols at the end of the current package's compile cycle.
  66 Functions called in the package itself will still be bound by their
  67 name, but they won't show up as methods on your class or instances.
  68
  69 By unimporting via C<no> you can tell C<namespace::clean> to start
  70 collecting functions for the next C<use namespace::clean;> specification.
  71
  72 You can use the C<-except> flag to tell C<namespace::clean> that you
  73 don't want it to remove a certain function. A common use would be a
  74 module exporting an C<import> method along with some functions:
  75
  76   use ModuleExportingImport;
  77   use namespace::clean -except => [qw( import )];
  78
  79 =head1 METHODS
  80
  81 You shouldn't need to call any of these. Just C<use> the package at the
  82 appropriate place.
  83
  84 =cut
  85
  86 =head2 import
  87
  88 Makes a snapshot of the current defined functions and registers a
  89 L<Filter::EOF> cleanup routine to remove those symbols at the end
  90 of the compile-time.
  91
  92 =cut
  93
  94 sub import {
  95     my ($pragma, %args) = @_;
  96
  97     # calling class, all current functions and our storage
  98     my $cleanee   = caller;
  99     my $functions = $pragma->get_functions($cleanee);
 100     my $store     = $pragma->get_class_store($cleanee);
 101
 102     my %except    = map {( $_ => 1 )} @{ $args{ -except } || [] };
 103
 104     # register symbols for removal, if they have a CODE entry
 105     for my $f (keys %$functions) {
 106         next if     $except{ $f };
 107         next unless    $functions->{ $f }
 108                 and *{ $functions->{ $f } }{CODE};
 109         $store->{remove}{ $f } = 1;
 110     }
 111
 112     # register EOF handler on first call to import
 113     unless ($store->{handler_is_installed}) {
 114         Filter::EOF->on_eof_call(sub {
 115           SYMBOL:
 116             for my $f (keys %{ $store->{remove} }) {
 117
 118                 # ignore already removed symbols
 119                 next SYMBOL if $store->{exclude}{ $f };
 120                 no strict 'refs';
 121
 122                 # keep original value to restore non-code slots
 123                 local *__tmp = *{ ${ "${cleanee}::" }{ $f } };
 124                 delete ${ "${cleanee}::" }{ $f };
 125
 126               SLOT:
 127                 # restore non-code slots to symbol
 128                 for my $t (qw( SCALAR ARRAY HASH IO FORMAT )) {
 129                     next SLOT unless defined *__tmp{ $t };
 130                     *{ "${cleanee}::$f" } = *__tmp{ $t };
 131                 }
 132             }
 133         });
 134         $store->{handler_is_installed} = 1;
 135     }
 136
 137     return 1;
 138 }
 139
 140 =head2 unimport
 141
 142 This method will be called when you do a
 143
 144   no namespace::clean;
 145
 146 It will start a new section of code that defines functions to clean up.
 147
 148 =cut
 149
 150 sub unimport {
 151     my ($pragma) = @_;
 152
 153     # the calling class, the current functions and our storage
 154     my $cleanee   = caller;
 155     my $functions = $pragma->get_functions($cleanee);
 156     my $store     = $pragma->get_class_store($cleanee);
 157
 158     # register all unknown previous functions as excluded
 159     for my $f (keys %$functions) {
 160         next if $store->{remove}{ $f }
 161              or $store->{exclude}{ $f };
 162         $store->{exclude}{ $f } = 1;
 163     }
 164
 165     return 1;
 166 }
 167
 168 =head2 get_class_store
 169
 170 This returns a reference to a hash in a passed package containing
 171 information about function names included and excluded from removal.
 172
 173 =cut
 174
 175 sub get_class_store {
 176     my ($pragma, $class) = @_;
 177     no strict 'refs';
 178     return \%{ "${class}::${STORAGE_VAR}" };
 179 }
 180
 181 =head2 get_functions
 182
 183 Takes a class as argument and returns all currently defined functions
 184 in it as a hash reference with the function name as key and a typeglob
 185 reference to the symbol as value.
 186
 187 =cut
 188
 189 sub get_functions {
 190     my ($pragma, $class) = @_;
 191
 192     return {
 193         map  { @$_ }                                        # key => value
 194         grep { *{ $_->[1] }{CODE} }                         # only functions
 195         map  { [$_, qualify_to_ref( $_, $class )] }         # get globref
 196         grep { $_ !~ /::$/ }                                # no packages
 197         do   { no strict 'refs'; keys %{ "${class}::" } }   # symbol entries
 198     };
 199 }
 200
 201 =head1 IMPLEMENTATION DETAILS
 202
 203 This module works through the effect that a
 204
 205   delete $SomePackage::{foo};
 206
 207 will remove the C<foo> symbol from C<$SomePackage> for run time lookups
 208 (e.g., method calls) but will leave the entry alive to be called by
 209 already resolved names in the package itself.
 210
 211 A test file has been added to the perl core to ensure that this behaviour
 212 will be stable in future releases.
 213
 214 Just for completeness sake, if you want to remove the symbol completely,
 215 use C<undef> instead.
 216
 217 =head1 SEE ALSO
 218
 219 L<Filter::EOF>
 220
 221 =head1 AUTHOR AND COPYRIGHT
 222
 223 Robert 'phaylon' Sedlacek C<E<lt>rs@474.atE<gt>>, with many thanks to
 224 Matt S Trout for the inspiration on the whole idea.
 225
 226 =head1 LICENSE
 227
 228 This program is free software; you can redistribute it and/or modify
 229 it under the same terms as perl itself.
 230
 231 =cut
 232
 233 1;