File Coverage

blib/lib/Validator/Custom.pm

Criterion	Covered	Total	%
statement	293	301	97.3
branch	172	184	93.4
condition	27	36	75.0
subroutine	26	27	96.3
pod	8	12	66.6
total	526	560	93.9

package Validator::Custom;
use Object::Simple -base;
use 5.008001;
our $VERSION = '1.02';

use Carp 'croak';
use Validator::Custom::Validation;
use Validator::Custom::FilterFunction;
use Validator::Custom::CheckFunction;

# Version 0 modules
use Validator::Custom::Constraints;
use Validator::Custom::Constraint;
use Validator::Custom::Result;
use Validator::Custom::Rule;

sub validation { Validator::Custom::Validation->new }

sub new {
  my $self = shift->SUPER::new(@_);

  # Add checks
  $self->add_check(
    ascii_graphic     => \&Validator::Custom::CheckFunction::ascii_graphic,
    number           => \&Validator::Custom::CheckFunction::number,
    int               => \&Validator::Custom::CheckFunction::int,
    in                => \&Validator::Custom::CheckFunction::in
  );

  # Add filters
  $self->add_filter(
    remove_blank      => \&Validator::Custom::FilterFunction::remove_blank,
    trim              => \&Validator::Custom::FilterFunction::trim,
  );

  # Version 0 constraints
  $self->register_constraint(
    any               => sub { 1 },
    ascii             => \&Validator::Custom::Constraint::ascii,
    between           => \&Validator::Custom::Constraint::between,
    blank             => \&Validator::Custom::Constraint::blank,
    date_to_timepiece => \&Validator::Custom::Constraint::date_to_timepiece,
    datetime_to_timepiece => \&Validator::Custom::Constraint::datetime_to_timepiece,
    decimal           => \&Validator::Custom::Constraint::decimal,
    defined           => sub { defined $_[0] },
    duplication       => \&Validator::Custom::Constraint::duplication,
    equal_to          => \&Validator::Custom::Constraint::equal_to,
    greater_than      => \&Validator::Custom::Constraint::greater_than,
    http_url          => \&Validator::Custom::Constraint::http_url,
    int               => \&Validator::Custom::Constraint::int,
    in_array          => \&Validator::Custom::Constraint::in_array,
    length            => \&Validator::Custom::Constraint::length,
    less_than         => \&Validator::Custom::Constraint::less_than,
    merge             => \&Validator::Custom::Constraint::merge,
    not_defined       => \&Validator::Custom::Constraint::not_defined,
    not_space         => \&Validator::Custom::Constraint::not_space,
    not_blank         => \&Validator::Custom::Constraint::not_blank,
    uint              => \&Validator::Custom::Constraint::uint,
    regex             => \&Validator::Custom::Constraint::regex,
    selected_at_least => \&Validator::Custom::Constraint::selected_at_least,
    shift             => \&Validator::Custom::Constraint::shift_array,
    space             => \&Validator::Custom::Constraint::space,
    string            => \&Validator::Custom::Constraint::string,
    to_array          => \&Validator::Custom::Constraint::to_array,
    to_array_remove_blank => \&Validator::Custom::Constraint::to_array_remove_blank,
    trim              => \&Validator::Custom::Constraint::trim,
    trim_collapse     => \&Validator::Custom::Constraint::trim_collapse,
    trim_lead         => \&Validator::Custom::Constraint::trim_lead,
    trim_trail        => \&Validator::Custom::Constraint::trim_trail,
    trim_uni          => \&Validator::Custom::Constraint::trim_uni,
    trim_uni_collapse => \&Validator::Custom::Constraint::trim_uni_collapse,
    trim_uni_lead     => \&Validator::Custom::Constraint::trim_uni_lead,
    trim_uni_trail    => \&Validator::Custom::Constraint::trim_uni_trail
  );

  return $self;
}

sub check_each {
  my ($self, $values, $name, $arg) = @_;

  if (@_ < 3) {
    croak "values and the name of a checking function must be passed";
  }

  my $checks = $self->{checks} || {};

  croak "Can't call \"$name\" checking function"
    unless $checks->{$name};

  croak "values must be array reference"
    unless ref $values eq 'ARRAY';

  my $is_invalid;
  for my $value (@$values) {
    my $is_valid = $checks->{$name}->($self, $value, $arg);
    unless ($is_valid) {
      $is_invalid = 1;
      last;
    }
  }

  return $is_invalid ? 0 : 1;
}

sub filter_each {
  my ($self, $values, $name, $arg) = @_;

  if (@_ < 3) {
    croak "values and the name of a filtering function must be passed";
  }

  my $filters = $self->{filters} || {};

  croak "Can't call \"$name\" filtering function"
    unless $filters->{$name};

  croak "values must be array reference"
    unless ref $values eq 'ARRAY';

  my $new_values = [];
  for my $value (@$values) {
    my $new_value = $filters->{$name}->($self, $value, $arg);
    push @$new_values, $new_value;
  }

  return $new_values;
}

