From: Karen Etheridge <ether@cpan.org>
Date: Thu, 7 Apr 2011 23:16:48 +0000 (-0700)
Subject: working role support!
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=44641a6189baef2d1c9c8c5ab48405768fadfd3c;p=gitmo%2FMooseX-StrictConstructor.git

working role support!
---

diff --git a/lib/MooseX/StrictConstructor.pm b/lib/MooseX/StrictConstructor.pm
index e7cfda2..a16b392 100644
--- a/lib/MooseX/StrictConstructor.pm
+++ b/lib/MooseX/StrictConstructor.pm
@@ -10,6 +10,7 @@ use MooseX::StrictConstructor::Role::Object;
 
 {
     my %class_meta;
+    my %role_meta;
 
     if ( $Moose::VERSION < 1.9900 ) {
         require MooseX::StrictConstructor::Trait::Method::Constructor;
@@ -22,10 +23,17 @@ use MooseX::StrictConstructor::Role::Object;
         require MooseX::StrictConstructor::Trait::Class;
         %class_meta
             = ( class => ['MooseX::StrictConstructor::Trait::Class'] );
+        %role_meta
+            = (
+                role => ['MooseX::StrictConstructor::Trait::Role'],
+                application_to_class => ['MooseX::StrictConstructor::Trait::ApplicationToClass'],
+                application_to_role =>['MooseX::StrictConstructor::Trait::ApplicationToRole'],
+              );
     }
 
     Moose::Exporter->setup_import_methods(
             class_metaroles  => \%class_meta,
+            role_metaroles   => \%role_meta,
             base_class_roles => ['MooseX::StrictConstructor::Role::Object'],
     );
 }
@@ -59,6 +67,10 @@ constructor is called with an attribute init argument that your class
 does not declare, then it calls C<Moose->throw_error()>. This is a great way
 to catch small typos.
 
+As of Moose 1.9900, this module can also be used in a role, in which case the
+constructor of the consuming class will become strict.
+
+
 =head2 Subverting Strictness
 
 You may find yourself wanting to have your constructor accept a
diff --git a/lib/MooseX/StrictConstructor/Trait/ApplicationToClass.pm b/lib/MooseX/StrictConstructor/Trait/ApplicationToClass.pm
new file mode 100644
index 0000000..7ec0fd2
--- /dev/null
+++ b/lib/MooseX/StrictConstructor/Trait/ApplicationToClass.pm
@@ -0,0 +1,26 @@
+package MooseX::StrictConstructor::Trait::ApplicationToClass;
+use Moose::Role;
+
+around apply => sub {
+    my $orig  = shift;
+    my $self  = shift;
+    my ($role, $class) = @_;
+
+    Moose::Util::MetaRole::apply_base_class_roles(
+        for => $class,
+        roles => ['MooseX::StrictConstructor::Role::Object'],
+    );
+
+    $class = Moose::Util::MetaRole::apply_metaroles(
+        for             => $class,
+        class_metaroles => {
+            class => [ 'MooseX::StrictConstructor::Trait::Class' ],
+        }
+    );
+
+    $self->$orig( $role, $class );
+};
+
+no Moose::Role;
+
+1;
diff --git a/lib/MooseX/StrictConstructor/Trait/ApplicationToRole.pm b/lib/MooseX/StrictConstructor/Trait/ApplicationToRole.pm
new file mode 100644
index 0000000..5f8e629
--- /dev/null
+++ b/lib/MooseX/StrictConstructor/Trait/ApplicationToRole.pm
@@ -0,0 +1,26 @@
+package MooseX::StrictConstructor::Trait::ApplicationToRole;
+use Moose::Role;
+
+around apply => sub {
+    my $orig  = shift;
+    my $self  = shift;
+    my ($role1, $role2) = @_;
+
+    $role2 = Moose::Util::MetaRole::apply_metaroles(
+        for             => $role2,
+        role_metaroles => {
+            application_to_class => [
+                'MooseX::StrictConstructor::Trait::ApplicationToClass',
+            ],
+            application_to_role => [
+                'MooseX::StrictConstructor::Trait::ApplicationToRole',
+            ],
+        }
+    );
+
+    $self->$orig( $role1, $role2 );
+};
+
+no Moose::Role;
+
+1;
diff --git a/lib/MooseX/StrictConstructor/Trait/Composite.pm b/lib/MooseX/StrictConstructor/Trait/Composite.pm
new file mode 100644
index 0000000..bd8b647
--- /dev/null
+++ b/lib/MooseX/StrictConstructor/Trait/Composite.pm
@@ -0,0 +1,25 @@
+package MooseX::StrictConstructor::Trait::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::StrictConstructor::Trait::ApplicationToClass'],
+            application_to_role =>
+                ['MooseX::StrictConstructor::Trait::ApplicationToRole'],
+        },
+    );
+
+    return $self;
+};
+
+no Moose::Role;
+
+1;
diff --git a/lib/MooseX/StrictConstructor/Trait/Role.pm b/lib/MooseX/StrictConstructor/Trait/Role.pm
new file mode 100644
index 0000000..47cc8a6
--- /dev/null
+++ b/lib/MooseX/StrictConstructor/Trait/Role.pm
@@ -0,0 +1,9 @@
+package MooseX::StrictConstructor::Trait::Role;
+
+use Moose::Role;
+
+sub composition_class_roles { 'MooseX::StrictConstructor::Trait::Composite' }
+
+no Moose::Role;
+
+1;
diff --git a/t/role.t b/t/role.t
new file mode 100644
index 0000000..bb10f39
--- /dev/null
+++ b/t/role.t
@@ -0,0 +1,37 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Test::Moose qw( with_immutable );
+
+{
+    package Role;
+
+    use Moose::Role;
+    use MooseX::StrictConstructor;
+
+    has 'size' => ( is => 'rw' );
+}
+
+{
+    package Standard;
+
+    use Moose;
+    with 'Role';
+
+    has 'thing' => ( is => 'rw' );
+}
+
+my @classes = qw( Standard );
+with_immutable {
+
+    like(
+        exception { Standard->new( thing => 1, bad => 99 ) },
+        qr/unknown attribute.+: bad/,
+        'strict constructor applied from role blows up on unknown params'
+    );
+}
+@classes;
+
+done_testing();