lib/namespace/clean.pm

   1 package namespace::clean;
   2
   3 =head1 NAME
   4
   5 namespace::clean - Keep imports 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.02
  19
  20 =cut
  21
  22 $VERSION     = 0.02;
  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);   # will be removed
  32
  33   sub bar { 23 }        # will be removed
  34
  35   use namespace::clean;
  36
  37   sub baz { bar() }     # still defined, 'bar' still bound
  38
  39   no namespace::clean;
  40
  41   sub quux { baz() }    # will be removed again
  42
  43   use namespace::clean;
  44
  45   ### Will print:
  46   #   No
  47   #   No
  48   #   Yes
  49   #   No
  50   print +(__PACKAGE__->can('croak') ? 'Yes' : 'No'), "\n";
  51   print +(__PACKAGE__->can('bar')   ? 'Yes' : 'No'), "\n";
  52   print +(__PACKAGE__->can('baz')   ? 'Yes' : 'No'), "\n";
  53   print +(__PACKAGE__->can('quux')  ? 'Yes' : 'No'), "\n";
  54
  55   1;
  56
  57 =head1 DESCRIPTION
  58
  59 When you define a function, or import one, into a Perl package, it will
  60 naturally also be available as a method. This does not per se cause
  61 problems, but it can complicate subclassing and, for example, plugin
  62 classes that are included by loading them as 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 This means that functions are already bound by their name, and calls to
  67 them still work. But they will not be available as methods on your class
  68 or instances.
  69
  70 =head1 METHODS
  71
  72 You shouldn't need to call any of these. Just C<use> the package at the
  73 appropriate place.
  74
  75 =head2 import
  76
  77 Makes a snapshot of the current defined functions and registers a
  78 L<Filter::EOF> cleanup routine to remove those symbols from the package
  79 at the end of the compile-time.
  80
  81 =cut
  82
  83 sub import {
  84     my ($pragma) = @_;
  85
  86     my $cleanee   = caller;
  87     my $functions = $pragma->get_functions($cleanee);
  88     my $store     = $pragma->get_class_store($cleanee);
  89
  90     for my $f (keys %$functions) {
  91         next unless    $functions->{ $f }
  92                 and *{ $functions->{ $f } }{CODE};
  93         $store->{remove}{ $f } = 1;
  94     }
  95
  96     unless ($store->{handler_is_installed}) {
  97         Filter::EOF->on_eof_call(sub {
  98             for my $f (keys %{ $store->{remove} }) {
  99                 next if $store->{exclude}{ $f };
 100                 no strict 'refs';
 101                 delete ${ "${cleanee}::" }{ $f };
 102             }
 103         });
 104         $store->{handler_is_installed} = 1;
 105     }
 106
 107     return 1;
 108 }
 109
 110 =head2 unimport
 111
 112 This method will be called when you do a
 113
 114   no namespace::clean;
 115
 116 It will start a new section of code that defines functions to clean up.
 117
 118 =cut
 119
 120 sub unimport {
 121     my ($pragma) = @_;
 122
 123     my $cleanee   = caller;
 124     my $functions = $pragma->get_functions($cleanee);
 125     my $store     = $pragma->get_class_store($cleanee);
 126
 127     for my $f (keys %$functions) {
 128         next if $store->{remove}{ $f }
 129              or $store->{exclude}{ $f };
 130         $store->{exclude}{ $f } = 1;
 131     }
 132
 133     return 1;
 134 }
 135
 136 =head2 get_class_store
 137
 138 This returns a reference to a hash in your package containing information
 139 about function names included and excluded from removal.
 140
 141 =cut
 142
 143 sub get_class_store {
 144     my ($pragma, $class) = @_;
 145     no strict 'refs';
 146     return \%{ "${class}::${STORAGE_VAR}" };
 147 }
 148
 149 =head2 get_functions
 150
 151 Takes a class as argument and returns all currently defined functions
 152 in it as a hash reference with the function name as key and a typeglob
 153 reference to the symbol as value.
 154
 155 =cut
 156
 157 sub get_functions {
 158     my ($pragma, $class) = @_;
 159
 160     return {
 161         map  { @$_ }
 162         grep { *{ $_->[1] }{CODE} }
 163         map  { [$_, qualify_to_ref( $_, $class )] }
 164         grep { $_ !~ /::$/ }
 165         do   { no strict 'refs'; keys %{ "${class}::" } }
 166     };
 167 }
 168
 169 =head1 SEE ALSO
 170
 171 L<Filter::EOF>
 172
 173 =head1 AUTHOR AND COPYRIGHT
 174
 175 Robert 'phaylon' Sedlacek C<E<lt>rs@474.atE<gt>>, with many thanks to
 176 Matt S Trout for the inspiration on the whole idea.
 177
 178 =head1 LICENSE
 179
 180 This program is free software; you can redistribute it and/or modify
 181 it under the same terms as perl itself.
 182
 183 =cut
 184
 185 1;