sub check {
  my ($self, $value, $name, $arg) = @_;

  if (@_ < 3) {
    croak "value and the name of a checking function must be passed";
  }

  my $checks = $self->{checks} || {};

  croak "Can't call \"$name\" checking function"
    unless $checks->{$name};

  return $checks->{$name}->($self, $value, $arg);
}

sub filter {
  my ($self, $value, $name, $arg) = @_;

  if (@_ < 3) {
    croak "value and the name of a filtering function must be passed";
  }

  my $filters = $self->{filters} || {};

  croak "Can't call \"$name\" filtering function"
    unless $filters->{$name};

  return $filters->{$name}->($self, $value, $arg);
}

sub add_check {
  my $self = shift;

  # Merge
  my $checks = ref $_[0] eq 'HASH' ? $_[0] : {@_};
  $self->{checks} = ({%{$self->{checks} || {}}, %$checks});

  return $self;
}

sub add_filter {
  my $self = shift;

  # Merge
  my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
  $self->{filters} = ({%{$self->{filters} || {}}, %$filters});

  return $self;
}

# Version 0 method
our %VALID_OPTIONS = map {$_ => 1} qw/message default copy require optional/;
sub _parse_constraint {
  my ($self, $c) = @_;

  # Constraint information
  my $cinfo = {};

  # Arrange constraint information
  my $constraint = $c->{constraint};
  $cinfo->{message} = $c->{message};
  $cinfo->{original_constraint} = $c->{constraint};

  # Code reference
  if (ref $constraint eq 'CODE') {
    $cinfo->{funcs} = [$constraint];
  }
  # Simple constraint name
  else {
    my $constraints;
    if (ref $constraint eq 'ARRAY') {
      $constraints = $constraint;
    }
    else {
      if ($constraint =~ /\|\|/) {
        $constraints = [split(/\|\|/, $constraint)];
      }
      else {
        $constraints = [$constraint];
      }
    }

    # Constraint functions
    my @cfuncs;
    my @cargs;
    for my $cname (@$constraints) {
      # Arrange constraint
      if (ref $cname eq 'HASH') {
        my $first_key = (keys %$cname)[0];
        push @cargs, $cname->{$first_key};
        $cname = $first_key;
      }

      # Target is array elements
      $cinfo->{each} = 1 if $cname =~ s/^@//;
      croak qq{"\@" must be one at the top of constrinat name}
        if index($cname, '@') > -1;


      # Trim space
      $cname =~ s/^\s+//;
      $cname =~ s/\s+$//;

      # Negative
      my $negative = $cname =~ s/^!// ? 1 : 0;
      croak qq{"!" must be one at the top of constraint name}
        if index($cname, '!') > -1;

      # Trim space
      $cname =~ s/^\s+//;
      $cname =~ s/\s+$//;

      # Constraint function
      croak "Constraint name '$cname' must be [A-Za-z0-9_]"
        if $cname =~ /\W/;
      my $cfunc = $self->constraints->{$cname} || '';
      croak qq{"$cname" is not registered}
        unless ref $cfunc eq 'CODE';

      # Negativate
      my $f = $negative ? sub {
        my $ret = $cfunc->(@_);
        if (ref $ret eq 'ARRAY') {
          $ret->[0] = ! $ret->[0];
          return $ret;
        }
        else { return !$ret }
      } : $cfunc;

      # Add
      push @cfuncs, $f;
    }
    $cinfo->{funcs} = \@cfuncs;
    $cinfo->{args} = \@cargs;
  }

  return $cinfo;
}

# DEPRECATED!
has shared_rule => sub { [] };
# DEPRECATED!
__PACKAGE__->attr('constraints' => sub { {} });

# Version 0 method
sub create_rule { Validator::Custom::Rule->new(validator => shift) }

# Version 0 method
sub register_constraint {
  my $self = shift;

  # Merge
  my $constraints = ref $_[0] eq 'HASH' ? $_[0] : {@_};
  $self->constraints({%{$self->constraints}, %$constraints});

  return $self;
}

