From: Stevan Little Date: Fri, 7 Apr 2006 01:11:46 +0000 (+0000) Subject: ROLES X-Git-Tag: 0_05~47 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a7d0cd00a63c674bb47b228e7d1158db25968e16;p=gitmo%2FMoose.git ROLES --- diff --git a/MANIFEST b/MANIFEST index 7a72ae5..98e5ca3 100644 --- a/MANIFEST +++ b/MANIFEST @@ -14,6 +14,7 @@ lib/Moose/Cookbook/Recipe2.pod lib/Moose/Cookbook/Recipe3.pod lib/Moose/Cookbook/Recipe4.pod lib/Moose/Cookbook/Recipe5.pod +lib/Moose/Cookbook/Recipe6.pod lib/Moose/Meta/Attribute.pm lib/Moose/Meta/Class.pm lib/Moose/Meta/Role.pm diff --git a/lib/Moose/Cookbook.pod b/lib/Moose/Cookbook.pod index 97a6338..9f1b890 100644 --- a/lib/Moose/Cookbook.pod +++ b/lib/Moose/Cookbook.pod @@ -26,6 +26,8 @@ details of the code. =item L - More subtypes, coercion in a B class +=item L - The Moose::Role example + =back =head1 SEE ALSO diff --git a/lib/Moose/Cookbook/Recipe6.pod b/lib/Moose/Cookbook/Recipe6.pod new file mode 100644 index 0000000..ed8d572 --- /dev/null +++ b/lib/Moose/Cookbook/Recipe6.pod @@ -0,0 +1,115 @@ + +=pod + +=head1 NAME + +Moose::Cookbook::Recipe6 - The Moose::Role example + +=head1 SYNOPSIS + + package Constraint; + use strict; + use warnings; + use Moose::Role; + + has 'value' => (isa => 'Int', is => 'ro'); + + around 'validate' => sub { + my $c = shift; + my ($self, $field) = @_; + if ($c->($self, $self->validation_value($field))) { + return undef; + } + else { + return $self->error_message; + } + }; + + sub validation_value { + my ($self, $field) = @_; + return $field; + } + + sub error_message { confess "Abstract method!" } + + package Constraint::OnLength; + use strict; + use warnings; + use Moose::Role; + + has 'units' => (isa => 'Str', is => 'ro'); + + override 'validation_value' => sub { + return length(super()); + }; + + override 'error_message' => sub { + my $self = shift; + return super() . ' ' . $self->units; + }; + + package Constraint::AtLeast; + use strict; + use warnings; + use Moose; + + with 'Constraint'; + + sub validate { + my ($self, $field) = @_; + ($field >= $self->value); + } + + sub error_message { 'must be at least ' . (shift)->value; } + + package Constraint::NoMoreThan; + use strict; + use warnings; + use Moose; + + with 'Constraint'; + + sub validate { + my ($self, $field) = @_; + ($field <= $self->value); + } + + sub error_message { 'must be no more than ' . (shift)->value; } + + package Constraint::LengthNoMoreThan; + use strict; + use warnings; + use Moose; + + extends 'Constraint::NoMoreThan'; + with 'Constraint::OnLength'; + + package Constraint::LengthAtLeast; + use strict; + use warnings; + use Moose; + + extends 'Constraint::AtLeast'; + with 'Constraint::OnLength'; + +=head1 DESCRIPTION + +Coming Soon. + +(the other 4 recipes kinda burned me out a bit) + +=head1 AUTHOR + +Stevan Little Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + \ No newline at end of file diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 37c8552..d32abf1 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp 'confess'; -use Scalar::Util 'weaken'; +use Scalar::Util 'weaken', 'blessed'; our $VERSION = '0.04'; @@ -50,6 +50,22 @@ sub construct_instance { return $instance; } +sub has_method { + my ($self, $method_name) = @_; + (defined $method_name && $method_name) + || confess "You must define a method name"; + + my $sub_name = ($self->name . '::' . $method_name); + + no strict 'refs'; + return 0 if !defined(&{$sub_name}); + my $method = \&{$sub_name}; + + return 1 if blessed($method) && $method->isa('Moose::Meta::Role::Method'); + return $self->SUPER::has_method($method_name); +} + + sub add_override_method_modifier { my ($self, $name, $method, $_super_package) = @_; # need this for roles ... diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm index a7f284e..ae3bb78 100644 --- a/lib/Moose/Meta/Role.pm +++ b/lib/Moose/Meta/Role.pm @@ -33,7 +33,10 @@ __PACKAGE__->meta->add_attribute('method_modifier_map' => ( sub new { my $class = shift; my %options = @_; - $options{role_meta} = Class::MOP::Class->initialize($options{role_name}); + $options{role_meta} = Class::MOP::Class->initialize( + $options{role_name}, + ':method_metaclass' => 'Moose::Meta::Role::Method' + ); my $self = $class->meta->new_object(%options); return $self; } @@ -55,7 +58,7 @@ sub apply { # skip it if it has one already next if $other->has_method($method_name); # add it, although it could be overriden - $other->add_method( + $other->alias_method( $method_name, $self->get_method($method_name) ); @@ -170,6 +173,14 @@ sub get_method_modifier_list { keys %{$self->get_method_modifier_map->{$modifier_type}}; } +package Moose::Meta::Role::Method; + +use strict; +use warnings; + +our $VERSION = '0.01'; + +use base 'Class::MOP::Method'; 1; diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index c8bbe76..b25a5b5 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -7,7 +7,7 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed'; -our $VERSION = '0.02'; +our $VERSION = '0.03'; use Moose::Meta::TypeConstraint; use Moose::Meta::TypeCoercion; @@ -146,7 +146,7 @@ and they are not used by Moose unless you tell it to. No type inference is performed, expression are not typed, etc. etc. etc. This is simply a means of creating small constraint functions which -can be used to simply your own type-checking code. +can be used to simplify your own type-checking code. =head2 Default Type Constraints diff --git a/t/006_basic.t b/t/006_basic.t index 05cdfdd..c62a801 100644 --- a/t/006_basic.t +++ b/t/006_basic.t @@ -3,44 +3,72 @@ use strict; use warnings; -use Test::More tests => 1; +use Test::More tests => 15; use Test::Exception; BEGIN { use_ok('Moose'); } +## Roles + { package Constraint; use strict; use warnings; - use Moose; + use Moose::Role; - sub validate { confess "Abstract method!" } - sub error_message { confess "Abstract method!" } + has 'value' => (isa => 'Int', is => 'ro'); + around 'validate' => sub { + my $c = shift; + my ($self, $field) = @_; + if ($c->($self, $self->validation_value($field))) { + return undef; + } + else { + return $self->error_message; + } + }; + sub validation_value { my ($self, $field) = @_; - return $field->value; + return $field; } + + sub error_message { confess "Abstract method!" } + + package Constraint::OnLength; + use strict; + use warnings; + use Moose::Role; + + has 'units' => (isa => 'Str', is => 'ro'); + + override 'validation_value' => sub { + return length(super()); + }; + + override 'error_message' => sub { + my $self = shift; + return super() . ' ' . $self->units; + }; + +} + +## Classes +{ package Constraint::AtLeast; use strict; use warnings; use Moose; - extends 'Constraint'; - - has 'value' => (isa => 'Num', is => 'ro'); + with 'Constraint'; sub validate { my ($self, $field) = @_; - if ($self->validation_value($field) >= $self->value) { - return undef; - } - else { - return $self->error_message; - } + ($field >= $self->value); } sub error_message { 'must be at least ' . (shift)->value; } @@ -50,37 +78,15 @@ BEGIN { use warnings; use Moose; - extends 'Constraint'; - - has 'value' => (isa => 'Num', is => 'ro'); + with 'Constraint'; sub validate { my ($self, $field) = @_; - if ($self->validation_value($field) <= $self->value) { - return undef; - } else { - return $self->error_message; - } + ($field <= $self->value); } sub error_message { 'must be no more than ' . (shift)->value; } - package Constraint::OnLength; - use strict; - use warnings; - use Moose::Role; - - has 'units' => (isa => 'Str', is => 'ro'); - - override 'value' => sub { - return length(super()); - }; - - override 'error_message' => sub { - my $self = shift; - return super() . ' ' . $self->units; - }; - package Constraint::LengthNoMoreThan; use strict; use warnings; @@ -97,3 +103,34 @@ BEGIN { extends 'Constraint::AtLeast'; with 'Constraint::OnLength'; } + +my $no_more_than_10 = Constraint::NoMoreThan->new(value => 10); +isa_ok($no_more_than_10, 'Constraint::NoMoreThan'); + +ok(!defined($no_more_than_10->validate(1)), '... validated correctly'); +is($no_more_than_10->validate(11), 'must be no more than 10', '... validation failed correctly'); + +my $at_least_10 = Constraint::AtLeast->new(value => 10); +isa_ok($at_least_10, 'Constraint::AtLeast'); + +ok(!defined($at_least_10->validate(11)), '... validated correctly'); +is($at_least_10->validate(1), 'must be at least 10', '... validation failed correctly'); + +# onlength + +my $no_more_than_10_chars = Constraint::LengthNoMoreThan->new(value => 10, units => 'chars'); +isa_ok($no_more_than_10_chars, 'Constraint::LengthNoMoreThan'); +isa_ok($no_more_than_10_chars, 'Constraint::NoMoreThan'); + +ok(!defined($no_more_than_10_chars->validate('foo')), '... validated correctly'); +is($no_more_than_10_chars->validate('foooooooooo'), + 'must be no more than 10 chars', + '... validation failed correctly'); + +my $at_least_10_chars = Constraint::LengthAtLeast->new(value => 10, units => 'chars'); +isa_ok($at_least_10_chars, 'Constraint::LengthAtLeast'); +isa_ok($at_least_10_chars, 'Constraint::AtLeast'); + +ok(!defined($at_least_10_chars->validate('barrrrrrrrr')), '... validated correctly'); +is($at_least_10_chars->validate('bar'), 'must be at least 10 chars', '... validation failed correctly'); + diff --git a/t/040_meta_role.t b/t/040_meta_role.t index 205b0df..b3b8328 100644 --- a/t/040_meta_role.t +++ b/t/040_meta_role.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 27; +use Test::More tests => 28; use Test::Exception; BEGIN { @@ -33,6 +33,8 @@ is($foo_role->version, '0.01', '... got the right version of FooRole'); ok($foo_role->has_method('foo'), '... FooRole has the foo method'); is($foo_role->get_method('foo'), \&FooRole::foo, '... FooRole got the foo method'); +isa_ok($foo_role->get_method('foo'), 'Moose::Meta::Role::Method'); + is_deeply( [ $foo_role->get_method_list() ], [ 'foo' ], diff --git a/t/041_role.t b/t/041_role.t index 8992173..d5080ba 100644 --- a/t/041_role.t +++ b/t/041_role.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 16; +use Test::More tests => 17; use Test::Exception; BEGIN { @@ -40,6 +40,8 @@ is($foo_role->version, '0.01', '... got the right version of FooRole'); ok($foo_role->has_method('foo'), '... FooRole has the foo method'); is($foo_role->get_method('foo'), \&FooRole::foo, '... FooRole got the foo method'); +isa_ok($foo_role->get_method('foo'), 'Moose::Meta::Role::Method'); + is_deeply( [ $foo_role->get_method_list() ], [ 'foo' ],