From: Stevan Little <stevan@Macintosh.local>
Date: Thu, 22 Oct 2009 05:00:25 +0000 (-0400)
Subject: requires_attr and requires_class stubs
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=83b9153691ee9071427c10662d68646463d41690;p=gitmo%2FMoose.git

requires_attr and requires_class stubs
---

diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm
index 16a2161..270f4ba 100644
--- a/lib/Moose/Meta/Role.pm
+++ b/lib/Moose/Meta/Role.pm
@@ -71,6 +71,24 @@ foreach my $action (
         }
     },
     {
+        name        => 'required_attributes',
+        attr_reader => 'get_required_attributes_map',
+        methods     => {
+            remove     => 'remove_required_attributes',
+            get_values => 'get_required_attribute_list',
+            existence  => 'requires_attribute',
+        }
+    },
+    {
+        name        => 'required_classes',
+        attr_reader => 'get_required_classes_map',
+        methods     => {
+            remove     => 'remove_required_classes',
+            get_values => 'get_required_class_list',
+            existence  => 'requires_class',
+        }
+    },
+    {
         name        => '_attribute_map',
         attr_reader => '_attribute_map',
         methods     => {
@@ -198,6 +216,14 @@ sub add_required_methods {
     }
 }
 
+sub add_required_attributes {
+    my $self = shift;
+}
+
+sub add_required_class {
+    my $self = shift;
+}
+
 sub add_conflicting_method {
     my $self = shift;
 
diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm
index 4ca88a3..76e47d2 100644
--- a/lib/Moose/Role.pm
+++ b/lib/Moose/Role.pm
@@ -32,6 +32,18 @@ sub requires {
     $meta->add_required_methods(@_);
 }
 
+sub requires_attr {
+    my $meta = shift;
+    croak "Must specify at least one attribute" unless @_;
+    $meta->add_required_attributes(@_);
+}
+
+sub requires_class {
+    my $meta = shift;
+    croak "Must specify at least one class" unless @_;
+    $meta->add_required_class(@_);
+}
+
 sub excludes {
     my $meta = shift;
     croak "Must specify at least one role" unless @_;
@@ -90,7 +102,7 @@ sub augment {
 
 Moose::Exporter->setup_import_methods(
     with_meta => [
-        qw( with requires excludes has before after around override )
+        qw( with requires requires_attr requires_class excludes has before after around override )
     ],
     as_is => [
         qw( extends super inner augment ),
diff --git a/t/030_roles/027_role_composition_req_attrs.t b/t/030_roles/027_role_composition_req_attrs.t
new file mode 100644
index 0000000..fdd1fe6
--- /dev/null
+++ b/t/030_roles/027_role_composition_req_attrs.t
@@ -0,0 +1,125 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 16;
+use Test::Exception;
+
+use Moose::Meta::Role::Application::RoleSummation;
+use Moose::Meta::Role::Composite;
+
+{
+    package Role::Foo;
+    use Moose::Role;
+    requires_attr 'foo';
+
+    package Role::Bar;
+    use Moose::Role;
+    requires_attr 'bar';
+
+    package Role::ProvidesFoo;
+    use Moose::Role;
+    has 'foo' => (is => 'ro');
+
+    package Role::ProvidesBar;
+    use Moose::Role;
+    has 'bar' => (is => 'ro');
+}
+
+# test simple requirement
+{
+    my $c = Moose::Meta::Role::Composite->new(
+        roles => [
+            Role::Foo->meta,
+            Role::Bar->meta,
+        ]
+    );
+    isa_ok($c, 'Moose::Meta::Role::Composite');
+
+    is($c->name, 'Role::Foo|Role::Bar', '... got the composite role name');
+
+    lives_ok {
+        Moose::Meta::Role::Application::RoleSummation->new->apply($c);
+    } '... this succeeds as expected';
+
+    is_deeply(
+        [ sort $c->get_required_attribute_list ],
+        [ 'bar', 'foo' ],
+        '... got the right list of required attributes'
+    );
+}
+
+# test requirement satisfied
+{
+    my $c = Moose::Meta::Role::Composite->new(
+        roles => [
+            Role::Foo->meta,
+            Role::ProvidesFoo->meta,
+        ]
+    );
+    isa_ok($c, 'Moose::Meta::Role::Composite');
+
+    is($c->name, 'Role::Foo|Role::ProvidesFoo', '... got the composite role name');
+
+    lives_ok {
+        Moose::Meta::Role::Application::RoleSummation->new->apply($c);
+    } '... this succeeds as expected';
+
+    is_deeply(
+        [ sort $c->get_required_attribute_list ],
+        [ 'FAIL' ],
+        '... got the right list of required attributes'
+    );
+}
+
+# test requirement satisfied
+{
+    my $c = Moose::Meta::Role::Composite->new(
+        roles => [
+            Role::Foo->meta,
+            Role::ProvidesFoo->meta,
+            Role::Bar->meta,
+        ]
+    );
+    isa_ok($c, 'Moose::Meta::Role::Composite');
+
+    is($c->name, 'Role::Foo|Role::ProvidesFoo|Role::Bar', '... got the composite role name');
+
+    lives_ok {
+        Moose::Meta::Role::Application::RoleSummation->new->apply($c);
+    } '... this succeeds as expected';
+
+    is_deeply(
+        [ sort $c->get_required_attribute_list ],
+        [ 'bar', ],
+        '... got the right list of required attributes'
+    );
+}
+
+# test requirement satisfied
+{
+    my $c = Moose::Meta::Role::Composite->new(
+        roles => [
+            Role::Foo->meta,
+            Role::ProvidesFoo->meta,
+            Role::ProvidesBar->meta,
+            Role::Bar->meta,
+        ]
+    );
+    isa_ok($c, 'Moose::Meta::Role::Composite');
+
+    is($c->name, 'Role::Foo|Role::ProvidesFoo|Role::ProvidesBar|Role::Bar', '... got the composite role name');
+
+    lives_ok {
+        Moose::Meta::Role::Application::RoleSummation->new->apply($c);
+    } '... this succeeds as expected';
+
+    is_deeply(
+        [ sort $c->get_required_attribute_list ],
+        [ 'FAIL' ],
+        '... got the right list of required attributes'
+    );
+}
+
+
diff --git a/t/030_roles/028_role_composition_req_class.t b/t/030_roles/028_role_composition_req_class.t
new file mode 100644
index 0000000..02a638d
--- /dev/null
+++ b/t/030_roles/028_role_composition_req_class.t
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 16;
+use Test::Exception;
+
+use Moose::Meta::Role::Application::RoleSummation;
+use Moose::Meta::Role::Composite;
+
+{
+    package Role::Foo;
+    use Moose::Role;
+    requires_class 'Class::Foo';
+
+    package Role::Bar;
+    use Moose::Role;
+    requires_class 'Class::Bar';
+
+    package Class::Foo;
+    use Moose;
+    with 'Role::Foo';
+
+    package Class::Bar;
+    use Moose;
+    with 'Role::Bar';
+
+}
+
+fail "This needs a test";
\ No newline at end of file