# Version 0 method
sub _parse_random_string_rule {
  my $self = shift;

  # Rule
  my $rule = ref $_[0] eq 'HASH' ? $_[0] : {@_};

  # Result
  my $result = {};

  # Parse string rule
  for my $name (keys %$rule) {
    # Pettern
    my $pattern = $rule->{$name};
    $pattern = '' unless $pattern;

    # State
    my $state = 'character';

    # Count
    my $count = '';

    # Chacacter sets
    my $csets = [];
    my $cset = [];

    # Parse pattern
    my $c;
    while (defined ($c = substr($pattern, 0, 1, '')) && length $c) {
      # Character class
      if ($state eq 'character_class') {
        if ($c eq ']') {
          $state = 'character';
          push @$csets, $cset;
          $cset = [];
          $state = 'character';
        }
        else { push @$cset, $c }
      }

      # Count
      elsif ($state eq 'count') {
        if ($c eq '}') {
          $count = 1 if $count < 1;
          for (my $i = 0; $i < $count - 1; $i++) {
              push @$csets, [@{$csets->[-1] || ['']}];
          }
          $count = '';
          $state = 'character';
        }
        else { $count .= $c }
      }

      # Character
      else {
        if ($c eq '[') { $state = 'character_class' }
        elsif ($c eq '{') { $state = 'count' }
        else { push @$csets, [$c] }
      }
    }

    # Add Charcter sets
    $result->{$name} = $csets;
  }

  return $result;
}

