added experimental validation support

lib/Mojolicious.pm

@@ -13,6 +13,7 @@ use Mojolicious::Routes;
 use Mojolicious::Sessions;
 use Mojolicious::Static;
 use Mojolicious::Types;
+use Mojolicious::Validator;
 use Scalar::Util qw(blessed weaken);
 use Time::HiRes 'gettimeofday';
 
@@ -36,9 +37,10 @@ has secret   => sub {
   # Default to moniker
   return $self->moniker;
 };
-has sessions => sub { Mojolicious::Sessions->new };
-has static   => sub { Mojolicious::Static->new };
-has types    => sub { Mojolicious::Types->new };
+has sessions  => sub { Mojolicious::Sessions->new };
+has static    => sub { Mojolicious::Static->new };
+has types     => sub { Mojolicious::Types->new };
+has validator => sub { Mojolicious::Validator->new };
 
 our $CODENAME = 'Top Hat';
 our $VERSION  = '4.42';
@@ -364,6 +366,14 @@ L<Mojolicious::Types> object.
   # Add custom MIME type
   $app->types->type(twt => 'text/tweet');
 
+=head2 validator
+
+  my $validator = $app->validator;
+  $app          = $app->validator(Mojolicious::Validator->new);
+
+Validate form data, defaults to a L<Mojolicious::Validator> object. Note that
+this attribute is EXPERIMENTAL and might change without warning!
+
 =head1 METHODS
 
 L<Mojolicious> inherits all methods from L<Mojo> and implements the following

lib/Mojolicious/Plugin/DefaultHelpers.pm

