From: Florian Ragwitz <rafl@debian.org>
Date: Fri, 16 Mar 2007 23:00:00 +0000 (+0100)
Subject: Import namespace-clean-0.04.tar.gz.
X-Git-Tag: 0.04^0
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2Fnamespace-clean.git;a=commitdiff_plain;h=53e92ec5277d51ae5e1726f8153b87353bb14665

Import namespace-clean-0.04.tar.gz.
---

diff --git a/Changes b/Changes
index 9a7fc5f..811804a 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,8 @@
 
+    [0.04] Sat Mar 17 16:22:10 CET 2007
+        - Added -except flag
+        - Non-CODE type slots will not be removed
+
     [0.03] Sat Feb 24 22:34:55 CET 2007
         - Minor comment and POD cleanups
         - Tried to clarify how the module works
diff --git a/META.yml b/META.yml
index f79b98a..59c363a 100644
--- a/META.yml
+++ b/META.yml
@@ -1,11 +1,15 @@
+--- 
 abstract: Keep imports and functions out of your namespace
 author: Robert 'phaylon' Sedlacek <rs@474.at>
 build_requires: 
   FindBin: 0
   Test::More: 0.62
 distribution_type: module
-generated_by: Module::Install version 0.64
+generated_by: Module::Install version 0.65
 license: perl
+meta-spec: 
+  url: http://module-build.sourceforge.net/META-spec-v1.3.html
+  version: 1.3
 name: namespace-clean
 no_index: 
   directory: 
@@ -14,4 +18,4 @@ no_index:
 requires: 
   Filter::EOF: 0.02
   Symbol: 0
-version: 0.03
+version: 0.04
diff --git a/README b/README
index ee8a034..dc8dc81 100644
--- a/README
+++ b/README
@@ -2,7 +2,7 @@ NAME
     namespace::clean - Keep imports and functions out of your namespace
 
 VERSION
-    0.03
+    0.04
 
 SYNOPSIS
       package Foo;
@@ -49,6 +49,13 @@ DESCRIPTION
     By unimporting via "no" you can tell "namespace::clean" to start
     collecting functions for the next "use namespace::clean;" specification.
 
+    You can use the "-except" flag to tell "namespace::clean" that you don't
+    want it to remove a certain function. A common use would be a module
+    exporting an "import" method along with some functions:
+
+      use ModuleExportingImport;
+      use namespace::clean -except => [qw( import )];
+
 METHODS
     You shouldn't need to call any of these. Just "use" the package at the
     appropriate place.
diff --git a/Todo b/Todo
index 247b99b..ef07194 100644
--- a/Todo
+++ b/Todo
@@ -1,5 +1,7 @@
 
     General Todo's
     -   Adding "use namespace::clean-start;" and "use namespace::clean-end;"
-    -   Adding "use namespace::clean 'remove_after_compile';" exporting that
-        function allowing "remove_after_compiletime($class, \@functions);"
+    -   Adding "use namespace::clean 'remove_after_compiletime';" exporting 
+        that function allows module authors to do
+            "remove_after_compiletime($class, \@functions);"
+
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 0330b0e..af6a59c 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -28,7 +28,7 @@ BEGIN {
     # This is not enforced yet, but will be some time in the next few
     # releases once we can make sure it won't clash with custom
     # Module::Install extensions.
-    $VERSION = '0.64';
+    $VERSION = '0.65';
 }
 
 # Whether or not inc::Module::Install is actually loaded, the
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index 30a24ca..b46a8ca 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -1,7 +1,7 @@
 #line 1
 package Module::Install::Base;
 
