File Coverage

File:blib/lib/Validator/Custom.pm
Coverage:98.6%

linestmtbrancondsubpodtimecode
1package Validator::Custom;
2
3
3
3
0
0
0
use Object::Simple;
3
4our $VERSION = '0.0205';
5
6require Carp;
7
8### class method
9
10# add validator function
11sub add_constraint {
12
6
1
0
    my $class = shift;
13
6
0
    my %old_constraints = $class->constraints;
14
6
1
10000
0
    my %new_constraints = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
15
6
0
    $class->constraints(%old_constraints, %new_constraints);
16}
17
18# get validator function
19
3
3
3
3
0
0
0
0
sub constraints : ClassAttr { type => 'hash', deref => 1, auto_build => \&_inherit_constraints }
20
21sub _inherit_constraints {
22
6
0
    my $class = shift;
23
6
0
    my $super = do {
24
3
3
3
0
0
0
        no strict 'refs';
25
6
6
0
0
        ${"${class}::ISA"}[0];
26    };
27
6
6
0
0
    my $constraints = eval{$super->can('constraints')}
28                        ? $super->constraints
29                        : {};
30
31
6
0
    $class->constraints($constraints);
32}
33
34### attribute
35
36# validators
37
3
3
3
3
13
0
0
0
0
0
sub validators : Attr { type => 'array', default => sub { [] } }
38
39# validation errors
40
3
3
3
3
14
0
0
0
0
0
sub errors : Attr { type => 'array', default => sub { [] }, deref => 1 }
41
42# error is stock?
43
3
3
3
3
10000
0
0
0
sub error_stock : Attr { default => 1 }
44
45# converted resutls
46
3
3
3
3
14
0
0
0
0
0
sub results : Attr { type => 'hash', default => sub{ {} }, deref => 1 }
47
48### method
49
50# validate!
51sub validate {
52
13
1
0
    my ($self, $hash, $validators ) = @_;
53
13
0
    my $class = ref $self;
54
55
56
13
0
    $validators ||= $self->validators;
57
58
13
0
    $self->errors([]);
59
13
0
    $self->results({});
60
13
0
    my $error_stock = $self->error_stock;
61
62    # process each key
63
41
0
    VALIDATOR_LOOP:
64    for (my $i = 0; $i < @{$validators}; $i += 2) {
65
30
30
0
0
        my ($key, $validator_infos) = @{$validators}[$i, ($i + 1)];
66
67
30
0
        foreach my $validator_info (@$validator_infos){
68
35
0
            my($constraint_expression, $error_message, $options ) = @$validator_info;
69
70
35
0
            my $data_type = {};
71
35
0
            my $args = [];
72
73
35
0
            if(ref $constraint_expression eq 'ARRAY') {
74
2
2
0
0
                $args = [@{$constraint_expression}[1 .. @$constraint_expression - 1]];
75
2
0
                $constraint_expression = $constraint_expression->[0];
76            }
77
78
35
0
            my $constraint_function;
79            # expression is code reference
80
35
0
            if( ref $constraint_expression eq 'CODE') {
81
10
0
                $constraint_function = $constraint_expression;
82            }
83
84            # expression is string
85            else {
86
25
0
                if($constraint_expression =~ /^\@(.+)$/) {
87
5
0
                    $data_type->{array} = 1;
88
5
0
                    $constraint_expression = $1;
89                }
90
91
25
0
                Carp::croak("Constraint type '$constraint_expression' must be [A-Za-z0-9_]")
92                  if $constraint_expression =~ /\W/;
93
94                # get validator function
95
25
0
                $constraint_function
96                  = $class->constraints->{$constraint_expression};
97
98
25
0
                Carp::croak("'$constraint_expression' is not resisted")
99                    unless ref $constraint_function eq 'CODE'
100            }
101
102            # validate
103
34
0
            my $is_valid;
104
34
0
            my $result;
105
34
0
            if($data_type->{array}) {
106
5
0
                my $values = ref $hash->{$key} eq 'ARRAY' ? $hash->{$key} : [$hash->{$key}];
107
108
5
0
                foreach my $data (@$values) {
109
8
0
                    ($is_valid, $result) = $constraint_function->($data, $args, $options->{options});
110
8
0
                    last unless $is_valid;
111
112
6
0
                    if (my $key = $options->{result}) {
113
2
0
                        $self->results->{$key} ||= [];
114
2
2
0
0
                        push @{$self->results->{$key}}, $result;
115                    }
116                }
117            }
118            else {
119
4
0
                ($is_valid, $result) = $constraint_function->(
120
29
0
                    ref $key eq 'ARRAY' ? [map { $hash->{$_} } @$key] : $hash->{$key},
121                    $args,
122                    $options->{options}
123                );
124
125
29
0
                if ($is_valid && $options->{result}) {
126
1
0
                    $self->results->{$options->{result}} = $result;
127                }
128            }
129
130            # add error if it is invalid
131
34
0
            unless($is_valid){
132
16
16
0
0
                push @{$self->errors}, $error_message;
133
16
0
                last VALIDATOR_LOOP unless $error_stock;
134
15
0
                next VALIDATOR_LOOP;
135            }
136        }
137
13
0
    }
138
12
0
    return $self;
139}
140
141Object::Simple->build_class;
142
143 - 323
=head1 NAME

