Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

clean now warns in autoclean namespaces, tests and batteries included

  • Loading branch information...
commit 2b4da35d6b7a84ddf9b4d90373875b0417e535a6 1 parent cff249b
@phaylon phaylon authored
View
50 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;
View
21 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 )]',
View
27 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),
),
);
View
50 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');
+
Please sign in to comment.
Something went wrong with that request. Please try again.