# Version 0 method
sub validate {
  my ($self, $input, $rule) = @_;

  # Class
  my $class = ref $self;

  # Validation rule
  $rule ||= $self->rule;

  # Data filter
  my $filter = $self->data_filter;
  $input = $filter->($input) if $filter;

  # Check data
  croak "First argument must be hash ref"
    unless ref $input eq 'HASH';

  # Check rule
  unless (ref $rule eq 'Validator::Custom::Rule') {
    croak "Invalid rule structure" unless ref $rule eq 'ARRAY';
  }

  # Result
  my $result = Validator::Custom::Result->new;
  $result->{_error_infos} = {};

  # Save raw data
  $result->raw_data($input);

  # Error is stock?
  my $error_stock = $self->error_stock;

  # Valid keys
  my $valid_keys = {};

  # Error position
  my $pos = 0;

  # Found missing parameters
  my $found_missing_params = {};

  # Shared rule
  my $shared_rule = $self->shared_rule;
  warn "Validator::Custom::shared_rule is DEPRECATED!"
    if @$shared_rule;

  if (ref $rule eq 'Validator::Custom::Rule') {
    $self->rule_obj($rule);
  }
  else {
    my $rule_obj = $self->create_rule;
    $rule_obj->parse($rule, $shared_rule);
    $self->rule_obj($rule_obj);
  }
  my $rule_obj = $self->rule_obj;

  if ($rule_obj->{version} && $rule_obj->{version} == 1) {
    croak "Can't call validate method(Validator::Custom). Use \$rule->validate(\$input) instead";
  }

  # Process each key
  OUTER_LOOP:
  for (my $i = 0; $i < @{$rule_obj->rule}; $i++) {

    my $r = $rule_obj->rule->[$i];

    # Increment position
    $pos++;

    # Key, options, and constraints
    my $key = $r->{key};
    my $opts = $r->{option};
    my $cinfos = $r->{constraints} || [];

    # Check constraints
    croak "Invalid rule structure"
      unless ref $cinfos eq 'ARRAY';

    # Arrange key
    my $result_key = $key;
    if (ref $key eq 'HASH') {
      my $first_key = (keys %$key)[0];
      $result_key = $first_key;
      $key         = $key->{$first_key};
    }
    elsif (defined $r->{name}) {
      $result_key = $r->{name};
    }

    # Real keys
    my $keys;

    if (ref $key eq 'ARRAY') { $keys = $key }
    elsif (ref $key eq 'Regexp') {
      $keys = [];
      for my $k (keys %$input) {
         push @$keys, $k if $k =~ /$key/;
      }
    }
    else { $keys = [$key] }

    # Check option
    if (exists $opts->{optional}) {
      if ($opts->{optional}) {
        $opts->{require} = 0;
      }
      delete $opts->{optional};
    }
    for my $oname (keys %$opts) {
      croak qq{Option "$oname" of "$result_key" is invalid name}
        unless $VALID_OPTIONS{$oname};
    }

    # Default
    if (exists $opts->{default}) {
      $r->{default} = $opts->{default};
    }

    # Is data copy?
    my $copy = 1;
    $copy = $opts->{copy} if exists $opts->{copy};

    # Check missing parameters
    my $require = exists $opts->{require} ? $opts->{require} : 1;
    my $found_missing_param;
    my $missing_params = $result->missing_params;
    for my $key (@$keys) {
      unless (exists $input->{$key}) {
        if ($require && !exists $r->{default}) {
          push @$missing_params, $key
            unless $found_missing_params->{$key};
          $found_missing_params->{$key}++;
        }
        $found_missing_param = 1;
      }
    }
    if ($found_missing_param) {
      $result->data->{$result_key} = ref $r->{default} eq 'CODE'
          ? $r->{default}->($self) : $r->{default}
        if exists $r->{default} && $copy;
      next if $r->{default} || !$require;
    }

    # Already valid
    next if $valid_keys->{$result_key};

    # Validation
    my $value = @$keys > 1
      ? [map { $input->{$_} } @$keys]
      : $input->{$keys->[0]};

    for my $cinfo (@$cinfos) {

      # Constraint information
      my $args = $cinfo->{args};
      my $message = $cinfo->{message};

      # Constraint function
      my $cfuncs = $cinfo->{funcs};

      # Is valid?
      my $is_valid;

      # Data is array
      if($cinfo->{each}) {

        # To array
        $value = [$value] unless ref $value eq 'ARRAY';

        # Validation loop
        for (my $k = 0; $k < @$value; $k++) {
          my $input = $value->[$k];

          # Validation
          for (my $j = 0; $j < @$cfuncs; $j++) {
            my $cfunc = $cfuncs->[$j];
            my $arg = $args->[$j];

            # Validate
            my $cresult;
            {
              local $_ = Validator::Custom::Constraints->new(
                constraints => $self->constraints
              );
              $cresult= $cfunc->($input, $arg, $self);
            }

            # Constrint result
            my $v;
            if (ref $cresult eq 'ARRAY') {
              ($is_valid, $v) = @$cresult;
              $value->[$k] = $v;
            }
            elsif (ref $cresult eq 'HASH') {
              $is_valid = $cresult->{result};
              $message = $cresult->{message} unless $is_valid;
              $value->[$k] = $cresult->{output} if exists $cresult->{output};
            }
            else { $is_valid = $cresult }

            last if $is_valid;
          }

          # Validation error
          last unless $is_valid;
        }
      }

      # Data is scalar
      else {
        # Validation
        for (my $k = 0; $k < @$cfuncs; $k++) {
          my $cfunc = $cfuncs->[$k];
          my $arg = $args->[$k];

          my $cresult;
          {
            local $_ = Validator::Custom::Constraints->new(
              constraints => $self->constraints
            );
            $cresult = $cfunc->($value, $arg, $self);
          }

          if (ref $cresult eq 'ARRAY') {
            my $v;
            ($is_valid, $v) = @$cresult;
            $value = $v if $is_valid;
          }
          elsif (ref $cresult eq 'HASH') {
            $is_valid = $cresult->{result};
            $message = $cresult->{message} unless $is_valid;
            $value = $cresult->{output} if exists $cresult->{output} && $is_valid;
          }
          else { $is_valid = $cresult }

          last if $is_valid;
        }
      }

      # Add error if it is invalid
      unless ($is_valid) {
        if (exists $r->{default}) {
          # Set default value
          $result->data->{$result_key} = ref $r->{default} eq 'CODE'
                                       ? $r->{default}->($self)
                                       : $r->{default}
            if exists $r->{default} && $copy;
          $valid_keys->{$result_key} = 1
        }
        else {
          # Resist error info
          $message = $opts->{message} unless defined $message;
          $result->{_error_infos}->{$result_key} = {
            message      => $message,
            position     => $pos,
            reason       => $cinfo->{original_constraint},
            original_key => $key
          } unless exists $result->{_error_infos}->{$result_key};

          # No Error stock
          unless ($error_stock) {
            # Check rest constraint
            my $found;
            for (my $k = $i + 1; $k < @{$rule_obj->rule}; $k++) {
              my $r_next = $rule_obj->rule->[$k];
              my $key_next = $r_next->{key};
              $key_next = (keys %$key)[0] if ref $key eq 'HASH';
              $found = 1 if $key_next eq $result_key;
            }
            last OUTER_LOOP unless $found;
          }
        }
        next OUTER_LOOP;
      }
    }

    # Result data
    $result->data->{$result_key} = $value if $copy;

    # Key is valid
    $valid_keys->{$result_key} = 1;

    # Remove invalid key
    delete $result->{_error_infos}->{$key};
  }

  return $result;
}

# Version 0 attributes
has 'data_filter';
has 'rule';
has 'rule_obj';
has error_stock => 1;

