- has keyword now takes a 'metaclass' option
to support custom attribute meta-classes
on a per-attribute basis
- - Moose now enforces that your attribute
- metaclasses are always derived from
- Moose::Meta::Attribute
- added tests for this
* Moose::Role
- keywords are now exported with Sub::Exporter
* Moose::Utils::TypeConstraints
- - added Bool type and CollectionRef type
- then made ArrayRef and HashRef into subtypes
- of the CollectionRef
+ - added several more types and restructured
+ the hierarchy somewhat
+ - added tests for this
- keywords are now exported with Sub::Exporter
thanks chansen for this commit
* Moose::Meta::Attribute
- due to changes in Class::MOP, we had to add the
initialize_instance_slot method (it's a good thing)
+
+ * Moose::Meta::TypeConstraints
+ - added type constraint unions
+ - added tests for this
0.04 Sun. April 16th, 2006
* Moose::Role
$options{type_constraint} = $options{isa};
}
else {
- # otherwise assume it is a constraint
- 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
- # an anon constraint for it
- $constraint = Moose::Util::TypeConstraints::subtype(
- 'Object',
- Moose::Util::TypeConstraints::where { $_->isa($options{isa}) }
+
+ if ($options{isa} =~ /\|/) {
+ my @type_constraints = split /\s*\|\s*/ => $options{isa};
+ $options{type_constraint} = Moose::Util::TypeConstraints::create_type_constraint_union(
+ @type_constraints
);
- }
- $options{type_constraint} = $constraint;
+ }
+ else {
+ # otherwise assume it is a constraint
+ 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
+ # an anon constraint for it
+ $constraint = Moose::Util::TypeConstraints::subtype(
+ 'Object',
+ Moose::Util::TypeConstraints::where { $_->isa($options{isa}) }
+ );
+ }
+ $options{type_constraint} = $constraint;
+ }
}
}
elsif (exists $options{does}) {
if (exists $options{coerce} && $options{coerce}) {
(exists $options{type_constraint})
|| confess "You cannot have coercion without specifying a type constraint";
+ (!$options{type_constraint}->isa('Moose::Meta::TypeConstraint::Union'))
+ || confess "You cannot have coercion with a type constraint union";
confess "You cannot have a weak reference to a coerced value"
if $options{weak_ref};
}
}
if (defined $val) {
if ($self->has_type_constraint) {
- if ($self->should_coerce && $self->type_constraint->has_coercion) {
- $val = $self->type_constraint->coercion->coerce($val);
+ my $type_constraint = $self->type_constraint;
+ if ($self->should_coerce && $type_constraint->has_coercion) {
+ $val = $type_constraint->coercion->coerce($val);
}
- (defined($self->type_constraint->check($val)))
- || confess "Attribute (" . $self->name . ") does not pass the type contraint with '$val'";
+ (defined($type_constraint->check($val)))
+ || confess "Attribute (" .
+ $self->name .
+ ") does not pass the type contraint (" .
+ $type_constraint->name .
+ ") with '$val'";
}
}
$instance->{$self->name} = $val;
: '')
. ($self->has_type_constraint ?
('(defined $self->type_constraint->check(' . $value_name . '))'
- . '|| confess "Attribute ($attr_name) does not pass the type contraint with \'' . $value_name . '\'"'
+ . '|| confess "Attribute ($attr_name) does not pass the type contraint (" . $self->type_constraint->name . ") with \'' . $value_name . '\'"'
. 'if defined ' . $value_name . ';')
: '')
. '$_[0]->{$attr_name} = ' . $value_name . ';'
: '')
. ($self->has_type_constraint ?
('(defined $self->type_constraint->check(' . $value_name . '))'
- . '|| confess "Attribute ($attr_name) does not pass the type contraint with \'' . $value_name . '\'"'
+ . '|| confess "Attribute ($attr_name) does not pass the type contraint (" . $self->type_constraint->name . ") with \'' . $value_name . '\'"'
. 'if defined ' . $value_name . ';')
: '')
. '$_[0]->{$attr_name} = ' . $value_name . ';'
use warnings;
use metaclass;
-use Sub::Name 'subname';
-use Carp 'confess';
+use Sub::Name 'subname';
+use Carp 'confess';
+use Scalar::Util 'blessed';
our $VERSION = '0.03';
sub union {
my ($class, @type_constraints) = @_;
+ (scalar @type_constraints >= 2)
+ || confess "You must pass in at least 2 Moose::Meta::TypeConstraint instances to make a union";
+ (blessed($_) && $_->isa('Moose::Meta::TypeConstraint'))
+ || confess "You must pass in only Moose::Meta::TypeConstraint instances to make unions"
+ foreach @type_constraints;
return Moose::Meta::TypeConstraint::Union->new(
type_constraints => \@type_constraints
);
sub name { join ' | ' => map { $_->name } @{$_[0]->type_constraints} }
+# NOTE:
+# this should probably never be used
+# but we include it here for completeness
+sub constraint {
+ my $self = shift;
+ sub { $self->check($_[0]) };
+}
+
+# conform to the TypeConstraint API
+sub parent { undef }
+sub coercion { undef }
+sub has_coercion { 0 }
+sub message { undef }
+sub has_message { 0 }
+
sub check {
my $self = shift;
my $value = shift;
$type->coercion($type_coercion);
}
+ sub create_type_constraint_union {
+ my (@type_constraint_names) = @_;
+ return Moose::Meta::TypeConstraint->union(
+ map {
+ find_type_constraint($_)
+ } @type_constraint_names
+ );
+ }
+
sub export_type_contstraints_as_functions {
my $pkg = caller();
no strict 'refs';
This function can be used to locate a specific type constraint
meta-object. What you do with it from there is up to you :)
+=item B<create_type_constraint_union (@type_constraint_names)>
+
+Given a list of C<@type_constraint_names>, this will return a
+B<Moose::Meta::TypeConstraint::Union> instance.
+
=item B<export_type_contstraints_as_functions>
This will export all the current type constraints as functions
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 10;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Moose');
+}
+
+{
+ package Foo;
+ use strict;
+ use warnings;
+ use Moose;
+
+ has 'bar' => (is => 'rw', isa => 'ArrayRef | HashRef');
+}
+
+my $foo = Foo->new;
+isa_ok($foo, 'Foo');
+
+lives_ok {
+ $foo->bar([])
+} '... set bar successfully with an ARRAY ref';
+
+lives_ok {
+ $foo->bar({})
+} '... set bar successfully with a HASH ref';
+
+dies_ok {
+ $foo->bar(100)
+} '... couldnt set bar successfully with a number';
+
+dies_ok {
+ $foo->bar(sub {})
+} '... couldnt set bar successfully with a CODE ref';
+
+# check the constructor
+
+lives_ok {
+ Foo->new(bar => [])
+} '... created new Foo with bar successfully set with an ARRAY ref';
+
+lives_ok {
+ Foo->new(bar => {})
+} '... created new Foo with bar successfully set with a HASH ref';
+
+dies_ok {
+ Foo->new(bar => 50)
+} '... didnt create a new Foo with bar as a number';
+
+dies_ok {
+ Foo->new(bar => sub {})
+} '... didnt create a new Foo with bar as a number';
+
+
projects / gitmo/Moose.git / commitdiff