341 lines
8.7 KiB
Perl
341 lines
8.7 KiB
Perl
package utils::support::moo_validations;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
use Scalar::Util qw(blessed);
|
|
use Scalar::Util::Numeric qw(:all);
|
|
use Switch;
|
|
|
|
require Exporter;
|
|
our @ISA = qw(Exporter);
|
|
our @EXPORT = qw(validates is_valid errors);
|
|
our @EXPORT_OK = qw(register_validator);
|
|
|
|
my %VALIDATORS = (
|
|
presence => \&_presense_validator,
|
|
numericality => \&_numericality_validator,
|
|
length => \&_length_validator,
|
|
#with => \&_with_validator;
|
|
);
|
|
|
|
my %THINGS = ();
|
|
|
|
sub validates {
|
|
my ($fields, %args) = @_;
|
|
my $caller = caller;
|
|
|
|
my $thing = $THINGS{$caller};
|
|
|
|
$fields = [$fields] if ref($fields) ne 'ARRAY';
|
|
|
|
my $all_on = delete $args{on};
|
|
my $all_message = delete $args{message};
|
|
my $all_allow_blank = delete $args{allow_blank};
|
|
|
|
foreach my $field (@$fields) {
|
|
|
|
my $field_validators = $thing->{fields}->{$field} //= [];
|
|
|
|
while (my ($validator, $options) = each %args) {
|
|
|
|
if (not exists $VALIDATORS{$validator}) {
|
|
croak "There is no validator registered with name $validator";
|
|
}
|
|
|
|
if (not ref($options) eq 'HASH') {
|
|
my $option = $options;
|
|
$options = {};
|
|
if (ref($option) eq 'ARRAY') {
|
|
$options->{in} = $option;
|
|
} else {
|
|
$options->{with} = $option;
|
|
}
|
|
}
|
|
|
|
my $on = delete $options->{on} || $all_on || 'all';
|
|
my $message = delete $options->{message} || $all_message;
|
|
my $allow_blank = delete $options->{allow_blank} || $all_allow_blank;
|
|
|
|
my $validation_options = {
|
|
on => $on,
|
|
message => $message,
|
|
allow_blank => $allow_blank
|
|
};
|
|
|
|
push @$field_validators, {
|
|
validator => $VALIDATORS{$validator},
|
|
args => $options,
|
|
options => $validation_options
|
|
};
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
sub is_valid {
|
|
my ($self, @args) = @_;
|
|
my $class = blessed $self;
|
|
|
|
if (@args % 2 != 0) {
|
|
my ($field, %args) = @args;
|
|
return _validate_field($self, $field, %args);
|
|
}
|
|
|
|
my $thing = $THINGS{$class};
|
|
|
|
my $valid = 1;
|
|
$self->{_validation_errors} = {};
|
|
|
|
foreach my $field (keys %{$thing->{fields}}) {
|
|
my $field_valid = _validate_field($self, $field, @args);
|
|
$valid &&= $field_valid;
|
|
}
|
|
|
|
return $valid;
|
|
}
|
|
|
|
sub _validate_field {
|
|
my ($self, $field, %args) = @_;
|
|
my $class = blessed $self;
|
|
|
|
my $thing = $THINGS{$class};
|
|
my $field_valid = 1;
|
|
my $for = $args{for} || 'all';
|
|
|
|
my $field_validators = $thing->{fields}->{$field} // [];
|
|
|
|
foreach my $validation (@$field_validators) {
|
|
|
|
my $validator = $validation->{validator};
|
|
my $validator_args = $validation->{args};
|
|
my $options = $validation->{options};
|
|
|
|
my $on = $options->{on};
|
|
my $message = $options->{message};
|
|
my $allow_blank = $options->{allow_blank};
|
|
|
|
my $validator_messages = [];
|
|
|
|
next unless ($on eq 'all' || $on eq $for);
|
|
|
|
my $field_value = $self->$field;
|
|
|
|
next if ($allow_blank && (not defined $field_value || $field_value eq ""));
|
|
|
|
my $valid = $validator->(
|
|
$self->$field,
|
|
%$validator_args,
|
|
messages => $validator_messages
|
|
);
|
|
|
|
if (not $valid) {
|
|
$self->errors($field => $message || $validator_messages);
|
|
$field_valid = 0;
|
|
}
|
|
}
|
|
|
|
return $field_valid;
|
|
}
|
|
|
|
sub errors {
|
|
my ($self, %args) = @_;
|
|
my $class = blessed $self;
|
|
|
|
$self->{_validation_errors} //= {};
|
|
|
|
if (keys %args == 0) {
|
|
return $self->{_validation_errors};
|
|
}
|
|
|
|
while (my ($field, $error_messages) = each %args) {
|
|
my $field_errors = $self->{_validation_errors}->{$field} //= [];
|
|
$error_messages = [$error_messages] if ref($error_messages) ne 'ARRAY';
|
|
push @$field_errors, @$error_messages;
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
sub register_validator {
|
|
my ($name, $sub) = @_;
|
|
|
|
if (not ref($sub) eq 'CODE') {
|
|
croak 'Validator subroutine must be a CODE ref';
|
|
}
|
|
|
|
if (exists $VALIDATORS{$name}) {
|
|
carp "A Validator subroutine with name $name already exists";
|
|
}
|
|
|
|
$VALIDATORS{$name} = $sub;
|
|
|
|
return;
|
|
}
|
|
|
|
sub _presense_validator {
|
|
my ($value, %config) = @_;
|
|
|
|
my $required = $config{with} || $config{is} || 1;
|
|
my $present = defined $value && $value ne "";
|
|
my $pass = $required == $present;
|
|
|
|
if (not $pass) {
|
|
push @{$config{messages}}, " must be present.";
|
|
}
|
|
|
|
return $pass;
|
|
}
|
|
|
|
sub _numericality_validator {
|
|
my ($value, %config) = @_;
|
|
|
|
my $messages = delete $config{messages};
|
|
my $only_integer = !! delete $config{only_integer};
|
|
|
|
if ($only_integer) {
|
|
unless (isint($value)) {
|
|
push @$messages, " is not an integer";
|
|
return 0;
|
|
}
|
|
} else {
|
|
my $numericality = !! delete $config{with} || 1;
|
|
unless (isnum($value) == $numericality) {
|
|
push @$messages, $numericality ? " is not a number" : " is a number";
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
my %numericality_options = %config;
|
|
my $pass = 1;
|
|
|
|
while (my ($option, $option_value) = each %numericality_options) {
|
|
|
|
unless ($option eq 'odd' || $option eq 'even') {
|
|
croak "$option must be a number" if (not isnum($option_value));
|
|
}
|
|
|
|
switch ($option) {
|
|
case 'greater_than' {
|
|
unless ($value > $option_value) {
|
|
push @$messages, " is not greater than $option_value";
|
|
$pass = 0;
|
|
}
|
|
}
|
|
case 'greater_than_or_equal_to' {
|
|
unless ($value >= $option_value) {
|
|
push @$messages, " is not greater than or equal to $option_value";
|
|
$pass = 0;
|
|
}
|
|
}
|
|
case 'equal_to' {
|
|
unless ($value == $option_value) {
|
|
push @$messages, " is not equal to $option_value";
|
|
$pass = 0;
|
|
}
|
|
}
|
|
case 'less_than' {
|
|
unless ($value < $option_value) {
|
|
push @$messages, " is not less than $option_value";
|
|
$pass = 0;
|
|
}
|
|
}
|
|
case 'less_than_or_equal_to' {
|
|
unless ($value <= $option_value) {
|
|
push @$messages, " is not less than or equal to $option_value";
|
|
$pass = 0;
|
|
}
|
|
}
|
|
case 'odd' {
|
|
unless ($value % 2 == 1) {
|
|
push @$messages, " is not a odd number";
|
|
$pass = 0;
|
|
}
|
|
}
|
|
case 'even' {
|
|
unless ($value % 2 == 0) {
|
|
push @$messages, " is not a even number";
|
|
$pass = 0;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
return $pass;
|
|
}
|
|
|
|
sub _length_validator {
|
|
my ($value, %config) = @_;
|
|
|
|
my $messages = delete $config{messages};
|
|
|
|
my ($option) = keys %config;
|
|
my $option_value = $config{$option};
|
|
my $value_length = length $value;
|
|
my $pass = 1;
|
|
|
|
switch ($option) {
|
|
case ['within', 'in'] {
|
|
my ($min, $max) = @$option_value;
|
|
if ($value_length < $min || $value_length > $max) {
|
|
push @$messages, " is the wrong length (should be between $min and $max characters)";
|
|
$pass = 0;
|
|
}
|
|
}
|
|
case 'is' {
|
|
if ($value_length != $option_value) {
|
|
push @$messages, " is the wrong length (should be $option_value characters)";
|
|
$pass = 0;
|
|
}
|
|
}
|
|
case 'minimum' {
|
|
if ($value_length < $option_value) {
|
|
push @$messages, " is too short (minimum is $option_value characters)";
|
|
$pass = 0;
|
|
}
|
|
}
|
|
case 'maxmimum' {
|
|
if ($value_length > $option_value) {
|
|
push @$messages, " is too long (maximum is $option_value characters)";
|
|
$pass = 0;
|
|
}
|
|
}
|
|
}
|
|
|
|
return $pass;
|
|
}
|
|
|
|
sub import {
|
|
my $class = shift;
|
|
my $caller = caller;
|
|
|
|
my $thing = $THINGS{$caller} = {
|
|
fields => {}
|
|
};
|
|
|
|
no strict 'refs';
|
|
no warnings 'redefine';
|
|
|
|
my $import = $caller->can('import');
|
|
|
|
*{"$caller\::import"} = sub {
|
|
# Attempt to check at compile time
|
|
# if validate fields exists on object
|
|
foreach my $field (keys %{$thing->{fields}}) {
|
|
if (not $caller->can($field)) {
|
|
croak "Field: $field is not available on $caller";
|
|
}
|
|
}
|
|
|
|
if ($import) {
|
|
$import->(@_);
|
|
}
|
|
};
|
|
|
|
__PACKAGE__->export_to_level(1, @_);
|
|
}
|
|
|
|
1;
|