File Coverage

blib/lib/WebService/MinFraud/Data/Rx/Type/CustomInputs.pm
Criterion Covered Total %
statement 45 48 93.7
branch 8 8 100.0
condition 6 9 66.6
subroutine 13 13 100.0
pod 0 2 0.0
total 72 80 90.0


line stmt bran cond sub pod time code
1             package WebService::MinFraud::Data::Rx::Type::CustomInputs;
2              
3 2     2   32 use 5.010;
  2         6  
4              
5 2     2   10 use strict;
  2         4  
  2         36  
6 2     2   9 use warnings;
  2         5  
  2         40  
7 2     2   9 use namespace::autoclean;
  2         5  
  2         11  
8              
9             our $VERSION = '1.010000';
10              
11 2     2   185 use JSON::MaybeXS qw( is_bool );
  2         4  
  2         99  
12 2     2   13 use Scalar::Util qw( looks_like_number );
  2         4  
  2         90  
13              
14 2     2   13 use parent 'Data::Rx::CommonType::EasyNew';
  2         4  
  2         10  
15              
16 2     2   113 use Role::Tiny::With;
  2         5  
  2         882  
17              
18             with 'WebService::MinFraud::Role::Data::Rx::Type';
19              
20             sub assert_valid {
21 5     5 0 230 my $self = shift;
22 5         10 my $value = shift;
23              
24             return
25 5   66     17 $self->_hash_is_valid($value)
26             && $self->_keys_are_valid($value)
27             && $self->_values_are_valid($value);
28             }
29              
30             sub _hash_is_valid {
31 5     5   9 my $self = shift;
32 5         10 my $value = shift;
33              
34 5 100       27 return 1 if ref $value eq 'HASH';
35              
36 1         7 $self->fail(
37             {
38             error => [qw(type)],
39             message =>
40             'Found invalid custom_inputs value that is not a hashref.',
41             value => $value,
42             }
43             );
44              
45 0         0 return 0;
46             }
47              
48             sub _keys_are_valid {
49 4     4   10 my $self = shift;
50 4         6 my $value = shift;
51              
52 4         8 my @invalid_keys = grep { !/^[a-z0-9_]{1,25}\Z/ } keys %{$value};
  7         119  
  4         15  
53              
54 4 100       33 return 1 unless @invalid_keys;
55              
56 1         19 $self->fail(
57             {
58             error => [qw(type)],
59             message => "Found invalid custom input keys [@invalid_keys].",
60             value => $value,
61             }
62             );
63              
64 0         0 return 0;
65             }
66              
67             sub _values_are_valid {
68 3     3   7 my $self = shift;
69 3         8 my $value = shift;
70              
71             # We can't reliably tell the difference between a string, a boolean, and
72             # a number in Perl. As such, we only do the string check.
73              
74             my @invalid_values
75 6 100 66     137 = grep { ( ref && !is_bool($_) ) || length > 255 || /\n/ }
      66        
76 3         5 values %{$value};
  3         9  
77              
78 3 100       14 return 1 unless @invalid_values;
79              
80 2         21 $self->fail(
81             {
82             error => [qw(type)],
83             message => "Found invalid custom input value [@invalid_values].",
84             value => $value,
85             }
86             );
87              
88 0         0 return 0;
89             }
90              
91             sub type_uri {
92 42     42 0 782 'tag:maxmind.com,MAXMIND:rx/custom_inputs';
93             }
94              
95             1;
96              
97             # ABSTRACT: A type to check for a valid IP address, version 4 or 6
98              
99             __END__
100              
101             =pod
102              
103             =encoding UTF-8
104              
105             =head1 NAME
106              
107             WebService::MinFraud::Data::Rx::Type::CustomInputs - A type to check for a valid IP address, version 4 or 6
108              
109             =head1 VERSION
110              
111             version 1.010000
112              
113             =head1 SUPPORT
114              
115             Bugs may be submitted through L<https://github.com/maxmind/minfraud-api-perl/issues>.
116              
117             =head1 AUTHOR
118              
119             Mateu Hunter <mhunter@maxmind.com>
120              
121             =head1 COPYRIGHT AND LICENSE
122              
123             This software is copyright (c) 2015 - 2020 by MaxMind, Inc.
124              
125             This is free software; you can redistribute it and/or modify it under
126             the same terms as the Perl 5 programming language system itself.
127              
128             =cut