File Coverage

blib/lib/Syccess/Result.pm
Criterion Covered Total %
statement 31 38 81.5
branch 6 12 50.0
condition 2 6 33.3
subroutine 6 6 100.0
pod n/a
total 45 62 72.5


line stmt bran cond sub pod time code
1             package Syccess::Result;
2             our $AUTHORITY = 'cpan:GETTY';
3             # ABSTRACT: A validation process result
4             $Syccess::Result::VERSION = '0.104';
5 9     9   3892 use Moo;
  9         20  
  9         50  
6 9     9   1691 use Module::Runtime qw( use_module );
  9         11  
  9         33  
7              
8             with qw(
9             MooX::Traits
10             );
11              
12             has syccess => (
13             is => 'ro',
14             required => 1,
15             );
16              
17             has params => (
18             is => 'ro',
19             required => 1,
20             );
21              
22             has success => (
23             is => 'lazy',
24             init_arg => undef,
25             );
26              
27             sub _build_success {
28 19     19   12526 my ( $self ) = @_;
29 19 100       269 return $self->error_count ? 0 : 1;
30             }
31              
32             has error_count => (
33             is => 'lazy',
34             init_arg => undef,
35             );
36              
37             sub _build_error_count {
38 19     19   87 my ( $self ) = @_;
39 19         17 return scalar @{$self->errors};
  19         297  
40             }
41              
42             has errors => (
43             is => 'lazy',
44             init_arg => undef,
45             );
46              
47             around errors => sub {
48             my ( $orig, $self, @args ) = @_;
49             my @errors = @{$self->$orig()};
50             return [ @errors ] unless scalar @args > 0;
51             my @args_errors;
52             for my $error (@errors) {
53             for my $arg (@args) {
54             push @args_errors, $error if $error->syccess_field->name eq $arg;
55             }
56             }
57             return [ @args_errors ];
58             };
59              
60             has error_class => (
61             is => 'lazy',
62             init_arg => undef,
63             );
64              
65             sub _build_error_class {
66 11     11   51 my ( $self ) = @_;
67 11         169 my $error_class = use_module($self->syccess->error_class);
68 11 100       137 if ($self->syccess->has_error_traits) {
69 2         2 $error_class = $error_class->with_traits(@{$self->syccess->error_traits});
  2         15  
70             }
71 11         356 return $error_class;
72             }
73              
74             sub _build_errors {
75 19     19   77 my ( $self ) = @_;
76 19         18 my %params = %{$self->params};
  19         83  
77 19         21 my @fields = @{$self->syccess->fields};
  19         255  
78             my %errors_args = $self->syccess->has_errors_args
79 19 50       142 ? (%{$self->syccess->errors_args}) : ();
  0         0  
80 19         17 my @errors;
81 19         22 for my $field (@fields) {
82 43         4306 my @messages = $field->validate( %params );
83 43         60 for my $message (@messages) {
84 22         52 my $ref = ref $message;
85 22 50 66     104 if ($ref eq 'ARRAY' or !ref) {
    0          
86 22         339 push @errors, $self->error_class->new(
87             %errors_args,
88             message => $message,
89             syccess_field => $field,
90             syccess_result => $self,
91             );
92             } elsif ($ref eq 'HASH') {
93 0         0 my %error_args = %{$message};
  0         0  
94 0         0 push @errors, $self->error_class->new(
95             %errors_args,
96             %error_args,
97             syccess_field => $field,
98             syccess_result => $self,
99             );
100             } else {
101 0 0 0     0 if (%errors_args && $message->can('errors_args')) {
102 0         0 $message->errors_args({ %errors_args });
103             }
104 0         0 push @errors, $message;
105             }
106             }
107             }
108 19         3676 return [ @errors ];
109             }
110              
111             1;
112              
113             __END__
114              
115             =pod
116              
117             =head1 NAME
118              
119             Syccess::Result - A validation process result
120              
121             =head1 VERSION
122              
123             version 0.104
124              
125             =head1 DESCRIPTION
126              
127             The result class of I<Syccess> is generated by calling L<Syccess/validate>. The
128             object of this class contains the L<success|/success> of the validation
129             procedure, and if this is false, also the L<Errors|/errors> of it.
130              
131             =head1 METHODS
132              
133             =head2 errors
134              
135             Gives back an ArrayRef of all errors, if no parameter is given. If you give
136             a list of field names as parameters, then you will only get the errors of
137             those specific fields. The errors are given back as L<Syccess::Error>.
138              
139             =head2 error_count
140              
141             Gives back the amount of errors.
142              
143             =head2 success
144              
145             Gives back a Bool value which indicates if the result of the validation was
146             a general success or not, or other said, if there are no errors.
147              
148             =encoding utf8
149              
150             =head1 SUPPORT
151              
152             IRC
153              
154             Join irc.perl.org and msg Getty
155              
156             Repository
157              
158             http://github.com/Getty/p5-syccess
159             Pull request and additional contributors are welcome
160              
161             Issue Tracker
162              
163             http://github.com/Getty/p5-syccess/issues
164              
165             =head1 AUTHOR
166              
167             Torsten Raudssus <torsten@raudss.us>
168              
169             =head1 COPYRIGHT AND LICENSE
170              
171             This software is copyright (c) 2017 by Torsten Raudssus.
172              
173             This is free software; you can redistribute it and/or modify it under
174             the same terms as the Perl 5 programming language system itself.
175              
176             =cut