Lite.pm

package FormValidator::Lite;
use strict;
use warnings;
use 5.008_001;
use Carp ();
use UNIVERSAL::require;
use Scalar::Util qw/blessed/;
use FormValidator::Lite::Constraint::Default;
use FormValidator::Lite::Upload;

our $VERSION = '0.17';

our $Rules;
our $FileRules;

sub import {
    my ($class, @constraints) = @_;
    $class->load_constraints(@constraints);
}

sub new {
    my ($class, $q) = @_;
    Carp::croak("Usage: ${class}->new(\$q)") unless $q;

    bless { _q => $q, _error => {} }, $class;
}

sub check {
    my ($self, @rule_ary) = @_;
    Carp::croak("this is instance method") unless ref $self;

    my $q = $self->{_q};
    while (my ($key, $rules) = splice(@rule_ary, 0, 2)) {
        local $_;
        if (ref $key) {
            $key = [%$key];
            $_ = [ map { $q->param($_) } @{ $key->[1] } ];
            $key = $key->[0];
        } else {
            $_ = $q->param($key);
        }
        for my $rule (@$rules) {
            my $rule_name = ref($rule) ? $rule->[0]                        : $rule;
            my $args      = ref($rule) ? [ @$rule[ 1 .. scalar(@$rule)-1 ] ] : +[];

            my $is_ok = do {
                if ((not (defined $_ && length $_)) && $rule_name ne 'NOT_NULL') {
                    1;
                } else {
                    if (my $file_rule = $FileRules->{$rule_name}) {
                        local $_ = FormValidator::Lite::Upload->new($q, $key);
                        $file_rule->(@$args) ? 1 : 0;
                    } else {
                        my $code = $Rules->{$rule_name} or Carp::croak("unknown rule $rule_name");
                        $code->(@$args) ? 1 : 0;
                    }
                }
            };
            if ($is_ok==0) {
                $self->set_error($key => $rule_name);
            }
        }
    }

    return $self;
}

sub is_error {
    my ($self, $key) = @_;
    $self->{_error}->{$key} ? 1 : 0;
}

sub is_valid {
    my $self = shift;
    !$self->has_error ? 1 : 0;
}

sub has_error {
    my ($self, ) = @_;
    %{ $self->{_error} } ? 1 : 0;
}

sub set_error {
    my ($self, $param, $rule_name) = @_;
    $self->{_error}->{$param}->{$rule_name}++;
    push @{$self->{_error_ary}}, [$param, $rule_name];
}

