From: Karen Etheridge Date: Wed, 18 May 2011 18:59:58 +0000 (+0000) Subject: role support, in MooseX::StrictConstructor::FromRole X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=refs%2Fheads%2Ftopic%2Frole_support;p=gitmo%2FMooseX-StrictConstructor.git role support, in MooseX::StrictConstructor::FromRole --- diff --git a/Changes b/Changes index 985bf3e..9d34369 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,8 @@ {{$NEXT}} -- Throw an error when used by a non-class; it won't do what users think +- Throw an error when used by a non-class; it won't do what users think (rjbs) +- addition of MooseX::StrictConstructor::FromRole, for people who really want + role support (ether) 0.16 2011-04-22 diff --git a/lib/MooseX/StrictConstructor.pm b/lib/MooseX/StrictConstructor.pm index 80e8453..e678bda 100644 --- a/lib/MooseX/StrictConstructor.pm +++ b/lib/MooseX/StrictConstructor.pm @@ -81,6 +81,12 @@ you can delete it from the hash reference of parameters. } } +=head2 Usage from roles + +It usually doesn't make sense for a role to force its consuming class to use a +strict constructor, so this is not normally permitted. If you desire this +behaviour, you can use C instead. + =head1 BUGS Please report any bugs or feature requests to diff --git a/lib/MooseX/StrictConstructor/FromRole.pm b/lib/MooseX/StrictConstructor/FromRole.pm new file mode 100644 index 0000000..8c6e580 --- /dev/null +++ b/lib/MooseX/StrictConstructor/FromRole.pm @@ -0,0 +1,48 @@ +package MooseX::StrictConstructor::FromRole; + +use strict; +use warnings; + +use Moose 0.94 (); +use Moose::Exporter; +use Moose::Util::MetaRole; + +{ + my %class_meta = ( class => ['MooseX::StrictConstructor::Trait::Class'] ); + my %role_meta; + + if ( $Moose::VERSION < 1.9900 ) { + require MooseX::StrictConstructor::Trait::Method::Constructor; + $class_meta{constructor} + = ['MooseX::StrictConstructor::Trait::Method::Constructor']; + } + else + { + %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, + ); +} + +1; + +# ABSTRACT: MooseX::StrictConstructor behaviour when used from a role + +__END__ + +=pod + +=head1 DESCRIPTION + +This package is equivalent to C except that it also +works from roles. This is only available in Moose 2.0 and later. + +=cut 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..4d62bae --- /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::FromRole; + + 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();