File Coverage

blib/lib/Validation/Class/Directive/Filters.pm

Criterion	Covered	Total	%
statement	73	73	100.0
branch	30	32	93.7
condition	13	18	72.2
subroutine	21	21	100.0
pod	0	17	0.0
total	137	161	85.0

# ABSTRACT: Filters Directive for Validation Class Field Definitions

package Validation::Class::Directive::Filters;

use strict;
use warnings;

use base 'Validation::Class::Directive';

use Validation::Class::Util;

our $VERSION = '7.900059'; # VERSION

our $_registry = {

    alpha        => \&filter_alpha,
    alphanumeric => \&filter_alphanumeric,
    autocase     => \&filter_autocase,
    capitalize   => \&filter_capitalize,
    currency     => \&filter_currency,
    decimal      => \&filter_decimal,
    lowercase    => \&filter_lowercase,
    numeric      => \&filter_numeric,
    strip        => \&filter_strip,
    titlecase    => \&filter_titlecase,
    trim         => \&filter_trim,
    uppercase    => \&filter_uppercase

};


sub registry {

    return $_registry;

}

sub filter_alpha {

    $_[0] =~ s/[^A-Za-z]//g;
    return $_[0];

}

sub filter_alphanumeric {

    $_[0] =~ s/[^A-Za-z0-9]//g;
    return $_[0];

}

sub filter_autocase {

    $_[0] =~ s/(^[a-z]|\b[a-z])/\u$1/g;
    return $_[0];

}

sub filter_capitalize {

    $_[0] = ucfirst $_[0];
    $_[0] =~ s/\.\s+([a-z])/\. \U$1/g;
    return $_[0];

}

sub filter_currency {

    my $n = $_[0] =~ /^(?:[^\d\-]+)?([\-])/ ? 1 : 0;
            $_[0] =~ s/[^0-9\.\,]+//g;
    return $n ? "-$_[0]" : "$_[0]";

}

sub filter_decimal {

    my $n = $_[0] =~ /^(?:[^\d\-]+)?([\-])/ ? 1 : 0;
            $_[0] =~ s/[^0-9\.]+//g;
    return $n ? "-$_[0]" : "$_[0]";

}

sub filter_lowercase {

    return lc $_[0];

}

sub filter_numeric {

    my $n = $_[0] =~ /^(?:[^\d\-]+)?([\-])/ ? 1 : 0;
            $_[0] =~ s/[^0-9]+//g;
    return $n ? "-$_[0]" : "$_[0]";

}

sub filter_strip {

    $_[0] =~ s/\s+/ /g;
    $_[0] =~ s/^\s+//;
    $_[0] =~ s/\s+$//;
    return $_[0];

}

sub filter_titlecase {

    return join( " ", map { ucfirst $_ } (split( /\s/, lc $_[0] )) );

}

sub filter_trim {

    $_[0] =~ s/^\s+//g;
    $_[0] =~ s/\s+$//g;
    return $_[0];

}

sub filter_uppercase {

    return uc $_[0];

}

has 'mixin' => 1;
has 'field' => 1;
has 'multi' => 1;
has 'dependencies' => sub {{
    normalization => ['filtering'],
    validation    => []
}};

sub after_validation {

    my ($self, $proto, $field, $param) = @_;

    if ($proto->validated == 2) {
        $self->execute_filtering($proto, $field, $param, 'post');
    }

    return $self;

}

sub before_validation {

    my ($self, $proto, $field, $param) = @_;

    $self->execute_filtering($proto, $field, $param, 'pre');

    return $self;

}

sub normalize {

    my ($self, $proto, $field, $param) = @_;

    # by default fields should have a filters directive
    # unless already specified

    if (! defined $field->{filters}) {

        $field->{filters} = [];

    }

    # run any existing filters on instantiation
    # if the field is set to pre-filter

    else {

        $self->execute_filtering($proto, $field, $param, 'pre');

    }

    return $self;

}

sub execute_filtering {

    my ($self, $proto, $field, $param, $state) = @_;

    return unless $state &&
        ($proto->filtering eq 'pre' || $proto->filtering eq 'post') &&
        defined $field->{filters} &&
        defined $field->{filtering} &&
        defined $param
    ;

    my $filtering = $field->{filtering};

    $field->{filtering} = $proto->filtering unless defined $field->{filtering};

    if ($field->{filtering} eq $state && $state ne 'off') {

        my @filters = isa_arrayref($field->{filters}) ?
                @{$field->{filters}} : ($field->{filters});

        my $values = $param;

        foreach my $value (isa_arrayref($param) ? @{$param} : ($param)) {

            next if ! $value;

            foreach my $filter (@filters) {

                $filter = $proto->filters->get($filter)
                    unless isa_coderef($filter);

                next if ! $filter;

                $value  = $filter->($value);

            }

        }

        my $name = $field->name;

        $proto->params->add($name, $param);

    }

    $field->{filtering} = $filtering;

    return $self;

}

1;

__END__