make this work in roles
Jesse Luehrs [Mon, 4 Apr 2011 03:24:33 +0000 (22:24 -0500)]
lib/MooseX/UndefTolerant.pm
lib/MooseX/UndefTolerant/ApplicationToClass.pm [new file with mode: 0644]
lib/MooseX/UndefTolerant/ApplicationToRole.pm [new file with mode: 0644]
lib/MooseX/UndefTolerant/Composite.pm [new file with mode: 0644]
lib/MooseX/UndefTolerant/Role.pm [new file with mode: 0644]
t/roles.t [new file with mode: 0644]

index b8ea693..7744594 100644 (file)
@@ -8,18 +8,38 @@ use MooseX::UndefTolerant::Class;
 use MooseX::UndefTolerant::Constructor;
 
 
-my %metaroles = ( attribute => [ 'MooseX::UndefTolerant::Attribute' ] );
+my %metaroles = (
+    class_metaroles => {
+        attribute => [ 'MooseX::UndefTolerant::Attribute' ],
+    }
+);
 if ( $Moose::VERSION < 1.9900 ) {
-        $metaroles{constructor} = [ 'MooseX::UndefTolerant::Constructor' ];
+    $metaroles{class_metaroles}{constructor} = [
+        'MooseX::UndefTolerant::Constructor',
+    ];
 }
 else {
-        $metaroles{class} = [ 'MooseX::UndefTolerant::Class' ];
+    $metaroles{class_metaroles}{class} = [
+        'MooseX::UndefTolerant::Class',
+    ];
+    $metaroles{role_metaroles} = {
+        applied_attribute => [
+            'MooseX::UndefTolerant::Attribute',
+        ],
+        role => [
+            'MooseX::UndefTolerant::Role',
+        ],
+        application_to_class => [
+            'MooseX::UndefTolerant::ApplicationToClass',
+        ],
+        application_to_role => [
+            'MooseX::UndefTolerant::ApplicationToRole',
+        ],
+    };
 }
 
 
-Moose::Exporter->setup_import_methods(
-    class_metaroles => \%metaroles,
-);
+Moose::Exporter->setup_import_methods(%metaroles);
 
 1;
 
diff --git a/lib/MooseX/UndefTolerant/ApplicationToClass.pm b/lib/MooseX/UndefTolerant/ApplicationToClass.pm
new file mode 100644 (file)
index 0000000..353858b
--- /dev/null
@@ -0,0 +1,21 @@
+package MooseX::UndefTolerant::ApplicationToClass;
+use Moose::Role;
+
+around apply => sub {
+    my $orig  = shift;
+    my $self  = shift;
+    my ($role, $class) = @_;
+
+    Moose::Util::MetaRole::apply_metaroles(
+        for             => $class,
+        class_metaroles => {
+            class => [ 'MooseX::UndefTolerant::Class' ],
+        }
+    );
+
+    $self->$orig( $role, $class );
+};
+
+no Moose::Role;
+
+1;
diff --git a/lib/MooseX/UndefTolerant/ApplicationToRole.pm b/lib/MooseX/UndefTolerant/ApplicationToRole.pm
new file mode 100644 (file)
index 0000000..6393923
--- /dev/null
@@ -0,0 +1,26 @@
+package MooseX::UndefTolerant::ApplicationToRole;
+use Moose::Role;
+
+around apply => sub {
+    my $orig  = shift;
+    my $self  = shift;
+    my ($role, $class) = @_;
+
+    Moose::Util::MetaRole::apply_metaroles(
+        for             => $class,
+        role_metaroles => {
+            application_to_class => [
+                'MooseX::UndefTolerant::ApplicationToClass',
+            ],
+            application_to_role => [
+                'MooseX::UndefTolerant::ApplicationToRole',
+            ],
+        }
+    );
+
+    $self->$orig( $role, $class );
+};
+
+no Moose::Role;
+
+1;
diff --git a/lib/MooseX/UndefTolerant/Composite.pm b/lib/MooseX/UndefTolerant/Composite.pm
new file mode 100644 (file)
index 0000000..b7de06d
--- /dev/null
@@ -0,0 +1,25 @@
+package MooseX::UndefTolerant::Composite;
+use Moose::Role;
+
+around apply_params => sub {
+    my $orig = shift;
+    my $self = shift;
+
+    $self->$orig(@_);
+
+    $self = Moose::Util::MetaRole::apply_metaroles(
+        for            => $self,
+        role_metaroles => {
+            application_to_class =>
+                ['MooseX::UndefTolerant::ApplicationToClass'],
+            application_to_role =>
+                ['MooseX::UndefTolerant::ApplicationToRole'],
+        },
+    );
+
+    return $self;
+};
+
+no Moose::Role;
+
+1;
diff --git a/lib/MooseX/UndefTolerant/Role.pm b/lib/MooseX/UndefTolerant/Role.pm
new file mode 100644 (file)
index 0000000..dcfd578
--- /dev/null
@@ -0,0 +1,8 @@
+package MooseX::UndefTolerant::Role;
+use Moose::Role;
+
+sub composition_class_roles { 'MooseX::UndefTolerant::Composite' }
+
+no Moose::Role;
+
+1;
diff --git a/t/roles.t b/t/roles.t
new file mode 100644 (file)
index 0000000..cfc989f
--- /dev/null
+++ b/t/roles.t
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Moose;
+use Test::Fatal;
+
+plan skip_all => "only relevant for Moose 2.0"
+    if Moose->VERSION < 1.9900;
+
+{
+    package Foo::Role;
+    use Moose::Role;
+    use MooseX::UndefTolerant;
+
+    has foo => (
+        is        => 'ro',
+        isa       => 'Str',
+        predicate => 'has_foo',
+    );
+}
+
+{
+    package Foo;
+    use Moose;
+
+    with 'Foo::Role';
+}
+
+{
+    package Bar::Role;
+    use Moose::Role;
+}
+
+{
+    package Bar;
+    use Moose;
+
+    with 'Foo::Role', 'Bar::Role';
+}
+
+with_immutable {
+    my $foo;
+    is(exception { $foo = Foo->new(foo => undef) }, undef,
+       "can set to undef in constructor");
+    ok(!$foo->has_foo, "role attribute isn't set");
+
+    my $bar;
+    is(exception { $bar = Bar->new(foo => undef) }, undef,
+       "can set to undef in constructor");
+    ok(!$bar->has_foo, "role attribute isn't set");
+} 'Foo', 'Bar';
+
+done_testing;