clean now warns in autoclean namespaces, tests and batteries included

j1n3l0 · May 3, 2009 · 2b4da35 · 2b4da35
1 parent cff249b
commit 2b4da35
Show file tree

Hide file tree

Showing 4 changed files with 143 additions and 5 deletions.
diff --git a/lib/MooseX/Declare/StackItem.pm b/lib/MooseX/Declare/StackItem.pm
@@ -0,0 +1,50 @@
+package MooseX::Declare::StackItem;
+
+use Moose;
+
+use namespace::clean -except => 'meta';
+use overload '""' => 'as_string', fallback => 1;
+
+has identifier => (
+    is          => 'rw',
+    isa         => 'Str',
+    required    => 1,
+);
+
+has handler => (
+    is          => 'ro',
+    required    => 1,
+    default     => '',
+);
+
+has is_dirty => (
+    is          => 'ro',
+    isa         => 'Bool',
+);
+
+has namespace => (
+    is          => 'ro',
+    isa         => 'Str|Undef',
+
+);
+
+sub as_string {
+    my ($self) = @_;
+    return $self->identifier;
+}
+
+sub serialize {
+    my ($self) = @_;
+    return sprintf '%s->new(%s)',
+        ref($self),
+        join ', ', map { defined($_) ? "q($_)" : 'undef' }
+        'identifier', $self->identifier,
+        'handler',    $self->handler,
+        'is_dirty',   ( $self->is_dirty ? 1 : 0 ),
+        'namespace',  $self->namespace,
+        ;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
diff --git a/lib/MooseX/Declare/Syntax/Keyword/Clean.pm b/lib/MooseX/Declare/Syntax/Keyword/Clean.pm
@@ -2,15 +2,36 @@ package MooseX::Declare::Syntax::Keyword::Clean;
 
 use Moose;
 
+use constant NAMESPACING_ROLE => 'MooseX::Declare::Syntax::NamespaceHandling';
+use Carp qw( cluck );
+
 use namespace::clean -except => 'meta';
 
 with qw(
     MooseX::Declare::Syntax::KeywordHandling
 );
 
+sub find_namespace_handler {
+    my ($self, $ctx) = @_;
+
+    for my $item (reverse @{ $ctx->stack }) {
+        return $item
+            if $item->handler->does(NAMESPACING_ROLE);
+    }
+
+    return undef;
+}
+
 sub parse {
     my ($self, $ctx) = @_;
 
+    if (my $stack_item = $self->find_namespace_handler($ctx)) {
+        my $namespace = $stack_item->namespace;
+
+        cluck "Attempted to clean an already cleaned namespace ($namespace). Did you mean to use 'is dirty'?"
+            unless $stack_item->is_dirty;
+    }
+
     $ctx->skip_declarator;
     $ctx->inject_code_parts_here(
         ';use namespace::clean -except => [qw( meta )]',

diff --git a/lib/MooseX/Declare/Syntax/NamespaceHandling.pm b/lib/MooseX/Declare/Syntax/NamespaceHandling.pm
@@ -1,10 +1,11 @@
 package MooseX::Declare::Syntax::NamespaceHandling;
 
 use Moose::Role;
-use MooseX::Declare::Util qw( outer_stack_peek );
+use MooseX::Declare::Util   qw( outer_stack_peek );
 
 use aliased 'MooseX::Declare::Context::Namespaced';
 use aliased 'MooseX::Declare::Context::WithOptions';
+use aliased 'MooseX::Declare::StackItem';
 
 use namespace::clean -except => 'meta';
 
@@ -43,6 +44,26 @@ sub parse_option_specification {
     return scalar $ctx->strip_options;
 }
 
+sub generate_inline_stack {
+    my ($self, $ctx) = @_;
+
+    return join ', ',
+        map { $_->serialize }
+            @{ $ctx->stack },
+            $self->generate_current_stack_item($ctx);
+}
+
+sub generate_current_stack_item {
+    my ($self, $ctx) = @_;
+
+    return StackItem->new(
+        identifier    => $self->identifier,
+        is_dirty      => $ctx->options->{is}{dirty},
+        handler       => ref($self),
+        namespace     => $ctx->namespace,
+    );
+}
+
 sub parse {
     my ($self, $ctx) = @_;
 
@@ -82,9 +103,9 @@ sub parse {
     $ctx->add_preamble_code_parts(
         "package ${package}",
         sprintf(
-            "use MooseX::Declare %s => '%s', file => __FILE__, stack => [qw( %s )]",
+            "use MooseX::Declare %s => '%s', file => __FILE__, stack => [ %s ]",
             outer_package => $package,
-            join(' ', @{ $ctx->stack }, $self->identifier),
+            $self->generate_inline_stack($ctx),
         ),
     );
 

diff --git a/t/autoclean.t b/t/autoclean.t
@@ -1,5 +1,5 @@
 use MooseX::Declare;
-use Test::More tests => 3;
+use Test::More tests => 9;
 
 class Foo {
     use Carp 'croak';
@@ -13,6 +13,52 @@ class Baz is clean {
     use Carp 'croak';
 }
 
+my $clean_has_warned;
+BEGIN { 
+    $SIG{__WARN__} = sub {
+        my ($message) = @_;
+        if ($message =~ /Attempted to clean an already cleaned namespace/i) {
+            $clean_has_warned = $message;
+            return;
+        }
+        warn $message;
+    };
+}
+
+class Qux {
+    use Carp 'croak';
+    clean;
+}
+
+my $clean_has_not_warned;
+BEGIN { 
+    $clean_has_not_warned = 1;
+    $SIG{__WARN__} = sub {
+        my ($message) = @_;
+        if ($message =~ /Attempted to clean an already cleaned namespace/i) {
+            $clean_has_warned = 0;
+            return;
+        }
+        warn $message;
+    };
+}
+
+class Quux is dirty {
+    use Carp 'croak';
+    clean;
+}
+
+undef $SIG{__WARN__};
+
 ok(!Foo->can('croak'), '... Foo is clean');
 ok( Bar->can('croak'), '... Bar is dirty');
-ok(!Baz->can('croak'), '... Foo is clean');
+ok(!Baz->can('croak'), '... Baz is clean');
+
+ok(!Qux->can('croak'), '... Qux is clean');
+ok($clean_has_warned, 'Qux usage of clean and autoclean leads to warning');
+like($clean_has_warned, qr/is dirty/, 'warning contains "is dirty" hint');
+like($clean_has_warned, qr/Qux/, 'warning contains Qux namespace');
+
+ok(!Quux->can('croak'), '... Quux is clean');
+ok($clean_has_not_warned, 'Quux usage of clean in a dirty class leads to no warning');
+