| File: | blib/lib/Validator/Custom.pm |
| Coverage: | 98.6% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package Validator::Custom; | ||||||
| 2 | 3 3 3 | 0 0 0 | use Object::Simple; | ||||
| 3 | |||||||
| 4 | our $VERSION = '0.0205'; | ||||||
| 5 | |||||||
| 6 | require Carp; | ||||||
| 7 | |||||||
| 8 | ### class method | ||||||
| 9 | |||||||
| 10 | # add validator function | ||||||
| 11 | sub 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 | |||||||
| 21 | sub _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! | ||||||
| 51 | sub 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 | |||||||
| 141 | Object::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 | |||||||
| 381 | 1; # End of Validator::Custom | ||||||