sub load_constraints {
    my $class = shift;
    for (@_) {
        my $constraint = $_;
        $constraint = ($constraint =~ s/^\+//) ? $constraint : "FormValidator::Lite::Constraint::${constraint}";
        $constraint->use or die $@;
    }
}

sub load_function_message {
    my ($self, $lang) = @_;
    my $pkg = "FormValidator::Lite::Messages::$lang";
    $pkg->require or die $@;

    no strict 'refs';
    $self->{_msg}->{function} = ${"${pkg}::MESSAGES"};
}

sub set_param_message {
    my ($self, %args) = @_;
    $self->{_msg}->{param} = \%args;
}

sub set_message_data {
    my ($self, $msg) = @_;
    for my $key (qw/message param function/) {
        Carp::croak("missing key $key") unless $msg->{$key};
    }
    $self->{_msg} = $msg;
}

sub set_message {
    my ($self, @args) = @_;
    my %msg = ref $args[0] ? %{$args[0]} : @args;
    $self->{_msg}->{message} = +{
        %{ $self->{_msg}->{message} || +{} },
        %msg
    };
}

sub get_error_messages {
    my $self = shift;
    Carp::croak("message doesn't loaded yet") unless $self->{_msg};

    my %dup_check;
    my @messages;
    for my $err (@{$self->{_error_ary}}) {
        my $param = $err->[0];
        my $func  = $err->[1];

        next if exists $dup_check{"$param.$func"};
        push @messages, $self->get_error_message( $param, $func );
        $dup_check{"$param.$func"}++;
    }

    return wantarray ? @messages : \@messages;
}

# $validator->get_error_message('email', 'NOT_NULL');
sub get_error_message {
    my ($self, $param, $function) = @_;
    $function = lc($function);

    my $msg = $self->{_msg};
    Carp::croak("please load message file first") unless $msg;

    my $err_message  = $msg->{message}->{"${param}.${function}"};
    my $err_param    = $msg->{param}->{$param};
    my $err_function = $msg->{function}->{$function};

    my $gen_msg = sub {
        my ($tmpl, @args) = @_;
        local $_ = $tmpl;
        s!\[_(\d+)\]!$args[$1-1]!ge;
        $_;
    };
    
    if ($err_message) {
        return $gen_msg->($err_message, $err_param);
    } elsif ($err_function && $err_param) {
        return $gen_msg->($err_function, $err_param);
    } else {
        Carp::carp  "${param}.${function} is not defined in message file.";
        if ($msg->{default_tmpl}) {
            return $gen_msg->($err_function || $msg->{default_tmpl}, $err_function || $param);
        } else {
            return '';
        }
    }
}

sub get_error_messages_from_param {
    my ($self, $target_param) = @_;

    my %dup_check;
    my @messages;
    for my $err (@{$self->{_error_ary}}) {
        my $param = $err->[0];
        my $func  = $err->[1];

        next if $target_param ne $param;
        next if exists $dup_check{"$param.$func"};
        push @messages, $self->get_error_message( $param, $func );
        $dup_check{"$param.$func"}++;
    }

    return @messages;
}

1;

__END__

=head1 NAME

FormValidator::Lite - lightweight form validation library

=head1 SYNOPSIS

    use FormValidator::Lite;

    FormValidator::Lite->load_constraints(qw/Japanese/);

    my $q = CGI->new();
    my $validator = FormValidator::Lite->new($q);
    my $res = $validator->check(
        name => [qw/NOT_NULL/],
        name_kana => [qw/NOT_NULL KATAKANA/],
        {mails => [qw/mail1 mail2/]} => ['DUPLICATION'],
    );
    if ( ..... return_true_when_if_error() ..... ) {
        $validator->set_error('login_id' => 'DUPLICATION');
    }
    if ($validator->has_error) {
        ...
    }

    # in your tmpl
    <ul>
    ? for my $msg ($validator->get_error_messages) {
        <li><?= $msg ?></li>
    ? }
    </ul>

=head1 DESCRIPTION

FormValidator::Lite is simple, fast implementation for form validation.

IT'S IN BETA QUALITY. API MAY CHANGE IN FUTURE.

=head1 HOW TO WRITE YOUR OWN CONSTRAINTS

    http parameter comes from $_
    validator args comes from @_

=head1 METHODS

=over 4

=item my $validator = FormValidator::Lite->new($q);

Create a new instance.

$q is query like object, such as Apache::Request, CGI.pm, Plack::Request.

=item $validator->check(@rule_ary)

This method do validation.

=item $validator->is_error($key)

Return true value if parameter named $key got error.

=item $validator->is_valid()

Return true value if $validator don't detects error.

This is same as !$validator->has_error().

=item $validator->has_error()

Return true value if $validator detects error.

This is same as !$validator->is_valid().

=item $validator->set_error($param, $rule_name)

Set new error to parameter named $param. The rule name is  $rule_name.

=item $validator->load_constraints($name)

load constraint components named "FormValidator::Lite::Constraint::${name}".

=item $validator->load_function_message($lang)

    $validator->load_function_message('ja');

Load function message file.

Currently, FormValidator::Lite::Messages::ja and FormValidator::Lite::Messages::en are available.

=item $validator->set_param_message($param => $message, ...)
    
    $validator->set_param_message(
        name => 'Your Name',
    );

Make relational map for the parameter name to human readable name.

=item $validator->set_message_data({ message => $msg, param => $param, function => $function })

    $v->set_message_data(YAML::Load(<<'...'));
    ---
    message:
      zip.jzip: Please input correct zip number.
    param:
      name: Your Name
    function:
      not_null: "[_1] is empty"
      hiragana: "[_1] is not Hiragana"
    ...

Setup error message map.

=item $validator->set_message("$param.$func" => $message)

    $v->set_message('zip.jzip' => 'Please input correct zip number.');

Set error message for the $param and $func.

=item my @errors = $validator->get_error_messages()

=item my $errors = $validator->get_error_messages()

Get whole error messages for $q in array/arrayref.

=item my $msg = $validator->get_error_message($param => $func)

Generate error message for parameter $param and function named $func.

=item my @msgs = $validator->get_error_messages_from_param($param)

Get error messages by $q for parameter $param.

=back

=head1 WHY NOT FormValidator::Simple?

Yes, I know. This module is very similar with FV::S.

But, FormValidator::Simple is too heavy for me.
FormValidator::Lite is fast!

   Perl: 5.010000
   FVS: 0.23
   FVL: 0.02
                           Rate FormValidator::Simple   FormValidator::Lite
   FormValidator::Simple  353/s                    --                  -75%
   FormValidator::Lite   1429/s                  304%                    --

=head1 AUTHOR

Tokuhiro Matsuno E<lt>tokuhirom {at} gmail.comE<gt>

=head1 THANKS TO

craftworks

nekokak

=head1 SEE ALSO

L<FormValidator::Simple>, L<Data::FormValidator>, L<HTML::FormFu>

=head1 LICENSE

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

=cut