# Version 0 method
sub js_fill_form_button {
  my ($self, $rule) = @_;

  my $r = $self->_parse_random_string_rule($rule);

  require JSON;
  my $r_json = JSON->new->encode($r);

  my $javascript = << "EOS";
(function () {

  var rule = $r_json;

  var create_random_value = function (rule, name) {
    var patterns = rule[name];
    if (patterns === undefined) {
      return "";
    }

    var value = "";
    for (var i = 0; i < patterns.length; i++) {
      var pattern = patterns[i];
      var num = Math.floor(Math.random() * pattern.length);
      value = value + pattern[num];
    }

    return value;
  };

  var addEvent = (function(){
    if(document.addEventListener) {
      return function(node,type,handler){
        node.addEventListener(type,handler,false);
      };
    } else if (document.attachEvent) {
      return function(node,type,handler){
        node.attachEvent('on' + type, function(evt){
          handler.call(node, evt);
        });
      };
    }
  })();

  var button = document.createElement("input");
  button.setAttribute("type","button");
  button.value = "Fill Form";
  document.body.insertBefore(button, document.body.firstChild)

  addEvent(
    button,
    "click",
    function () {

      var input_elems = document.getElementsByTagName('input');
      var radio_names = {};
      var checkbox_names = {};
      for (var i = 0; i < input_elems.length; i++) {
        var e = input_elems[i];

        var name = e.getAttribute("name");
        var type = e.getAttribute("type");
        if (type === "text" || type === "hidden" || type === "password") {
          var value = create_random_value(rule, name);
          e.value = value;
        }
        else if (type === "checkbox") {
          e.checked = Math.floor(Math.random() * 2) ? true : false;
        }
        else if (type === "radio") {
          radio_names[name] = 1;
        }
      }

      for (name in radio_names) {
        var elems = document.getElementsByName(name);
        var num = Math.floor(Math.random() * elems.length);
        elems[num].checked = true;
      }

      var textarea_elems = document.getElementsByTagName("textarea");
      for (var i = 0; i < textarea_elems.length; i++) {
        var e = textarea_elems[i];

        var name = e.getAttribute("name");
        var value = create_random_value(rule, name);

        var text = document.createTextNode(value);

        if (e.firstChild) {
          e.removeChild(e.firstChild);
        }

        e.appendChild(text);
      }

      var select_elems = document.getElementsByTagName("select");
      for (var i = 0; i < select_elems.length; i++) {
        var e = select_elems[i];
        var options = e.options;
        if (e.multiple) {
          for (var k = 0; k < options.length; k++) {
            options[k].selected = Math.floor(Math.random() * 2) ? true : false;
          }
        }
        else {
          var num = Math.floor(Math.random() * options.length);
          e.selectedIndex = num;
        }
      }
    }
  );
})();
EOS

  return $javascript;
}

1;

=encoding UTF-8

=head1 NAME

Validator::Custom - HTML form Validation, simple and good flexibility

=head1 SYNOPSIS

  use Validator::Custom;
  my $vc = Validator::Custom->new;

  # Input data
  my $id = 1;
  my $name = 'Ken Suzuki';
  my $price = ' 19.23 ';
  my $favorite = ['001', '002'];

  # Create validation object
  my $validation = $vc->validation;

  # Check if id is integer
  if (!$vc->check($id, 'int')) {
    # Add failed message
    $validation->add_failed(id => 'id must be integer');
  }

  # Check if name has length
  if (!(length $name)) {
    $validation->add_failed(name => 'name must have length');
  }
  # Check if name's length is less than 30
  elsif (!(length $name < 30)) {
    $validation->add_failed(name => 'name is too long');
  }

  # Filter price to remove left-rigth space
  $price = $vc->filter($price, 'trim');

  # Check price is number and the digits of the decimal part is two or less than two
  if (!$vc->check($price, 'number', {decimal_part_max => 2})) {
    # Set default value if validation fail
    $price = 20.25;
  }

  # Filter each value of favorite using "trim" filtering function
  $favorite = $vc->filter_each($favorite, 'trim');

  # Check if favorite has at least one values
  if (@$favorite == 0) {
    $validation->add_failed(favorite => 'favorite must be selected more than one');
  }
  # Check if favorite is one of the specified values
  elsif (!($vc->check_each($favorite, 'in',  ['001', '002', '003']))) {
    $validation->add_failed(favorite => 'favorite is invalid');
  }

  # Check if validation result is valid
  if ($validation->is_valid) {
    # ...
  }
  else {

    # Check what parameter fail
    unless ($validation->is_valid('name')) {
      # ...
    }

    # Get all failed parameter names
    my $failed = $validation->failed;

    # Get a failed parameter message
    my $name_message = $validation->message('name');

    # Get all failed parameter messages
    my $messages = $validation->messages;

    # Get all failed parameter names and the messages as hash reference
    my $messages_h = $validation->messages_to_hash;
  }

=head1 DESCRIPTION

L is a validator for HTML form
with simple and good flexibility.

The features are the following ones.

=over 4

=item *

Sevral checking functions are available by default, C,
C, C, C.

=item *

Several filtering functions are available by default, such as C, C.

=item *

You can add your own checking and filtering function.

=item *

Simple validation object is available.
You can add failed parameter names
and the messages keeping the order of validation.

=back

=head1 GUIDE

=head2 1. Basic usage

=head3 1. Create a new Validator::Custom object