Validator::Custom - Custom validator

=head1 VERSION

Version 0.0205

=head1 CAUTION

Validator::Custom is yew experimental stage.

=head1 SYNOPSIS
    
    ### How to use Validator::Custom
    
    # data
    my $hash = { title => 'aaa', content => 'bbb' };
    
    # validator functions
    my $validators = [
        title => [
            [sub{$_[0]},              "Specify title"],
            [sub{length $_[0] < 128}, "Too long title"]
        ],
        content => [
            [sub{$_[0]},               "Specify content"],
            [sub{length $_[0] < 1024}, "Too long content"]
        ]
    ];
    
    # validate
    my $vc = Validator::Custom->new;
    my @errors = $vc->validate($hash,$validators)->errors;
    
    # or
    my $vc = Validator::Custom->new( validators => $validators);
    my @errors = $vc->validate($hash)->errors;
    
    # process in error case
    if($errors){
        foreach my $error (@$errors) {
            # process all errors
        }
    }
    
    ### How to costomize Validator::Custom
    package Validator::Custom::Yours;
    use base 'Validator::Custom';
    
    # regist custom type
    __PACKAGE__->add_constraint(
        Int => sub {$_[0] =~ /^\d+$/},
        Num => sub {
            require Scalar::Util;
            Scalar::Util::looks_like_number($_[0]);
        },
        Str => sub {!ref $_[0]}
    );
    
    ### How to use customized validator class
    use Validator::Custom::Yours;
    my $hash = { age => 'aaa', weight => 'bbb', favarite => [qw/sport food/};
    
    my $validators = [
        title => [
            ['Int', "Must be integer"],
        ],
        content => [
            ['Num', "Must be number"],
        ],
        favorite => [
            ['@Str', "Must be string"]
        ]
    ];
    
    my $vc = Validator::Custom::Yours->new;
    my $errors = $vc->validate($hash,$validators)->errors;
    
=head1 CLASS METHOD

=head2 constraints

get constraints
    
    # get
    my $constraints = Validator::Custom::Your->constraints;
    

=head2 add_constraint

You can use this method in custom class.
New validator functions is added.
    
    package Validator::Custom::Yours;
    use base 'Validator::Custom';
    
    __PACKAGE__->add_constraint(
        Int => sub {$_[0] =~ /^\d+$/}
    );

You can merge multiple custom class

    package Validator::Custom::YoursNew;
    use base 'Validator::Custom';
    
    use Validator::Custum::Yours1;
    use Validatro::Cumtum::Yours2;
    
    __PACAKGE__->add_constraint(
        %{Validator::Custom::Yours1->constraints},
        %{Validator::Custom::Yours2->constraints}
    );

=head1 ACCESSORS

=head2 errors

You can get validating errors

    my @errors = $vc->errors;

You can use this method after calling validate

    my @errors = $vc->validate($hash,$validators)->errors;

=head2 error_stock

If you stock error, set 1, or set 0.

Default is 1. 

=head2 validators

You can set validators

    $vc->validators($validators);

=head2 results

You can get converted result if any.

    $vc->results

=head1 METHOD

=head2 new

create instance

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

=head2 validate

validate

    $vc->validate($hash,$validators);

validator format is like the following.

    my $validators = [
        # Function
        key1 => [
            [ \&validator_function1, "Error message1-1"],
            [ \&validator_function2, "Error message1-2"] 
        ],
        
        # Custom Type
        key2 => [
            [ 'CustomType' ,         "Error message2-1"],
        ],
        
        # Array of Custom Type
        key3 => [
            [ '@CustomType',         "Error message3-1"]
        ]
    ];

this method retrun self.

=cut
324
325 - 379
=head1 AUTHOR

Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-validator-custom at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Validator-Custom>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Validator::Custom


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Validator-Custom>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Validator-Custom>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Validator-Custom>

=item * Search CPAN

L<http://search.cpan.org/dist/Validator-Custom/>

=back


=head1 ACKNOWLEDGEMENTS


=head1 COPYRIGHT & LICENSE

Copyright 2009 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
380
3811; # End of Validator::Custom