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 );
  13 use Symbol            qw( qualify_to_ref );
  14 use Filter::EOF;
  15
  16 =head1 VERSION
  17
  18 0.01
  19
  20 =cut
  21
  22 $VERSION = 0.01;
  23
  24 =head1 SYNOPSIS
  25
  26   package Foo;
  27   use warnings;
  28   use strict;
  29
  30   use Carp qw(croak);   # will be removed
  31
  32   sub bar { 23 }        # will be removed
  33
  34   use namespace::clean;
  35
  36   sub baz { bar() }     # still defined, 'bar' still bound
  37
  38   ### Will print:
  39   #   No
  40   #   No
  41   #   Yes
  42   print +(__PACKAGE__->can('croak') ? 'Yes' : 'No'), "\n";
  43   print +(__PACKAGE__->can('bar')   ? 'Yes' : 'No'), "\n";
  44   print +(__PACKAGE__->can('baz')   ? 'Yes' : 'No'), "\n";
  45
  46   1;
  47
  48 =head1 DESCRIPTION
  49
  50 When you define a function, or import one, into a Perl package, it will
  51 naturally also be available as a method. This does not per se cause
  52 problems, but it can complicate subclassing and, for example, plugin
  53 classes that are included by loading them as base classes.
  54
  55 The C<namespace::clean> pragma will remove all previously declared or
  56 imported symbols at the end of the current package's compile cycle.
  57 This means that functions are already bound by their name, and calls to
  58 them still work. But they will not be available as methods on your class
  59 or instances.
  60
  61 =head1 METHODS
  62
  63 You shouldn't need to call any of these. Just C<use> the package at the
  64 appropriate place.
  65
  66 =head2 import
  67
  68 Makes a snapshot of the current defined functions and registers a
  69 L<Filter::EOF> cleanup routine to remove those symbols from the package
  70 at the end of the compile-time.
  71
  72 =cut
  73
  74 sub import {
  75     my ($pragma) = @_;
  76
  77     my $cleanee   = caller;
  78     my $functions = $pragma->get_functions($cleanee);
  79
  80     Filter::EOF->on_eof_call(sub {
  81         for my $f (keys %$functions) {
  82             next unless $functions->{ $f }
  83                     and *{ $functions->{ $f } }{CODE};
  84             {   no strict 'refs';
  85                 delete ${ "${cleanee}::" }{ $f };
  86             }
  87         }
  88     });
  89 }
  90
  91 =head2 get_functions
  92
  93 Takes a class as argument and returns all currently defined functions
  94 in it as a hash reference with the function name as key and a typeglob
  95 reference to the symbol as value.
  96
  97 =cut
  98
  99 sub get_functions {
 100     my ($pragma, $class) = @_;
 101
 102     return {
 103         map  { @$_ }
 104         grep { *{ $_->[1] }{CODE} }
 105         map  { [$_, qualify_to_ref( $_, $class )] }
 106         grep { $_ !~ /::$/ }
 107         do   { no strict 'refs'; keys %{ "${class}::" } }
 108     };
 109 }
 110
 111 =head1 SEE ALSO
 112
 113 L<Filter::EOF>
 114
 115 =head1 AUTHOR AND COPYRIGHT
 116
 117 Robert 'phaylon' Sedlacek C<E<lt>rs@474.atE<gt>>, with many thanks to
 118 Matt S Trout for the inspiration on the whole idea.
 119
 120 =head1 LICENSE
 121
 122 This program is free software; you can redistribute it and/or modify
 123 it under the same terms as perl itself.
 124
 125 =cut
 126
 127 1;