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.03
  19
  20 =cut
  21
  22 $VERSION     = 0.03;
  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 =head1 METHODS
  73
  74 You shouldn't need to call any of these. Just C<use> the package at the
  75 appropriate place.
  76
  77 =cut
  78
  79 =head2 import
  80
  81 Makes a snapshot of the current defined functions and registers a
  82 L<Filter::EOF> cleanup routine to remove those symbols at the end
  83 of the compile-time.
  84
  85 =cut
  86
  87 sub import {
  88     my ($pragma) = @_;
  89
  90     # calling class, all current functions and our storage
  91     my $cleanee   = caller;
  92     my $functions = $pragma->get_functions($cleanee);
  93     my $store     = $pragma->get_class_store($cleanee);
  94
  95     # register symbols for removal, if they have a CODE entry
  96     for my $f (keys %$functions) {
  97         next unless    $functions->{ $f }
  98                 and *{ $functions->{ $f } }{CODE};
  99         $store->{remove}{ $f } = 1;
 100     }
 101
 102     # register EOF handler on first call to import
 103     unless ($store->{handler_is_installed}) {
 104         Filter::EOF->on_eof_call(sub {
 105             for my $f (keys %{ $store->{remove} }) {
 106                 next if $store->{exclude}{ $f };
 107                 no strict 'refs';
 108                 delete ${ "${cleanee}::" }{ $f };
 109             }
 110         });
 111         $store->{handler_is_installed} = 1;
 112     }
 113
 114     return 1;
 115 }
 116
 117 =head2 unimport
 118
 119 This method will be called when you do a
 120
 121   no namespace::clean;
 122
 123 It will start a new section of code that defines functions to clean up.
 124
 125 =cut
 126
 127 sub unimport {
 128     my ($pragma) = @_;
 129
 130     # the calling class, the current functions and our storage
 131     my $cleanee   = caller;
 132     my $functions = $pragma->get_functions($cleanee);
 133     my $store     = $pragma->get_class_store($cleanee);
 134
 135     # register all unknown previous functions as excluded
 136     for my $f (keys %$functions) {
 137         next if $store->{remove}{ $f }
 138              or $store->{exclude}{ $f };
 139         $store->{exclude}{ $f } = 1;
 140     }
 141
 142     return 1;
 143 }
 144
 145 =head2 get_class_store
 146
 147 This returns a reference to a hash in a passed package containing
 148 information about function names included and excluded from removal.
 149
 150 =cut
 151
 152 sub get_class_store {
 153     my ($pragma, $class) = @_;
 154     no strict 'refs';
 155     return \%{ "${class}::${STORAGE_VAR}" };
 156 }
 157
 158 =head2 get_functions
 159
 160 Takes a class as argument and returns all currently defined functions
 161 in it as a hash reference with the function name as key and a typeglob
 162 reference to the symbol as value.
 163
 164 =cut
 165
 166 sub get_functions {
 167     my ($pragma, $class) = @_;
 168
 169     return {
 170         map  { @$_ }                                        # key => value
 171         grep { *{ $_->[1] }{CODE} }                         # only functions
 172         map  { [$_, qualify_to_ref( $_, $class )] }         # get globref
 173         grep { $_ !~ /::$/ }                                # no packages
 174         do   { no strict 'refs'; keys %{ "${class}::" } }   # symbol entries
 175     };
 176 }
 177
 178 =head1 IMPLEMENTATION DETAILS
 179
 180 This module works through the effect that a
 181
 182   delete $SomePackage::{foo};
 183
 184 will remove the C<foo> symbol from C<$SomePackage> for run time lookups
 185 (e.g., method calls) but will leave the entry alive to be called by
 186 already resolved names in the package itself.
 187
 188 A test file has been added to the perl core to ensure that this behaviour
 189 will be stable in future releases.
 190
 191 Just for completeness sake, if you want to remove the symbol completely,
 192 use C<undef> instead.
 193
 194 =head1 SEE ALSO
 195
 196 L<Filter::EOF>
 197
 198 =head1 AUTHOR AND COPYRIGHT
 199
 200 Robert 'phaylon' Sedlacek C<E<lt>rs@474.atE<gt>>, with many thanks to
 201 Matt S Trout for the inspiration on the whole idea.
 202
 203 =head1 LICENSE
 204
 205 This program is free software; you can redistribute it and/or modify
 206 it under the same terms as perl itself.
 207
 208 =cut
 209
 210 1;