@@ -33,6 +33,7 @@ sub register {
   $app->helper(include       => \&_include);
   $app->helper(ua            => sub { shift->app->ua });
   $app->helper(url_with      => \&_url_with);
+  $app->helper(validation    => \&_validation);
 }
 
 sub _content {
@@ -88,6 +89,12 @@ sub _url_with {
   return $self->url_for(@_)->query($self->req->url->query->clone);
 }
 
+sub _validation {
+  my $self = shift;
+  return $self->stash->{'mojo.validation'}
+    ||= $self->app->validator->validation->input($self->req->params->to_hash);
+}
+
 1;
 
 =encoding utf8
@@ -251,6 +258,13 @@ request.
 
   %= url_with->query([page => 2])
 
+=head2 validation
+
+  %= validation
+
+Get L<Mojolicious::Validator::Validation> object for current request. Note
+that this helper is EXPERIMENTAL and might change without warning!
+
 =head1 METHODS
 
 L<Mojolicious::Plugin::DefaultHelpers> inherits all methods from

lib/Mojolicious/Validator.pm

@@ -0,0 +1,98 @@
+package Mojolicious::Validator;
+use Mojo::Base -base;
+
+use Mojolicious::Validator::Validation;
+
+has checks => sub { {range => \&_range} };
+has errors => sub {
+  {
+    range    => sub {qq{Value needs to be $_[3]-$_[4] characters long.}},
+    required => sub {qq{Value is required.}}
+  };
+};
+
+sub add_check { shift->_add(checks => @_) }
+sub add_error { shift->_add(errors => @_) }
+
+sub validation {
+  Mojolicious::Validator::Validation->new(validator => shift);
+}
+
+sub _add {
+  my ($self, $attr, $name, $cb) = @_;
+  $self->$attr->{$name} = $cb;
+  return $self;
+}
+
+sub _range {
+  my ($validation, $name, $value, $min, $max) = @_;
+  my $len = length $value;
+  return $len >= $min && $len <= $max;
+}
+
+1;
+
+=encoding utf8
+
+=head1 NAME
+
+Mojolicious::Validator - Validate form data
+
+=head1 SYNOPSIS
+
+  use Mojolicious::Validator;
+
+  my $validator  = Mojolicious::Validator->new;
+  my $validation = $validator->validation;
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Validator> validates form data.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Validator> implements the following attributes.
+
+=head2 checks
+
+  my $checks = $validator->checks;
+  $validator = $validator->checks({range => sub {...}});
+
+Registered checks, by default only C<range> is already defined.
+
+=head2 errors
+
+  my $errors = $validator->errors;
+  $validator = $validator->errors({range => sub {...}});
+
+Registered error generators, by default only C<range> and C<required> are
+already defined.
+
+=head1 METHODS
+
+L<Mojolicious::Validator> inherits all methods from L<Mojo::Base> and
+implements the following new ones.
+
+=head2 add_check
+
+  $validator = $validator->add_check(range => sub {...});
+
+Register a new check.
+
+=head2 add_error
+
+  $validator = $validator->add_error(range => sub {...});
+
+Register a new error generator.
+
+=head2 validation
+
+  my $validation = $validator->validation;
+
+Get a new L<Mojolicious::Validator::Validation> object to perform validations.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+
+=cut

lib/Mojolicious/Validator/Validation.pm

@@ -0,0 +1,212 @@
+package Mojolicious::Validator::Validation;
+use Mojo::Base -base;
+
+use Carp 'croak';
+use Scalar::Util 'blessed';
+
+has [qw(input output)] => sub { {} };
+has [qw(topic validator)];
+
+sub AUTOLOAD {
+  my $self = shift;
+
+  my ($package, $method) = our $AUTOLOAD =~ /^([\w:]+)::(\w+)$/;
+  Carp::croak "Undefined subroutine &${package}::$method called"
+    unless Scalar::Util::blessed $self && $self->isa(__PACKAGE__);
+
+  croak qq{Can't locate object method "$method" via package "$package"}
+    unless $self->validator->checks->{$method};
+  return $self->check($method => @_);
+}
+
+sub DESTROY { }
+
+sub check {
+  my ($self, $check) = (shift, shift);
+
+  my $err = delete $self->{error};
+  return $self unless $self->is_valid;
+
+  my $cb   = $self->validator->checks->{$check};
+  my $name = $self->topic;
+  return $self if $self->_check($name, $self->input->{$name}, $cb, @_);
+
+  delete $self->output->{$name};
+  $self->_error($check, $err, $name, delete $self->input->{$name}, @_);
+  return $self;
+}
+
+sub error {
+  my $self = shift;
+  $self->{error} = shift;
+  return $self;
+}
+
+sub errors { @{shift->{errors}{shift()} // []} }
+
+sub has_errors { !!keys %{shift->{errors}} }
+
+sub is_valid { exists $_[0]->output->{$_[1] // $_[0]->topic} }
+
+sub optional {
+  my ($self, $name) = @_;
+  my $input = $self->input->{$name};
+  $self->output->{$name} = $input
+    if $self->_check($name, $input, sub { defined $_[2] && length $_[2] });
+  return $self->topic($name);
+}
+
+sub param {
+  my ($self, $name) = @_;
+
+  # Multiple names
+  return map { scalar $self->param($_) } @$name if ref $name eq 'ARRAY';
+
+  # List names
+  return sort keys %{$self->output} unless $name;
+
+  my $value = $self->output->{$name};
+  my @values = ref $value eq 'ARRAY' ? @$value : ($value);
+  return wantarray ? @values : $values[0];
+}
+
+sub required {
+  my ($self, $name) = @_;
+  $self->optional($name);
+  my $err = delete $self->{error};
+  $self->_error('required', $err, $name, $self->input->{$name})
+    unless $self->is_valid;
+  return $self;
+}
+
+sub _check {
+  my ($self, $name, $input, $cb) = (shift, shift, shift, shift);
+  for my $value (ref $input eq 'ARRAY' ? @$input : $input) {
+    return undef unless $self->$cb($name, $value, @_);
+  }
+  return 1;
+}
+
+sub _error {
+  my ($self, $check, $err, $name, $input)
+    = (shift, shift, shift, shift, shift);
+  my $cb = $self->validator->errors->{$check} // sub {'Value is invalid.'};
+  push @{$self->{errors}{$name}}, $err // $self->$cb($name, $_, @_)
+    for ref $input eq 'ARRAY' ? @$input : $input;
+}
+
+1;
+
+=encoding utf8
+
+=head1 NAME
+
+Mojolicious::Validator::Validation - Perform validations
+
+=head1 SYNOPSIS
+
+  use Mojolicious::Validator;
+  use Mojolicious::Validator::Validation;
+
+  my $validator = Mojolicious::Validator->new;
+  my $validation
+    = Mojolicious::Validator::Validation->new(validator => $validator);
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Validator::Validation> performs validations.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Validator::Validation> implements the following attributes.
+
+=head2 input
+
+  my $input   = $validation->input;
+  $validation = $validation->input({});
+
+Data to be validated.
+
+=head2 output
+
+  my $output  = $validation->output;
+  $validation = $validation->output({});
+
+Validated data.
+
+=head2 topic
+
+  my $topic   = $validation->topic;
+  $validation = $validation->topic('foo');
+
+Current validation topic.
+
+=head2 validator
+
+  my $validator = $validation->validator;
+  $validation   = $validation->validator(Mojolicious::Validator->new);
+
+L<Mojolicious::Validator> object this validation belongs to.
+
+=head1 METHODS
+
+L<Mojolicious::Validator::Validation> inherits all methods from L<Mojo::Base>
+and implements the following new ones.
+
+=head2 check
+
+  $validation = $validation->check('range', 2, 7);
+
+Perform validation check.
+
+=head2 error
+
+  $validation = $validation->error('This went wrong.');
+
+Set custom error message for next validation check.
+
+=head2 errors
+
+  my @messages = $validation->errors('foo');
+
+Get error messages for failed validation checks.
+
+=head2 has_errors
+
+  my $success = $validation->has_errors;
+
+Check if this validation has error messages.
+
+=head2 is_valid
+
+  my $success = $validation->is_valid;
+  my $success = $validation->is_valid('foo');
+
+Check if validation was successful, defaults to checking the current C<topic>.
+
+=head2 optional
+
+  $validation = $validation->optional('foo');
+
+Change validation C<topic>.
+
+=head2 param
+
+  my @names       = $c->param;
+  my $foo         = $c->param('foo');
+  my @foo         = $c->param('foo');
+  my ($foo, $bar) = $c->param(['foo', 'bar']);
+
+Access validated parameters.
+
+=head2 required
+
+  $validation = $validation->required('foo');
+
+Change validation C<topic> and make sure a value is present.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+
+=cut