From: Jesse Luehrs Date: Mon, 4 Apr 2011 03:24:33 +0000 (-0500) Subject: make this work in roles X-Git-Tag: 0.12~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fff0a09d7aa2aaccf7ab93d2f5cb005ada59a1d9;p=gitmo%2FMooseX-UndefTolerant.git make this work in roles --- diff --git a/lib/MooseX/UndefTolerant.pm b/lib/MooseX/UndefTolerant.pm index b8ea693..7744594 100644 --- a/lib/MooseX/UndefTolerant.pm +++ b/lib/MooseX/UndefTolerant.pm @@ -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 index 0000000..353858b --- /dev/null +++ b/lib/MooseX/UndefTolerant/ApplicationToClass.pm @@ -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 index 0000000..6393923 --- /dev/null +++ b/lib/MooseX/UndefTolerant/ApplicationToRole.pm @@ -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 index 0000000..b7de06d --- /dev/null +++ b/lib/MooseX/UndefTolerant/Composite.pm @@ -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 index 0000000..dcfd578 --- /dev/null +++ b/lib/MooseX/UndefTolerant/Role.pm @@ -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 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;