MooseX::Meta::TypeConstraint::Intersection - An intersection of Moose type constraints

MooseX-Meta-TypeConstraint-Intersection documentation Contained in the MooseX-Meta-TypeConstraint-Intersection distribution.

Index

Code Index:

NAME

Top

MooseX::Meta::TypeConstraint::Intersection - An intersection of Moose type constraints

VERSION

Top

version 0.03

DESCRIPTION

Top

This class represents an intersection of type constraints. An intersection takes multiple type constraints, and is true if all of its member constraints are true.

INHERITANCE

Top

MooseX::Meta::TypeConstraint::Intersection is a subclass of Moose::Meta::TypeConstraint.

ATTRIBUTES

Top

type_constraints

The member type constraints of this intersection.

METHODS

Top

new(%options)

This creates a new intersection type constraint based on the given %options.

It takes the same options as its parent. It also requires an additional option, type_constraints. This is an array reference containing the Moose::Meta::TypeConstraint objects that are the members of the intersection type. The name option defaults to the names of all of these member types sorted and then joined by an ampersand (&).

check($value)

Checks a $value against the intersection constraint. If all member constraints accept the value, the value is valid and something true is returned.

equals($other_constraint)

A type is considered equal if it is also an intersection type, and the two intersections have the same member types.

parents

This returns the same constraint as the type_constraints method.

validate($value)

Like check, but returns an error message including all of the error messages returned by the member constraints, or undef.

validate_all($value)

Same as validate, but returns an array reference of tuples with error messages and the type constraints that produced them from the individual validation errors instead of a plain string with the errors concatenated.

is_subtype_of($other_constraint)

This returns true if the $other_constraint is also an intersection constraint and contains at least all of the member constraints of the intersection this method is called on.

THANKS

Top

Ionzero LLC (http://ionzero.com) for sponsoring the initial development.

AUTHOR

Top

Florian Ragwitz <rafl@debian.org>

COPYRIGHT AND LICENSE

Top

This software is copyright (c) 2010 by Florian Ragwitz.

This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.

MooseX-Meta-TypeConstraint-Intersection documentation Contained in the MooseX-Meta-TypeConstraint-Intersection distribution. 
package MooseX::Meta::TypeConstraint::Intersection;
our $VERSION = '0.03';
# ABSTRACT: An intersection of Moose type constraints

use Moose;
use MooseX::Types::Moose qw/ArrayRef/;
use Moose::Util::TypeConstraints 'find_type_constraint';
use aliased 'Moose::Meta::TypeConstraint';
use namespace::autoclean -also => 'TypeConstraint';


extends TypeConstraint;


has type_constraints => (
    is      => 'ro',
    isa     => ArrayRef[TypeConstraint],
    default => sub { [] },
);


around new => sub {
    my ($next, $class, %args) = @_;
    my $name = join '&' => sort { $a cmp $b }
        map { $_->name } @{ $args{type_constraints} };
    return $class->$next(name => $name, %args);
};


sub _actually_compile_type_constraint {
    my ($self) = @_;
    my @type_constraints = @{ $self->type_constraints };
    return sub {
        my ($value) = @_;

        for my $type (@type_constraints) {
            return unless $type->check($value);
        }

        return 1;
    };
}


# this is stolen from TC::Union. meh
sub equals {
    my ($self, $type_or_name) = @_;
    my $other = find_type_constraint($type_or_name);

    return unless $other->isa(__PACKAGE__);

    my @self_constraints  = @{ $self->type_constraints  };
    my @other_constraints = @{ $other->type_constraints };

    return unless @self_constraints == @other_constraints;

  CONSTRAINT: for my $constraint (@self_constraints) {
        for (my $i = 0; $i < @other_constraints; $i++) {
            if ($constraint->equals($other_constraints[$i])) {
                splice @other_constraints, $i, 1;
                next CONSTRAINT;
            }
        }
    }

    return @other_constraints == 0;
}


# this too, although i'm not too sure what the point of it is
sub parents {
    my ($self) = @_;
    return $self->type_constraints;
}


sub validate {
    my ($self, $value) = @_;
    my $msgs = $self->validate_all($value);
    return undef unless defined $msgs;
    return join(q{ and } => map { $_->[0] } @{ $msgs }) . ' in ' . $self->name;
}


sub validate_all {
    my ($self, $value) = @_;

    my @msgs = map {
        my $err = $_->validate($value);
        defined $err ? [ $err, $_ ] : ();
    } @{ $self->type_constraints };

    return @msgs ? \@msgs : undef;
}


sub is_subtype_of {
    my ($self, $type_or_name) = @_;
    my $other = find_type_constraint($type_or_name);

    return unless $other->isa(__PACKAGE__);

    my @self_constraints  = @{ $self->type_constraints  };
    my @other_constraints = @{ $other->type_constraints };

    return if @self_constraints < @other_constraints;

  CONSTRAINT: for my $tc (@other_constraints) {
        for (my $i = 0; $i < @self_constraints; $i++) {
            if ($tc->is_subtype_of($self_constraints[$i])) {
                splice @self_constraints, $i, 1;
                next CONSTRAINT;
            }
        }
    }

    return @self_constraints == 0;
}


1;

__END__