view release on metacpan or  search on metacpan

lib/Data/Validation/Constraints.pm  view on Meta::CPAN

package Data::Validation::Constraints;

use namespace::autoclean;
use charnames qw( :full );

use Data::Validation::Constants qw( EXCEPTION_CLASS FALSE HASH TRUE );
use Data::Validation::Utils     qw( ensure_class_loaded load_class throw );
use List::Util                  qw( any );
use Scalar::Util                qw( looks_like_number );
use Try::Tiny;
use Unexpected::Functions       qw( KnownType );
use Unexpected::Types           qw( Any ArrayRef Bool Int Object Str Undef );
use Moo;

# Public attributes
has 'allowed'        => is => 'ro',   iss => ArrayRef, builder => sub { [] };

has 'max_length'     => is => 'ro',   isa => Int;

has 'max_value'      => is => 'ro',   isa => Int;

has 'method'         => is => 'ro',   isa => Str, required => TRUE;

has 'min_length'     => is => 'ro',   isa => Int;

has 'min_value'      => is => 'ro',   isa => Int;

has 'pattern'        => is => 'ro',   isa => Str;

has 'required'       => is => 'ro',   isa => Bool, default => FALSE;

has 'type'           => is => 'ro',   isa => Str | Undef;

has 'type_libraries' => is => 'ro',   isa => ArrayRef[Str],
   builder           => sub { [ 'Unexpected::Types' ] };

has 'type_registry'  => is => 'lazy', isa => Object, builder => sub {
   my $self = shift; ensure_class_loaded 'Type::Registry';
   my $reg  = Type::Registry->for_me;

   $reg->add_types( $_ ) for (@{ $self->type_libraries });

   return $reg;
};

has 'value'          => is => 'ro',   isa => Any;

# Public methods
sub new_from_method {
   my ($class, $attr) = @_;

   $class->can( $attr->{method} ) and return $class->new( $attr );

   return (load_class $class, 'isValid', $attr->{method})->new( $attr );
}

sub validate {
   my ($self, $v) = @_; my $method = $self->method; return $self->$method( $v );
}

around 'validate' => sub {
   my ($orig, $self, $v) = @_;

   not defined $v and $self->required and return FALSE;

   not defined $v and not $self->required and $self->method ne 'isMandatory'
      and return TRUE;

   return $orig->( $self, $v );
};

# Builtin factory validation methods
sub isAllowed {
   my ($self, $v) = @_;

   return (any { $_ eq $v } @{ $self->allowed }) ? TRUE : FALSE;
}

sub isBetweenValues {
   my ($self, $v) = @_;

   defined $self->min_value and $v < $self->min_value and return FALSE;
   defined $self->max_value and $v > $self->max_value and return FALSE;
   return TRUE;
}

sub isEqualTo {
   my ($self, $v) = @_;

   $self->isValidNumber( $v ) and $self->isValidNumber( $self->value )
      and return $v == $self->value ? TRUE : FALSE;

   return $v eq $self->value ? TRUE : FALSE;
}