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
=item L<Moose::Cookbook::Recipe5> - More subtypes, coercion in a B<Request> class
+=item L<Moose::Cookbook::Recipe6> - The Moose::Role example
+
=back
=head1 SEE ALSO
--- /dev/null
+
+=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 E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+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
use warnings;
use Carp 'confess';
-use Scalar::Util 'weaken';
+use Scalar::Util 'weaken', 'blessed';
our $VERSION = '0.04';
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 ...
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;
}
# 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)
);
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;
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.02';
+our $VERSION = '0.03';
use Moose::Meta::TypeConstraint;
use Moose::Meta::TypeCoercion;
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
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; }
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;
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');
+
use strict;
use warnings;
-use Test::More tests => 27;
+use Test::More tests => 28;
use Test::Exception;
BEGIN {
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' ],
use strict;
use warnings;
-use Test::More tests => 16;
+use Test::More tests => 17;
use Test::Exception;
BEGIN {
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' ],
projects / gitmo/Moose.git / commitdiff