=head1 NAME
-MooseX::Meta::TypeConstraint::Parameterizable - Metaclass for Parameterizable type constraints.
+MooseX::Meta::TypeConstraint::Parameterizable - Parameterizable Meta Class.
=head1 DESCRIPTION
-see L<MooseX::Parameterizable::Types> for how to use parameterizable
+See L<MooseX::Types::Parameterizable> for how to use parameterizable
types. This class is a subclass of L<Moose::Meta::TypeConstraint> which
provides the gut functionality to enable parameterizable type constraints.
-This class is not intended for public consumption. Please don't subclass it
-or rely on it. Chances are high stuff here is going to change a lot. For
-example, I will probably refactor this into several classes to get rid of all
-the ugly conditionals.
+You probably won't need to subclass or consume this class directly.
=head1 ATTRIBUTES
has 'parent_type_constraint' => (
is=>'ro',
- isa=>'Object',
+ isa=>Moose::Util::TypeConstraints::class_type('Moose::Meta::TypeConstraint'),
default=> sub {
Moose::Util::TypeConstraints::find_type_constraint("Any");
},
has 'constraining_value_type_constraint' => (
is=>'ro',
- isa=>'Object',
+ isa=>Moose::Util::TypeConstraints::class_type('Moose::Meta::TypeConstraint'),
default=> sub {
Moose::Util::TypeConstraints::find_type_constraint("Any");
},
=cut
+## TODO, this is where we probably should break out Parameterized stuff from
+## parameterizable...
+
has 'constraining_value' => (
is=>'ro',
predicate=>'has_constraining_value',
=head2 new
-Do some post build stuff
+Do some post build stuff, mostly make sure we set the correct coercion object.
=cut
-
-## Right now I add in the parameterizable type coercion until I can merge some Moose
-## changes upstream.
around 'new' => sub {
my ($new, $class, @args) = @_;
if(my $exists = Moose::Util::TypeConstraints::find_type_constraint($name)) {
return $exists;
} else {
- my $type_constraint = $class->new(
+ return $class->new(
name => $name,
parent => $self,
constraint => $self->constraint,
constraining_value => $args,
parent_type_constraint=>$self->parent_type_constraint,
constraining_value_type_constraint => $self->constraining_value_type_constraint,
- message => $self->message,
+ ($self->has_message ? (message => sub { $self->message->( @_, $args ) } ) : ()),
);
-
- ## TODO This is probably going to have to go away (too many things added to the registry)
- ##Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint($type_constraint);
- return $type_constraint;
}
}
}
around 'coerce' => sub {
my ($coerce, $self, @args) = @_;
-
if($self->has_constraining_value) {
push @args, $self->constraining_value;
- if(@{$self->coercion->type_coercion_map}) {
- my $coercion = $self->coercion;
- my $coerced = $self->$coerce(@args);
- if(defined $coerced) {
- return $coerced;
- } else {
- my $parent = $self->parent;
- return $parent->coerce(@args);
- }
+ }
+ if(@{$self->coercion->type_coercion_map}) {
+ my $coercion = $self->coercion;
+ my $coerced = $coercion->coerce(@args);
+ if(defined $coerced) {
+ return $coerced;
} else {
my $parent = $self->parent;
return $parent->coerce(@args);
- }
- }
- else {
- return $self->$coerce(@args);
- }
- return;
-};
-
-=head2 get_message
-
-Give you a better peek into what's causing the error.
-
-around 'get_message' => sub {
- my ($get_message, $self, $value) = @_;
- return $self->$get_message($value);
+ }
+ } else {
+ my $parent = $self->parent;
+ return $parent->coerce(@args);
+ }
};
=head1 SEE ALSO