-$VERSION = '0.64';
+$VERSION = '0.65';
 
 # Suspend handler for "redefined" warnings
 BEGIN {
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index 1c01e22..9bcf278 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -11,7 +11,7 @@ use ExtUtils::MakeMaker ();
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.64';
+	$VERSION = '0.65';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index 24c0c02..0d2c39c 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base;
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.64';
+	$VERSION = '0.65';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 96c7e17..eb67033 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -7,7 +7,7 @@ use ExtUtils::MakeMaker ();
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.64';
+	$VERSION = '0.65';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }
@@ -136,9 +136,13 @@ sub write {
                 . "but we need version >= $perl_version";
     }
 
+    $args->{INSTALLDIRS} = $self->installdirs;
+
     my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
-    if ($self->admin->preop) {
-        $args{dist} = $self->admin->preop;
+
+    my $user_preop = delete $args{dist}->{PREOP};
+    if (my $preop = $self->admin->preop($user_preop)) {
+        $args{dist} = $preop;
     }
 
     my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
@@ -205,4 +209,4 @@ sub postamble {
 
 __END__
 
-#line 334
+#line 338
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index 6c80832..b5658c9 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,14 +6,14 @@ use Module::Install::Base;
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.64';
+	$VERSION = '0.65';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }
 
 my @scalar_keys = qw{
     name module_name abstract author version license
-    distribution_type perl_version tests
+    distribution_type perl_version tests installdirs
 };
 
 my @tuple_keys = qw{
@@ -56,6 +56,11 @@ foreach my $key (@tuple_keys) {
     };
 }
 
+sub install_as_core   { $_[0]->installdirs('perl')   }
+sub install_as_cpan   { $_[0]->installdirs('site')   }
+sub install_as_site   { $_[0]->installdirs('site')   }
+sub install_as_vendor { $_[0]->installdirs('vendor') }
+
 sub sign {
     my $self = shift;
     return $self->{'values'}{'sign'} if defined wantarray and !@_;
@@ -279,9 +284,11 @@ sub license_from {
 
     if (
         $self->_slurp($file) =~ m/
-        =head \d \s+
-        (?:licen[cs]e|licensing|copyright|legal)\b
-        (.*?)
+        (
+            =head \d \s+
+            (?:licen[cs]e|licensing|copyright|legal)\b
+            .*?
+        )
         (=head\\d.*|=cut.*|)
         \z
     /ixms
@@ -298,6 +305,7 @@ sub license_from {
             'LGPL'                                            => 'lgpl',
             'BSD'                                             => 'bsd',
             'Artistic'                                        => 'artistic',
+            'MIT'                                             => 'MIT',
         );
         while ( my ( $pattern, $license ) = splice( @phrases, 0, 2 ) ) {
             $pattern =~ s{\s+}{\\s+}g;
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index 2ec7d66..42cb653 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base;
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.64';
+	$VERSION = '0.65';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index 3546e61..d0908fb 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base;
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.64';
+	$VERSION = '0.65';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }
diff --git a/lib/namespace/clean.pm b/lib/namespace/clean.pm
index ac82f8b..9d7268f 100644
--- a/lib/namespace/clean.pm
+++ b/lib/namespace/clean.pm
@@ -15,11 +15,11 @@ use Filter::EOF;
 
 =head1 VERSION
 
-0.03
+0.04
 
 =cut
 
-$VERSION     = 0.03;
+$VERSION     = 0.04;
 $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
 
 =head1 SYNOPSIS
@@ -69,6 +69,13 @@ name, but they won't show up as methods on your class or instances.
 By unimporting via C<no> you can tell C<namespace::clean> to start
 collecting functions for the next C<use namespace::clean;> specification.
 
+You can use the C<-except> flag to tell C<namespace::clean> that you
+don't want it to remove a certain function. A common use would be a 
+module exporting an C<import> method along with some functions:
+
+  use ModuleExportingImport;
+  use namespace::clean -except => [qw( import )];
+
 =head1 METHODS
 
 You shouldn't need to call any of these. Just C<use> the package at the
@@ -85,15 +92,18 @@ of the compile-time.
 =cut
 
 sub import {
-    my ($pragma) = @_;
+    my ($pragma, %args) = @_;
 
     # calling class, all current functions and our storage
     my $cleanee   = caller;
     my $functions = $pragma->get_functions($cleanee);
     my $store     = $pragma->get_class_store($cleanee);
-    
+
+    my %except    = map {( $_ => 1 )} @{ $args{ -except } || [] };
+
     # register symbols for removal, if they have a CODE entry
     for my $f (keys %$functions) {
+        next if     $except{ $f };
         next unless    $functions->{ $f } 
                 and *{ $functions->{ $f } }{CODE};
         $store->{remove}{ $f } = 1;
@@ -102,10 +112,23 @@ sub import {
     # register EOF handler on first call to import
     unless ($store->{handler_is_installed}) {
         Filter::EOF->on_eof_call(sub {
+          SYMBOL:
             for my $f (keys %{ $store->{remove} }) {
-                next if $store->{exclude}{ $f };
+
+                # ignore already removed symbols
+                next SYMBOL if $store->{exclude}{ $f };
                 no strict 'refs';
+
+                # keep original value to restore non-code slots
+                local *__tmp = *{ ${ "${cleanee}::" }{ $f } };
                 delete ${ "${cleanee}::" }{ $f };
+
+              SLOT:
+                # restore non-code slots to symbol
+                for my $t (qw( SCALAR ARRAY HASH IO FORMAT )) {
+                    next SLOT unless defined *__tmp{ $t };
+                    *{ "${cleanee}::$f" } = *__tmp{ $t };
+                }
             }
         });
         $store->{handler_is_installed} = 1;
diff --git a/t/01-function-wipeout.t b/t/01-function-wipeout.t
index a0e3c16..be2430b 100644
--- a/t/01-function-wipeout.t
+++ b/t/01-function-wipeout.t
@@ -4,7 +4,7 @@ use strict;
 
 use FindBin;
 use lib "$FindBin::Bin/lib";
-use Test::More tests => 5;
+use Test::More tests => 9;
 
 use_ok('FunctionWipeout');
 ok( !FunctionWipeout->can('foo'),
@@ -15,4 +15,11 @@ ok( FunctionWipeout->can('baz'),
     'later declared function still exists' );
 is( FunctionWipeout->baz, 23,
     'removed functions still bound' );
-
+ok( FunctionWipeout->can('qux'),
+    '-except flag keeps import' );
+is( FunctionWipeout->qux, 17,
+    'kept import still works' );
+ok( $FunctionWipeout::foo,
+    'non-code symbol was not removed' );
+is( $FunctionWipeout::foo, 777,
+    'non-code symbol still has correct value' );
diff --git a/t/lib/ExporterTest.pm b/t/lib/ExporterTest.pm
index 08f3ea0..98f9bbe 100644
--- a/t/lib/ExporterTest.pm
+++ b/t/lib/ExporterTest.pm
@@ -3,11 +3,13 @@ use warnings;
 use strict;
 
 use base 'Exporter';
-use vars qw( @EXPORT_OK );
+use vars qw( @EXPORT_OK $foo );
 
-@EXPORT_OK = qw( foo bar );
+$foo       = 777;
+@EXPORT_OK = qw( $foo foo bar qux );
 
 sub foo { 23 }
 sub bar { 12 }
+sub qux { 17 }
 
 1;
diff --git a/t/lib/FunctionWipeout.pm b/t/lib/FunctionWipeout.pm
index e788a2b..766cec2 100644
--- a/t/lib/FunctionWipeout.pm
+++ b/t/lib/FunctionWipeout.pm
@@ -2,11 +2,11 @@ package FunctionWipeout;
 use warnings;
 use strict;
 
-use ExporterTest qw(foo);
+use ExporterTest qw( foo qux $foo );
 
 sub bar { foo() }
 
-use namespace::clean;
+use namespace::clean -except => [qw( qux )];
 
 sub baz { bar() }