use Moose;
use Moose::Util::TypeConstraints ();
+use MooseX::Dependent::Meta::TypeCoercion::Dependent;
use Scalar::Util qw(blessed);
use Data::Dump;
use Digest::MD5;
This class defines the following methods.
+=head2 BUILD
+
+Do some post build stuff
+
+=cut
+
+## Right now I add in the dependent type coercion until I can merge some Moose
+## changes upstream
+
+around 'new' => sub {
+ my ($new, $class, @args) = @_;
+ my $self = $class->$new(@args);
+ my $coercion = MooseX::Dependent::Meta::TypeCoercion::Dependent->new(type_constraint => $self);
+ $self->coercion($coercion);
+ return $self;
+};
+
=head2 parameterize (@args)
Given a ref of type constraints, create a structured type.
parent_type_constraint=>$self->parent_type_constraint,
constraining_value_type_constraint => $self->constraining_value_type_constraint,
);
- Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint($type_constraint);
+
+ ## 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;
}
}
}
};
+=head2 is_subtype_of
+
+Method modifier to make sure we match on subtype for both the dependent type
+as well as the type being made dependent
+
+=cut
+
around 'is_subtype_of' => sub {
my ( $is_subtype_of, $self, $type_or_name ) = @_;
};
-sub is_a_type_of {
- my ($self, @args) = @_;
- return ($self->equals(@args) ||
- $self->is_subtype_of(@args));
-}
+=head2 check
+
+As with 'is_subtype_of', we need to dual dispatch the method request
+
+=cut
around 'check' => sub {
my ($check, $self, @args) = @_;
);
};
+=head2 validate
+
+As with 'is_subtype_of', we need to dual dispatch the method request
+
+=cut
+
around 'validate' => sub {
my ($validate, $self, @args) = @_;
return (
);
};
+=head2 _compiled_type_constraint
+
+modify this method so that we pass along the constraining value to the constraint
+coderef and also throw the correct error message if the constraining value does
+not match it's requirement.
+
+=cut
+
around '_compiled_type_constraint' => sub {
my ($method, $self, @args) = @_;
my $coderef = $self->$method(@args);
};
};
+=head2 coerce
+
+More method modification to support dispatch coerce to a parent.
+
+=cut
+
around 'coerce' => sub {
my ($coerce, $self, @args) = @_;
- if($self->coercion) {
- if(my $value = $self->$coerce(@args)) {
- return $value;
+
+ 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);
+ }
+ } else {
+ my $parent = $self->parent;
+ return $parent->coerce(@args);
}
}
- return $self->parent->coerce(@args);
+ else {
+ return $self->$coerce(@args);
+ }
+ return;
};
=head2 get_message
=cut
-__PACKAGE__->meta->make_immutable(inline_constructor => 0);
+1;
+##__PACKAGE__->meta->make_immutable(inline_constructor => 0);