}
},
{
+ 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 => {
}
}
+sub add_required_attributes {
+ my $self = shift;
+}
+
+sub add_required_class {
+ my $self = shift;
+}
+
sub add_conflicting_method {
my $self = shift;
$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 @_;
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 ),
--- /dev/null
+#!/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'
+ );
+}
+
+