# make a subtype for each Moose class
subtype $pkg
=> as 'Object'
- => where { $_->isa($pkg) };
+ => where { $_->isa($pkg) }
+ unless find_type_constraint($pkg);
my $meta;
if ($pkg->can('meta')) {
=item Moose Offers Often Super Extensions
+=item Meta Object Orientation Syntax Extensions
+
=back
=head1 BUILDING CLASSES WITH MOOSE
=head1 SYNOPSIS
- package Constraint;
+ package Eq;
use strict;
use warnings;
use Moose::Role;
- has 'value' => (isa => 'Int', is => 'ro');
+ requires 'equal_to';
- around 'validate' => sub {
- my $c = shift;
- my ($self, $field) = @_;
- return undef if $c->($self, $self->validation_value($field));
- return $self->error_message;
- };
-
- sub validation_value {
- my ($self, $field) = @_;
- return $field;
+ sub not_equal_to {
+ my ($self, $other) = @_;
+ !$self->equal_to($other);
}
- sub error_message { confess "Abstract method!" }
-
- package Constraint::OnLength;
+ package Ord;
use strict;
use warnings;
use Moose::Role;
- has 'units' => (isa => 'Str', is => 'ro');
+ with 'Eq';
- override 'validation_value' => sub {
- return length(super());
- };
+ requires 'compare';
- override 'error_message' => sub {
- my $self = shift;
- return super() . ' ' . $self->units;
- };
+ sub equal_to {
+ my ($self, $other) = @_;
+ $self->compare($other) == 0;
+ }
- package Constraint::AtLeast;
- use strict;
- use warnings;
- use Moose;
+ sub greater_than {
+ my ($self, $other) = @_;
+ $self->compare($other) == 1;
+ }
- with 'Constraint';
-
- sub validate {
- my ($self, $field) = @_;
- ($field >= $self->value);
+ sub less_than {
+ my ($self, $other) = @_;
+ $self->compare($other) == -1;
}
- sub error_message { 'must be at least ' . (shift)->value; }
-
- package Constraint::NoMoreThan;
- use strict;
- use warnings;
- use Moose;
-
- with 'Constraint';
+ sub greater_than_or_equal_to {
+ my ($self, $other) = @_;
+ $self->greater_than($other) || $self->equal_to($other);
+ }
- sub validate {
- my ($self, $field) = @_;
- ($field <= $self->value);
- }
+ sub less_than_or_equal_to {
+ my ($self, $other) = @_;
+ $self->less_than($other) || $self->equal_to($other);
+ }
- sub error_message { 'must be no more than ' . (shift)->value; }
-
- package Constraint::LengthNoMoreThan;
+ package US::Currency;
use strict;
use warnings;
use Moose;
- extends 'Constraint::NoMoreThan';
- with 'Constraint::OnLength';
-
- package Constraint::LengthAtLeast;
- use strict;
- use warnings;
- use Moose;
+ with 'Ord';
- extends 'Constraint::AtLeast';
- with 'Constraint::OnLength';
+ has 'amount' => (is => 'rw', isa => 'Int', default => 0);
+
+ sub compare {
+ my ($self, $other) = @_;
+ $self->amount <=> $other->amount;
+ }
=head1 DESCRIPTION
}
else {
# otherwise assume it is a constraint
- my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa});
+ my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa});
# if the constraing it not found ....
unless (defined $constraint) {
# assume it is a foreign class, and make
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.03';
+our $VERSION = '0.04';
use Moose::Meta::TypeConstraint;
use Moose::Meta::TypeCoercion;
{
my %TYPES;
- sub find_type_constraint { $TYPES{$_[0]}->[1] }
-
+ sub find_type_constraint {
+ return $TYPES{$_[0]}->[1]
+ if exists $TYPES{$_[0]};
+ return;
+ }
+
+ sub _dump_type_constraints {
+ require Data::Dumper;
+ Data::Dumper::Dumper \%TYPES;
+ }
+
sub _create_type_constraint {
my ($name, $parent, $check, $message) = @_;
my $pkg_defined_in = scalar(caller(1));
($TYPES{$name}->[0] eq $pkg_defined_in)
- || confess "The type constraint '$name' has already been created"
+ || confess "The type constraint '$name' has already been created "
if defined $name && exists $TYPES{$name};
$parent = find_type_constraint($parent) if defined $parent;
my $constraint = Moose::Meta::TypeConstraint->new(
use strict;
use warnings;
-use Test::More tests => 21;
+use Test::More tests => 52;
use Test::Exception;
BEGIN {
## Roles
{
- package Constraint;
+ package Eq;
use strict;
use warnings;
use Moose::Role;
-
- has 'value' => (isa => 'Int', is => 'ro');
-
- around 'validate' => sub {
- my $c = shift;
- my ($self, $field) = @_;
- return undef if $c->($self, $self->validation_value($field));
- return $self->error_message;
- };
- sub validation_value {
- my ($self, $field) = @_;
- return $field;
- }
+ requires 'equal_to';
- sub error_message { confess "Abstract method!" }
+ sub not_equal_to {
+ my ($self, $other) = @_;
+ !$self->equal_to($other);
+ }
- package Constraint::OnLength;
+ package Ord;
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;
- };
-
+
+ with 'Eq';
+
+ requires 'compare';
+
+ sub equal_to {
+ my ($self, $other) = @_;
+ $self->compare($other) == 0;
+ }
+
+ sub greater_than {
+ my ($self, $other) = @_;
+ $self->compare($other) == 1;
+ }
+
+ sub less_than {
+ my ($self, $other) = @_;
+ $self->compare($other) == -1;
+ }
+
+ sub greater_than_or_equal_to {
+ my ($self, $other) = @_;
+ $self->greater_than($other) || $self->equal_to($other);
+ }
+
+ sub less_than_or_equal_to {
+ my ($self, $other) = @_;
+ $self->less_than($other) || $self->equal_to($other);
+ }
}
-## Classes
+## Classes
{
- package Constraint::AtLeast;
+ package US::Currency;
use strict;
use warnings;
use Moose;
+
+ with 'Ord';
+
+ has 'amount' => (is => 'rw', isa => 'Int', default => 0);
+
+ sub compare {
+ my ($self, $other) = @_;
+ $self->amount <=> $other->amount;
+ }
+}
- with 'Constraint';
+ok(US::Currency->does('Ord'), '... US::Currency does Ord');
+ok(US::Currency->does('Eq'), '... US::Currency does Eq');
- sub validate {
- my ($self, $field) = @_;
- ($field >= $self->value);
- }
+my $hundred = US::Currency->new(amount => 100.00);
+isa_ok($hundred, 'US::Currency');
- sub error_message { 'must be at least ' . (shift)->value; }
+can_ok($hundred, 'amount');
+is($hundred->amount, 100, '... got the right amount');
- package Constraint::NoMoreThan;
- use strict;
- use warnings;
- use Moose;
+ok($hundred->does('Ord'), '... US::Currency does Ord');
+ok($hundred->does('Eq'), '... US::Currency does Eq');
- with 'Constraint';
+my $fifty = US::Currency->new(amount => 50.00);
+isa_ok($fifty, 'US::Currency');
- sub validate {
- my ($self, $field) = @_;
- ($field <= $self->value);
- }
+can_ok($fifty, 'amount');
+is($fifty->amount, 50, '... got the right amount');
- sub error_message { 'must be no more than ' . (shift)->value; }
+ok($hundred->greater_than($fifty), '... 100 gt 50');
+ok($hundred->greater_than_or_equal_to($fifty), '... 100 ge 50');
+ok(!$hundred->less_than($fifty), '... !100 lt 50');
+ok(!$hundred->less_than_or_equal_to($fifty), '... !100 le 50');
+ok(!$hundred->equal_to($fifty), '... !100 eq 50');
+ok($hundred->not_equal_to($fifty), '... 100 ne 50');
- package Constraint::LengthNoMoreThan;
- use strict;
- use warnings;
- use Moose;
+ok(!$fifty->greater_than($hundred), '... !50 gt 100');
+ok(!$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100');
+ok($fifty->less_than($hundred), '... 50 lt 100');
+ok($fifty->less_than_or_equal_to($hundred), '... 50 le 100');
+ok(!$fifty->equal_to($hundred), '... !50 eq 100');
+ok($fifty->not_equal_to($hundred), '... 50 ne 100');
- extends 'Constraint::NoMoreThan';
- with 'Constraint::OnLength';
-
- package Constraint::LengthAtLeast;
- use strict;
- use warnings;
- use Moose;
-
- extends 'Constraint::AtLeast';
- with 'Constraint::OnLength';
-}
+ok(!$fifty->greater_than($fifty), '... !50 gt 50');
+ok($fifty->greater_than_or_equal_to($fifty), '... !50 ge 50');
+ok(!$fifty->less_than($fifty), '... 50 lt 50');
+ok($fifty->less_than_or_equal_to($fifty), '... 50 le 50');
+ok($fifty->equal_to($fifty), '... 50 eq 50');
+ok(!$fifty->not_equal_to($fifty), '... !50 ne 50');
-my $no_more_than_10 = Constraint::NoMoreThan->new(value => 10);
-isa_ok($no_more_than_10, 'Constraint::NoMoreThan');
+## ... check some meta-stuff
-ok($no_more_than_10->does('Constraint'), '... Constraint::NoMoreThan does Constraint');
+# Eq
-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 $eq_meta = Eq->meta;
+isa_ok($eq_meta, 'Moose::Meta::Role');
-my $at_least_10 = Constraint::AtLeast->new(value => 10);
-isa_ok($at_least_10, 'Constraint::AtLeast');
+ok($eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to');
+ok($eq_meta->requires_method('equal_to'), '... Eq requires_method not_equal_to');
-ok($at_least_10->does('Constraint'), '... Constraint::AtLeast does Constraint');
+# Ord
-ok(!defined($at_least_10->validate(11)), '... validated correctly');
-is($at_least_10->validate(1), 'must be at least 10', '... validation failed correctly');
+my $ord_meta = Ord->meta;
+isa_ok($ord_meta, 'Moose::Meta::Role');
-# onlength
+ok($ord_meta->does_role('Eq'), '... Ord does Eq');
-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');
+foreach my $method_name (qw(
+ equal_to not_equal_to
+ greater_than greater_than_or_equal_to
+ less_than less_than_or_equal_to
+ )) {
+ ok($ord_meta->has_method($method_name), '... Ord has_method ' . $method_name);
+}
-ok($no_more_than_10_chars->does('Constraint'), '... Constraint::LengthNoMoreThan does Constraint');
-ok($no_more_than_10_chars->does('Constraint::OnLength'), '... Constraint::LengthNoMoreThan does Constraint::OnLength');
+ok($ord_meta->requires_method('compare'), '... Ord requires_method compare');
-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');
+# US::Currency
-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');
+my $currency_meta = US::Currency->meta;
+isa_ok($currency_meta, 'Moose::Meta::Class');
-ok($at_least_10_chars->does('Constraint'), '... Constraint::LengthAtLeast does Constraint');
-ok($at_least_10_chars->does('Constraint::OnLength'), '... Constraint::LengthAtLeast does Constraint::OnLength');
+ok($currency_meta->does_role('Ord'), '... US::Currency does Ord');
+ok($currency_meta->does_role('Eq'), '... US::Currency does Eq');
-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');
+foreach my $method_name (qw(
+ amount
+ equal_to not_equal_to
+ compare
+ greater_than greater_than_or_equal_to
+ less_than less_than_or_equal_to
+ )) {
+ ok($currency_meta->has_method($method_name), '... US::Currency has_method ' . $method_name);
+}
use strict;
use warnings;
-use Test::More tests => 52;
+use Test::More tests => 21;
use Test::Exception;
BEGIN {
## Roles
{
- package Eq;
+ package Constraint;
use strict;
use warnings;
use Moose::Role;
+
+ has 'value' => (isa => 'Int', is => 'ro');
+
+ around 'validate' => sub {
+ my $c = shift;
+ my ($self, $field) = @_;
+ return undef if $c->($self, $self->validation_value($field));
+ return $self->error_message;
+ };
- requires 'equal_to';
-
- sub not_equal_to {
- my ($self, $other) = @_;
- !$self->equal_to($other);
+ sub validation_value {
+ my ($self, $field) = @_;
+ return $field;
}
- package Ord;
+ sub error_message { confess "Abstract method!" }
+
+ package Constraint::OnLength;
use strict;
use warnings;
use Moose::Role;
-
- with 'Eq';
-
- requires 'compare';
-
- sub equal_to {
- my ($self, $other) = @_;
- $self->compare($other) == 0;
- }
-
- sub greater_than {
- my ($self, $other) = @_;
- $self->compare($other) == 1;
- }
-
- sub less_than {
- my ($self, $other) = @_;
- $self->compare($other) == -1;
- }
-
- sub greater_than_or_equal_to {
- my ($self, $other) = @_;
- $self->greater_than($other) || $self->equal_to($other);
- }
-
- sub less_than_or_equal_to {
- my ($self, $other) = @_;
- $self->less_than($other) || $self->equal_to($other);
- }
+
+ 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
+## Classes
{
- package US::Currency;
+ package Constraint::AtLeast;
use strict;
use warnings;
use Moose;
-
- with 'Ord';
-
- has 'amount' => (is => 'rw', isa => 'Int', default => 0);
-
- sub compare {
- my ($self, $other) = @_;
- $self->amount <=> $other->amount;
- }
-}
-ok(US::Currency->does('Ord'), '... US::Currency does Ord');
-ok(US::Currency->does('Eq'), '... US::Currency does Eq');
+ with 'Constraint';
-my $hundred = US::Currency->new(amount => 100.00);
-isa_ok($hundred, 'US::Currency');
+ sub validate {
+ my ($self, $field) = @_;
+ ($field >= $self->value);
+ }
-can_ok($hundred, 'amount');
-is($hundred->amount, 100, '... got the right amount');
+ sub error_message { 'must be at least ' . (shift)->value; }
-ok($hundred->does('Ord'), '... US::Currency does Ord');
-ok($hundred->does('Eq'), '... US::Currency does Eq');
+ package Constraint::NoMoreThan;
+ use strict;
+ use warnings;
+ use Moose;
+
+ with 'Constraint';
-my $fifty = US::Currency->new(amount => 50.00);
-isa_ok($fifty, 'US::Currency');
+ sub validate {
+ my ($self, $field) = @_;
+ ($field <= $self->value);
+ }
-can_ok($fifty, 'amount');
-is($fifty->amount, 50, '... got the right amount');
+ sub error_message { 'must be no more than ' . (shift)->value; }
-ok($hundred->greater_than($fifty), '... 100 gt 50');
-ok($hundred->greater_than_or_equal_to($fifty), '... 100 ge 50');
-ok(!$hundred->less_than($fifty), '... !100 lt 50');
-ok(!$hundred->less_than_or_equal_to($fifty), '... !100 le 50');
-ok(!$hundred->equal_to($fifty), '... !100 eq 50');
-ok($hundred->not_equal_to($fifty), '... 100 ne 50');
+ package Constraint::LengthNoMoreThan;
+ use strict;
+ use warnings;
+ use Moose;
-ok(!$fifty->greater_than($hundred), '... !50 gt 100');
-ok(!$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100');
-ok($fifty->less_than($hundred), '... 50 lt 100');
-ok($fifty->less_than_or_equal_to($hundred), '... 50 le 100');
-ok(!$fifty->equal_to($hundred), '... !50 eq 100');
-ok($fifty->not_equal_to($hundred), '... 50 ne 100');
+ extends 'Constraint::NoMoreThan';
+ with 'Constraint::OnLength';
+
+ package Constraint::LengthAtLeast;
+ use strict;
+ use warnings;
+ use Moose;
+
+ extends 'Constraint::AtLeast';
+ with 'Constraint::OnLength';
+}
-ok(!$fifty->greater_than($fifty), '... !50 gt 50');
-ok($fifty->greater_than_or_equal_to($fifty), '... !50 ge 50');
-ok(!$fifty->less_than($fifty), '... 50 lt 50');
-ok($fifty->less_than_or_equal_to($fifty), '... 50 le 50');
-ok($fifty->equal_to($fifty), '... 50 eq 50');
-ok(!$fifty->not_equal_to($fifty), '... !50 ne 50');
+my $no_more_than_10 = Constraint::NoMoreThan->new(value => 10);
+isa_ok($no_more_than_10, 'Constraint::NoMoreThan');
-## ... check some meta-stuff
+ok($no_more_than_10->does('Constraint'), '... Constraint::NoMoreThan does Constraint');
-# Eq
+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 $eq_meta = Eq->meta;
-isa_ok($eq_meta, 'Moose::Meta::Role');
+my $at_least_10 = Constraint::AtLeast->new(value => 10);
+isa_ok($at_least_10, 'Constraint::AtLeast');
-ok($eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to');
-ok($eq_meta->requires_method('equal_to'), '... Eq requires_method not_equal_to');
+ok($at_least_10->does('Constraint'), '... Constraint::AtLeast does Constraint');
-# Ord
+ok(!defined($at_least_10->validate(11)), '... validated correctly');
+is($at_least_10->validate(1), 'must be at least 10', '... validation failed correctly');
-my $ord_meta = Ord->meta;
-isa_ok($ord_meta, 'Moose::Meta::Role');
+# onlength
-ok($ord_meta->does_role('Eq'), '... Ord does Eq');
+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');
-foreach my $method_name (qw(
- equal_to not_equal_to
- greater_than greater_than_or_equal_to
- less_than less_than_or_equal_to
- )) {
- ok($ord_meta->has_method($method_name), '... Ord has_method ' . $method_name);
-}
+ok($no_more_than_10_chars->does('Constraint'), '... Constraint::LengthNoMoreThan does Constraint');
+ok($no_more_than_10_chars->does('Constraint::OnLength'), '... Constraint::LengthNoMoreThan does Constraint::OnLength');
-ok($ord_meta->requires_method('compare'), '... Ord requires_method compare');
+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');
-# US::Currency
+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');
-my $currency_meta = US::Currency->meta;
-isa_ok($currency_meta, 'Moose::Meta::Class');
+ok($at_least_10_chars->does('Constraint'), '... Constraint::LengthAtLeast does Constraint');
+ok($at_least_10_chars->does('Constraint::OnLength'), '... Constraint::LengthAtLeast does Constraint::OnLength');
-ok($currency_meta->does_role('Ord'), '... US::Currency does Ord');
-ok($currency_meta->does_role('Eq'), '... US::Currency does Eq');
+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');
-foreach my $method_name (qw(
- amount
- equal_to not_equal_to
- compare
- greater_than greater_than_or_equal_to
- less_than less_than_or_equal_to
- )) {
- ok($currency_meta->has_method($method_name), '... US::Currency has_method ' . $method_name);
-}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib 't/lib', 'lib';
+
+use Test::More tests => 3;
+
+BEGIN {
+ use_ok('Moose');
+}
+
+use_ok('MyMooseA');
+use_ok('MyMooseB');
\ No newline at end of file
--- /dev/null
+package MyMooseA;
+
+use strict;
+use warnings;
+use Moose;
+
+has 'b' => (is => 'rw', isa => 'MyMooseB');
+
+1;
\ No newline at end of file
--- /dev/null
+package MyMooseB;
+
+use strict;
+use warnings;
+use Moose;
+
+1;
\ No newline at end of file
projects / gitmo/Moose.git / commitdiff