File Coverage

blib/lib/Syccess/Validator/Call.pm
Criterion Covered Total %
statement 17 17 100.0
branch 10 12 83.3
condition 12 15 80.0
subroutine 5 5 100.0
pod 0 2 0.0
total 44 51 86.2


line stmt bran cond sub pod time code
1             package Syccess::Validator::Call;
2             our $AUTHORITY = 'cpan:GETTY';
3             # ABSTRACT: A validator to check via call to a method
4             $Syccess::Validator::Call::VERSION = '0.104';
5 2     2   2331 use Moo;
  2         3  
  2         8  
6 2     2   350 use Carp qw( croak );
  2         3  
  2         387  
7              
8             with qw(
9             Syccess::ValidatorSimple
10             );
11              
12             has not => (
13             is => 'ro',
14             predicate => 1,
15             );
16              
17             sub BUILD {
18 3     3 0 992 my ( $self ) = @_;
19 3 50 66     16 croak __PACKAGE__.' cant have arg and not'
20             if $self->has_arg and $self->has_not;
21 3 50 66     26 croak __PACKAGE__.' requires arg or not'
22             unless $self->has_arg or $self->has_not;
23             }
24              
25             has message => (
26             is => 'lazy',
27             );
28              
29             sub _build_message {
30 2     2   15 return 'Your value for %s is not valid.';
31             }
32              
33             sub validator {
34 6     6 0 5 my ( $self, $value ) = @_;
35             # probably making function() possible, don't know yet how, as the
36             # function will be not available in my scope probably, and calling
37             # on main:: doesnt sound much of a "functionality"
38 6 100       5 my ( $thing, $method ) = @{$self->has_arg ? $self->arg : $self->not};
  6         16  
39 6 100       9 my $not = $self->has_not ? 1 : 0;
40 6 100       15 my $return = $thing->$method($value) ? 1 : 0;
41 6 100 100     52 return if ( $return and !$not ) or ( !$return and $not );
      100        
      66        
42 3         45 return $self->message;
43             }
44              
45             1;
46              
47             __END__
48              
49             =pod
50              
51             =head1 NAME
52              
53             Syccess::Validator::Call - A validator to check via call to a method
54              
55             =head1 VERSION
56              
57             version 0.104
58              
59             =head1 SYNOPSIS
60              
61             Syccess->new(
62             fields => [
63             foo => [ call => [ $thing, 'whitelisted' ] ],
64             baz => [ call => { not => [ $thing, 'blacklisted' ] } ],
65             bar => [ call => {
66             not => [ $thing, 'blacklisted' ],
67             message => 'You have 5 seconds to comply.'
68             } ],
69             ],
70             );
71              
72             =head1 DESCRIPTION
73              
74             This validator allows checking against a method call on an object. If used
75             with the B<not> parameter, it will see success if the called method gives back
76             a B<false> value, else it will succeed on a B<true> value.
77              
78             =head1 ATTRIBUTES
79              
80             =head2 message
81              
82             This contains the error message or the format for the error message
83             generation. See L<Syccess::Error/validator_message>.
84              
85             =encoding utf8
86              
87             =head1 SUPPORT
88              
89             IRC
90              
91             Join irc.perl.org and msg Getty
92              
93             Repository
94              
95             http://github.com/Getty/p5-syccess
96             Pull request and additional contributors are welcome
97              
98             Issue Tracker
99              
100             http://github.com/Getty/p5-syccess/issues
101              
102             =head1 AUTHOR
103              
104             Torsten Raudssus <torsten@raudss.us>
105              
106             =head1 COPYRIGHT AND LICENSE
107              
108             This software is copyright (c) 2017 by Torsten Raudssus.
109              
110             This is free software; you can redistribute it and/or modify it under
111             the same terms as the Perl 5 programming language system itself.
112              
113             =cut