package ## Hide from PAUSE
- MooseX::Meta::TypeConstraint::Dependent;
+ MooseX::Dependent::Meta::TypeConstraint::Dependent;
use Moose;
use Moose::Util::TypeConstraints ();
-use MooseX::Meta::TypeCoercion::Dependent;
-use Devel::PartialDump;
extends 'Moose::Meta::TypeConstraint';
=head1 NAME
-MooseX::Meta::TypeConstraint::Dependent - Metaclass for Dependent type constraints.
+MooseX::Dependent::Meta::TypeConstraint::Dependent - Metaclass for Dependent type constraints.
=head1 DESCRIPTION
-see L<MooseX::Types::Dependent> for examples and details of how to use dependent
+see L<MooseX::Dependent> for examples and details of how to use dependent
types. This class is a subclass of L<Moose::Meta::TypeConstraint> which
provides the gut functionality to enable dependent type constraints.
This class defines the following attributes.
-=head2 dependent_type_constraint
+=head2 parent_type_constraint
-The type constraint whose validity is being made dependent on a value that is a
-L</constraining_type_constraint>
+The type constraint whose validity is being made dependent.
=cut
-has 'dependent_type_constraint' => (
+has 'parent_type_constraint' => (
is=>'ro',
isa=>'Object',
- predicate=>'has_dependent_type_constraint',
- handles=>{
- check_dependent=>'check',
- get_message_dependent=>'get_message',
+ predicate=>'has_parent_type_constraint',
+ default=> sub {
+ Moose::Util::TypeConstraints::find_type_constraint("Any");
},
+ required=>1,
);
-=head2 constraining_type_constraint
+=head2 constraining_value_type_constraint
This is a type constraint which defines what kind of value is allowed to be the
-constraining value of the depending type.
+constraining value of the dependent type.
=cut
-has 'constraining_type_constraint' => (
+has 'constraining_value_type_constraint' => (
is=>'ro',
isa=>'Object',
- predicate=>'has_constraining_type_constraint',
- handles=>{
- check_constraining=>'check',
- get_message_constraining=>'get_message',
+ predicate=>'has_constraining_value_type_constraint',
+ default=> sub {
+ Moose::Util::TypeConstraints::find_type_constraint("Any");
},
+ required=>1,
);
-=head2 comparison_callback
-
-This is a callback which returns a boolean value. It get's passed the value
-L</constraining_type_constraint> validates as well as the check value.
-
-This callback is executed in addition to anything you put into a 'where' clause.
-However, the 'where' clause only get's the check value.
+=head2 constrainting_value
-Exercise some sanity, this should be limited to actual comparision operations,
-not as a sneaky way to mess with the constraining value.
-
-This should return a Bool, suitable for ->check (That is true for valid, false
-for fail).
+This is the actual value that constraints the L</parent_type_constraint>
=cut
-has 'comparison_callback' => (
- is=>'ro',
- isa=>'CodeRef',
- predicate=>'has_comparison_callback',
+has 'constraining_value' => (
+ reader=>'constraining_value',
+ writer=>'_set_constraining_value',
+ predicate=>'has_constraining_value',
);
=head2 constraint_generator
A subref or closure that contains the way we validate incoming values against
a set of type constraints.
-=cut
has 'constraint_generator' => (
is=>'ro',
This class defines the following methods.
-=head2 new
-
-Initialization stuff.
-
-=cut
-
-around 'new' => sub {
- my ($new, $class, @args) = @_;
- my $self = $class->$new(@args);
- $self->coercion(MooseX::Meta::TypeCoercion::Dependent->new(
- type_constraint => $self,
- ));
- return $self;
-};
-
=head2 validate
We intercept validate in order to custom process the message.
-=cut
-
override 'validate' => sub {
my ($self, @args) = @_;
my $compiled_type_constraint = $self->_compiled_type_constraint;
Given some type constraints, use them to generate validation rules for an ref
of values (to be passed at check time)
-=cut
sub generate_constraint_for {
my ($self, $callback) = @_;
sub parameterize {
my ($self, $dependent_tc, $callback, $constraining_tc) = @_;
+
+ die 'something';
+
my $class = ref $self;
my $name = $self->_generate_subtype_name($dependent_tc, $callback, $constraining_tc);
my $constraint_generator = $self->__infer_constraint_generator;
=cut
sub _generate_subtype_name {
- my ($self, $dependent_tc, $callback, $constraining_tc) = @_;
+ my ($self, $parent_tc, $constraining_tc) = @_;
return sprintf(
- "%s_depends_on_%s_via_%s",
- $dependent_tc, $constraining_tc, $callback,
+ "%s_depends_on_%s",
+ $parent_tc, $constraining_tc,
);
}
my $tc = shift @_;
my $merged_tc = [
@$tc,
- $self->comparison_callback,
- $self->constraining_type_constraint,
];
$self->constraint->($merged_tc, @_);
my ($create_child_type, $self, %opts) = @_;
return $self->$create_child_type(
%opts,
- constraint_generator => $self->__infer_constraint_generator,
+ #constraint_generator => $self->__infer_constraint_generator,
);
};
Override the base class behavior.
-=cut
-
sub equals {
my ( $self, $type_or_name ) = @_;
my $other = Moose::Util::TypeConstraints::find_type_constraint("$type_or_name");
Give you a better peek into what's causing the error.
-=cut
-
around 'get_message' => sub {
my ($get_message, $self, $value) = @_;
return $self->$get_message($value);
};
+=head2 _throw_error ($error)
+
+Given a string, delegate to the Moose exception object
+
+=cut
+
+sub _throw_error {
+ my $self = shift @_;
+ my $err = defined $_[0] ? $_[0] : 'Exception Thrown without Message';
+ require Moose; Moose->throw_error($err);
+}
+
=head1 SEE ALSO
The following modules or resources may be of interest.
package MooseX::Dependent::Types;
-use 5.008;
-
use Moose::Util::TypeConstraints;
-use MooseX::Dependent::Meta::TypeConstraint::Parameterizable;
+use MooseX::Dependent::Meta::TypeConstraint::Dependent;
use MooseX::Types -declare => [qw(Dependent)];
-our $VERSION = '0.01';
-our $AUTHORITY = 'cpan:JJNAPIORK';
-
=head1 NAME
MooseX::Dependent::Types - L<MooseX::Types> constraints that depend on values.
=cut
Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
- MooseX::Dependent::Meta::TypeConstraint::Parameterizable->new(
+ MooseX::Dependent::Meta::TypeConstraint::Dependent->new(
name => 'MooseX::Dependent::Types::Dependent',
- parent => find_type_constraint('ArrayRef'),
- constraint_generator=> sub {
- my ($dependent_val, $callback, $constraining_val) = @_;
- return $callback->($dependent_val, $constraining_val);
- },
+ parent => find_type_constraint('Any'),
)
);
=cut
1;
+
+__END__
+
+oose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
+ Moose::Meta::TypeConstraint::Parameterizable->new(
+ name => 'MooseX::Dependent::Types::Dependent',
+ parent => find_type_constraint('Any'),
+ constraint => sub { 0 },
+ constraint_generator=> sub {
+ my ($dependent_val, $callback, $constraining_val) = @_;
+ return $callback->($dependent_val, $constraining_val);
+ },
+ )
+);
+
+
+
+$REGISTRY->add_type_constraint(
+ Moose::Meta::TypeConstraint::Parameterizable->new(
+ name => 'HashRef',
+ package_defined_in => __PACKAGE__,
+ parent => find_type_constraint('Ref'),
+ constraint => sub { ref($_) eq 'HASH' },
+ optimized =>
+ \&Moose::Util::TypeConstraints::OptimizedConstraints::HashRef,
+ constraint_generator => sub {
+ my $type_parameter = shift;
+ my $check = $type_parameter->_compiled_type_constraint;
+ return sub {
+ foreach my $x ( values %$_ ) {
+ ( $check->($x) ) || return;
+ }
+ 1;
+ }
+ }
+ )
+);
\ No newline at end of file
+++ /dev/null
-
-use Test::More tests=>9; {
-
- use strict;
- use warnings;
-
- use_ok 'MooseX::Meta::TypeConstraint::Dependent';
- use_ok 'Moose::Util::TypeConstraints';
-
- ## A sample dependent type constraint the requires two ints and sees if
- ## the dependent value (the first) is greater than the constraining value
- ## (the second).
-
- ok my $int = find_type_constraint('Int') => 'Got Int';
-
- my $dep_tc = MooseX::Meta::TypeConstraint::Dependent->new(
- name => "MooseX::Types::Dependent::Depending" ,
- parent => find_type_constraint('ArrayRef'),
- dependent_type_constraint=>$int,
- comparison_callback=>sub {
- my ($dependent_val, $constraining_val) = @_;
- return ($dependent_val > $constraining_val) ? 1:undef;
- },
- constraining_type_constraint =>$int,
- constraint_generator=> sub {
- my ($dependent_val, $callback, $constraining_val) = @_;
- return $callback->($dependent_val, $constraining_val);
- },
- );
-
- isa_ok $dep_tc, 'MooseX::Meta::TypeConstraint::Dependent';
-
- ok !$dep_tc->check(['a',10]), "Fails, 'a' is not an Int.";
- ok !$dep_tc->check([5,'b']), "Fails, 'b' is not an Int either.";
- ok !$dep_tc->check({4,1}), "Fails, since this isn't an arrayref";
- ok !$dep_tc->check([5,10]), "Fails, 5 is less than 10";
- ok $dep_tc->check([11,6]), "Success, 11 is greater than 6.";
-}
projects / gitmo/MooseX-Dependent.git / commitdiff