At first, create L object using C method.

  use Validator::Custom;
  my $vc = Validator::Custom->new;

=head3 2. Prepare input data for validation

Next, prepare input data.

  my $id = 1;
  my $name = 'Ken Suzuki';
  my $price = ' 19.23 ';
  my $favorite = ['001', '002'];

=head3 3. Create a new validation object

Next, create a new validation object using C method.

  my $validation = $vc->validation;

This is L object
to store failed parameter names and the messages.

=head3 4. Validate input data

  # Check if id is integer
  if (!$vc->check($id, 'int')) {
    # Add failed message
    $validation->add_failed(id => 'id must be integer');
  }

You can use C checking function to check the value is integer.
C checking function is default one.
Any checking function is available through C method.

When the check doesn't succeed, you can add the failed parameter name and the message
using C method of L class.

  # Filter price to remove left-rigth space
  $price = $vc->filter($price, 'trim');

You can use C filtering function to trim left-rigth spaces.

  # Filter each value of favorite using "trim" filtering function
  $favorite = $vc->filter_each($favorite, 'trim');

You can use C method to filter each value of favorite.

  # Check if favorite has at least one values
  if (@$favorite == 0) {
    $validation->add_failed(favorite => 'favorite must be selected more than one');
  }
  # Check if favorite is one of the specified values
  elsif (!($vc->check_each($favorite, 'in',  ['001', '002', '003']))) {
    $validation->add_failed(favorite => 'favorite is invalid');
  }

You can use C method to check each value of favorite.

If you see default checks and filter,
see L and L.

=head2 2. Manipulate validation object

If you check all input data is valid, use C method.

  # Check if validation result is valid
  if ($validation->is_valid) {
    # Success
  }
  else {
    # Failed
  }

If you can check a input data is valid, use C method with parameter name.

  # Check what parameter fail
  unless ($validation->is_valid('name')) {
    # ...
  }

You can get all failed parameter names using C method.

  # Get all failed parameter names
  my $failed = $validation->failed;

You can get a failed parameter message using C method.

  # Get a failed parameter message
  my $name_message = $validation->message('name');

You can get all failed parameter messages using C method.

  # Get all failed parameter messages
  my $messages = $validation->messages;

You can get all failed names and the messages as hash reference using C method.

  # Get all failed parameter names and the messages as hash reference
  my $messages_h = $validation->messages_to_hash;

See also L.

=head2 3. Advanced tequnique

=head3 1. Add checking function

You can add your own checking function using C method if you need.

  $vc->add_check(
    telephone => sub {
      my ($vc, $value, $arg) = @_;

      my $is_valid;
      if ($value =~ /^[\d-]+$/) {
        $is_valid = 1;
      }
      return $is_valid;
    }
  );

Checking function receives three arguments,
First argument is L object,
Second argument is the value for checking,
Third argument is the argument of checking function.

Your Checking function must return true or false value.

=head3 2. Add filtering function

You can add your filtering function by C method if you need.

  $vc->add_filter(
    to_upper_case => sub {
      my ($vc, $value, $arg) = @_;

      my $new_$value = uc $value;

      return $new_value;
    }
  );

Filtering function receives three arguments,
First argument is L object,
Second argument is the value for filtering.
Third argument is the argument of filtering function.

Your filtering function must return the result of filtering.

=head1 CHECKING FUNCTIONS

L have the following default checking functions.
You can call any checking function by C method.

=head2 int

  my $value = 19;
  my $is_valid = $vc->check($value, 'int');

Check if the value is integer value.

Example of valid values:

  "-10"
  "234"

Example of invalid values:

  "10.11"
  "abc"

If you also need to check the range of value, you can write the following way.

  my $is_valid =  $vc->check($value, 'int') && $value > 0;

=head2 number

  my $is_valid = $vc->check($value, 'number');

Check if the value is number.
Number means integer or decimal.

Example of valid values:

  '1'
  '123'
  '123.456'
  '-1'
  '-100'
  '-100.789'

Example of invalid values:

  'a';
  '1.a';
  'a.1';

You can also specify decimal part max digits using C option.

  my $is_valid = $vc->check($value, 'number', {decimal_part_max => 3});

Example of valid values:

  '123'
  '123.456'
  '-100.789'

Example of invalid values:

  '123.4567'
  '-100.7891'

=head2 ascii_graphic

  my $is_valid = $vc->check($value, 'ascii');

Check if the value is Ascii graphic characters(hex 21-7e).
Generally, C function is used to
check the characters of a password.

Example of valid values:

  "Ken!@-"

Example of invalid values:

  "aa aa"
  "\taaa"

=head2 in

  my $value = '001';
  my $is_valid = $vc->check($value, 'in', ['001', '002', '003']);

Check if the value is one of the given values.

Example of valid values:

  '001'
  '002'
  '003'

Example of invalid values:

  '004'
  '005'

=head1 FILTERING FUNCTIONS

L have the following default filtering functions.
You can call any filtering function using C method.

=head2 trim

  my $new_value = $vc->filter($value, 'trim');

Trim leading and trailing white space.
Note that trim function remove unicode space character, not only C<[ \t\n\r\f]>.

Filtering example:

  Input : '  　Ken  '
  Output: 'Ken'

=head2 remove_blank

  my $new_values = $vc->filter($values, 'remove_blank');

Remove blank character and undefined value from array reference.

Filtering example:

  Input : [1, 2, '', undef, 4]
  Output: [1, 2, 4]

=head1 METHODS

L inherits all methods from L
and implements the following new ones.

=head2 new

  my $vc = Validator::Custom->new;

Create a new L object.

=head2 add_check

  $vc->add_check(int => sub { ... });

Add a checking function.

Example:

  $vc->add_check(
    int => sub {
      my ($vc, $value, $arg) = @_;

      my $is_valid = $value =~ /^\-?[\d]+$/;

      return $is_valid;
    }
  );

Checking function receives three arguments,
First argument is L object,
Second argument is the value for checking,
Third argument is the argument of checking function.

Your Checking function must return true or false value.

=head2 add_filter

  $vc->add_filter(trim => sub { ... });

Add a filtering function.

Example:

  $vc->add_filter(
    trim => sub {
      my ($vc, $value, $arg) = @_;

      $value =~ s/^\s+//;
      $value =~ s/\s+$//;

      return $value;
    }
  );

=head2 check

  my $is_valid = $vc->check($value, 'int');
  my $is_valid = $vc->check($value, 'int', $arg);

Execute a checking function.

First argument is the value for checking.
Second argument is the name of the checking funcion.
Third argument is the argument of the checking function.

=head2 check_each

  my $is_valid = $vc->check_each($values, 'int');
  my $is_valid = $vc->check_each($values, 'int', $arg);

Execute a checking function to all elements of array reference.
If more than one element is invalid, C method return false.

First argument is the values for checking, which must be array reference.
Second argument is the name of the checking funcion.
Third argument is the argument of the checking function.

=head2 filter

  my $new_value = $vc->filter($value, 'trim');
  my $new_value = $vc->filter($value, 'trim', $arg);

Execute a filtering function.

First argument is the value for filtering.
Second argument is the name of the filtering funcion.
Third argument is the argument of the filtering function.

=head2 filter_each

  my $new_values = $vc->filter_each($values, 'trim');
  my $new_values = $vc->filter_each($values, 'trim', $arg);

Execute a filtering function to all elements of array reference.

First argument is the values for filtering, which must be array reference.
Second argument is the name of the filtering funcion.
Third argument is the argument of the filtering function.

=head1 EXAMPLES

Show you some examples to do some validation.

Password checking:

  my $password = 'abc';
  my $password2 = 'abc';

  my $validation = $vc->validation;

  if (!length $password) {
    $validation->add_failed(password => 'password must have length');
  }
  elsif (!$vc->check($password, 'ascii')) {
    $validation->add_failed(password => 'password contains invalid characters');
  }
  elsif ($password ne $password2) {
    $validation->add_failed(password => "two passwords don't match");
  }

  if ($validation->is_valid) {
    # ...
  }
  else {
    # ...
  }

Check box, selected at least 1, one of the given values:

  my $favorite = ['001', '002'];

  my $validation = $vc->validation;

  if (@$favorite == 0) {
    $validation->add_failed(favorite => 'favorite must be selected at least 1');
  }
  elsif (!$vc->check($favorite, 'in', ['001', '002', '003'])) {
    $validation->add_failed(favorite => 'favorite have invalid value');
  }

  if ($validtion->is_valid) {
    # ...
  }
  else {
    # ...
  }

Convert date string to L object.

  my $date = '2014/05/16';

  my $validation = $vc->validation;

  my $date_tp;
  if (!length $date) {
    $validation->add_failed(date => 'date must have length');
  }
  else {
    eval { $date_tp = Time::Piece->strptime($date, '%Y/%m/%d') };
    if (!$date_tp) {
      $validation->add_failed(date => 'date value is invalid');
    }
  }

Convert datetime string to L object.

  my $datetime = '2014/05/16 12:30:40';

  my $validation = $vc->validation;

  my $datetime_tp;
  if (!length $datetime) {
    $validation->add_failed(datetime => 'datetime must have length');
  }
  else {
    eval { $datetime_tp = Time::Piece->strptime($datetime, '%Y/%m/%d %H:%M:%S') };
    if (!$datetime_tp) {
      $validation->add_failed(datetime => 'datetime value is invalid');
    }
  }

=head1 FAQ

=head2 I use Validator::Custom 0.xx yet. I want to see documentation of Version 0.xx.

See L.
This is complete document for L version 0.xx.

=head2 What point I take care of in Version 1.xx.

=over 4

=item *

C constraint function is renamed to C checking function.

=item *

C filtering function becomes triming unicode space characters, not only C<[ \t\n\r\f]>.

=item *

C constraint is renamed to C checking function and simplified.

=item *

C checking function doesn't exist.
About alternative way, see the topic "Convert date string to Time::Piece object" in "EXAMPLES".

=item *

C checking function doesn't exists.
About alternative way, see the topic "Convert datetime string to Time::Piece object" in "EXAMPLES".

=back

=head2 How to create the corresponding checking functions in Version 0.xx constraint functions.

I show some examples.

space

  $vc->add_check(space => sub {
    my ($vc, $value, $arg) = @_;
    return defined $value && $value =~ '^[ \t\n\r\f]*$' ? 1 : 0;
  });

http_url

  $vc->add_check(http_url => sub {
    my ($vc, $value, $arg) = @_;
    return defined $value && $value =~ /^s?https?:\/\/[-_.!~*'()a-zA-Z0-9;\/?:\@&=+\$,%#]+$/ ? 1 : 0;
  });

decimal

  $vc->add_check(decimal => sub {
    my ($vc, $value, $arg) = @_;

    return undef unless defined $value;

    my $digits_tmp = $arg;

    # Digit
    my $digits;
    if (defined $digits_tmp) {
      if (ref $digits_tmp eq 'ARRAY') {
        $digits = $digits_tmp;
      }
      else {
        $digits = [$digits_tmp, undef];
      }
    }
    else {
      $digits = [undef, undef];
    }

    # Regex
    my $re;
    if (defined $digits->[0] && defined $digits->[1]) {
      $re = qr/^[0-9]{1,$digits->[0]}(\.[0-9]{0,$digits->[1]})?$/;
    }
    elsif (defined $digits->[0]) {
      $re = qr/^[0-9]{1,$digits->[0]}(\.[0-9]*)?$/;
    }
    elsif (defined $digits->[1]) {
      $re = qr/^[0-9]+(\.[0-9]{0,$digits->[1]})?$/;
    }
    else {
      $re = qr/^[0-9]+(\.[0-9]*)?$/;
    }

    # Check value
    if ($value =~ /$re/) {
      return 1;
    }
    else {
      return 0;
    }
  }

=head2 How to create the corresponding filtering functions in Version 0.xx constraint functions.

I show some examples.

trim_collapse

  $vc->add_filter(trim_collapse => sub {
    my ($vc, $value, $arg) = @_;

    return undef unless defined $value;

    $value =~ s/[ \t\n\r\f]+/ /g;
    $value =~ s/^[ \t\n\r\f]*(.*?)[ \t\n\r\f]*$/$1/ms;

    return $value;
  });

trim_lead

  $vc->add_filter(trim_lead => sub {
    my ($vc, $value, $arg) = @_;

    return undef unless defined $value;

    $value =~ s/^[ \t\n\r\f]+(.*)$/$1/ms;

    return $value;
  });

trim_trail

  $vc->add_filter(trim_trail => sub {
    my ($vc, $value, $arg) = @_;

    return undef unless defined $value;

    $value =~ s/^(.*?)[ \t\n\r\f]+$/$1/ms;

    return $value;
  });

trim_uni

  $vc->add_filter(trim_uni => sub {
    my ($vc, $value, $arg) = @_;

    return undef unless defined $value;

    $value =~ s/^\s*(.*?)\s*$/$1/ms;

    return $value;
  });

trim_uni_collapse

  $vc->add_filter(trim_uni_collapse => sub {
    my ($vc, $value, $arg) = @_;

    return undef unless defined $value;

    $value =~ s/\s+/ /g;
    $value =~ s/^\s*(.*?)\s*$/$1/ms;

    return $value;
  });

trim_uni_lead

  $vc->add_filter(trim_uni_lead => sub {
    my ($vc, $value, $arg) = @_;

    return undef unless defined $value;

    $value =~ s/^\s+(.*)$/$1/ms;

    return $value;
  });

trim_uni_trail

  $vc->add_filter(trim_uni_trail => sub {
    my ($vc, $value, $arg) = @_;

    return undef unless defined $value;

    $value =~ s/^(.*?)\s+$/$1/ms;

    return $value;
  });

=head1 AUTHOR

Yuki Kimoto, C<<  >>

L

=head1 COPYRIGHT & LICENCE

Copyright 2009-2015 Yuki Kimoto, all rights reserved.

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

=cut