File Coverage

blib/lib/App/Spec/Run/Validator.pm
Criterion Covered Total %
statement 106 128 82.8
branch 69 86 80.2
condition 23 32 71.8
subroutine 10 10 100.0
pod 1 1 100.0
total 209 257 81.3


line stmt bran cond sub pod time code
1             # ABSTRACT: Processes and validates options and parameters
2 4     4   25 use strict;
  4         8  
  4         112  
3 4     4   18 use warnings;
  4         6  
  4         196  
4             package App::Spec::Run::Validator;
5              
6             our $VERSION = '0.013'; # VERSION;
7              
8 4     4   23 use List::Util qw/ any /;
  4         9  
  4         361  
9 4     4   2319 use List::MoreUtils qw/ uniq /;
  4         49864  
  4         24  
10 4     4   4208 use Ref::Util qw/ is_arrayref is_hashref /;
  4         8  
  4         247  
11 4     4   1055 use Moo;
  4         22495  
  4         21  
12              
13             has options => ( is => 'ro' );
14             has option_specs => ( is => 'ro' );
15             has parameters => ( is => 'ro' );
16             has param_specs => ( is => 'ro' );
17              
18             my %validate = (
19             string => sub { length($_[0]) > 0 },
20             file => sub { $_[0] eq '-' or -f $_[0] },
21             filename => sub { 1 },
22             dir => sub { -d $_[0] },
23             dirname => sub { 1 },
24             integer => sub { $_[0] =~ m/^[+-]?\d+$/ },
25             float => sub { $_[0] =~ m/^[+-]?\d+(?:\.\d+)?$/ },
26             flag => sub { 1 },
27             enum => sub {
28             my ($value, $list) = @_;
29             any { $value eq $_ } @$list;
30             },
31             );
32              
33             sub process {
34 27     27 1 135 my ($self, $run, $errs) = @_;
35 27         136 my ($ok) = $self->_process( $errs, type => "parameters", app => $run );
36 27   100     135 $ok &&= $self->_process( $errs, type => "options", app => $run );
37 27         88 return $ok;
38             }
39              
40             sub _process {
41 44     44   159 my ($self, $errs, %args) = @_;
42 44         93 my $run = $args{app};
43 44         82 my $type = $args{type};
44 44         105 my ($items, $specs);
45 44 100       130 if ($args{type} eq "parameters") {
46 27         97 $items = $self->parameters;
47 27         121 $specs = $self->param_specs;
48             }
49             else {
50 17         67 $items = $self->options;
51 17         50 $specs = $self->option_specs;
52             }
53              
54             # TODO: iterate over parameters in original cmdline order
55 44         249 for my $name (sort keys %$specs) {
56 118         250 my $spec = $specs->{ $name };
57 118         198 my $value = $items->{ $name };
58 118         250 my $param_type = $spec->type;
59 118         248 my $enum = $spec->enum;
60              
61 118 100       325 if ($spec->type eq "flag") {
62 43 100       137 if ($spec->multiple) {
63 16 50 66     86 if (defined $value and $value !~ m/^\d+$/) {
64 0         0 die "Value for '$name': '$value' shouldn't happen";
65             }
66             }
67             else {
68 27 50 66     111 if (defined $value and $value != 1) {
69 0         0 die "Value for '$name': '$value' shouldn't happen";
70             }
71             }
72 43         81 next;
73             }
74              
75 75         1222 my $values;
76 75 100 100     458 if ($spec->multiple and $spec->mapping) {
    100          
77 5 50       28 if (not defined $value) {
78 0         0 $items->{ $name } = $value = {};
79             }
80 5         12 $values = $value;
81              
82 5 50       24 if (not keys %$values) {
83 0 0       0 if (defined (my $default = $spec->default)) {
84 0         0 $values = { split m/=/, $default, 2 };
85 0         0 $items->{ $name } = $values;
86             }
87             }
88              
89 5 50 33     31 if (not keys %$values and $spec->required) {
90 0         0 $errs->{ $type }->{ $name } = "missing";
91 0         0 next;
92             }
93              
94 5 50       21 if (not keys %$values) {
95 0         0 next;
96             }
97              
98             }
99             elsif ($spec->multiple) {
100 10 50       35 if (not defined $value) {
101 0         0 $items->{ $name } = $value = [];
102             }
103 10         22 $values = $value;
104              
105 10 100       29 if (not @$values) {
106 6 50       28 if (defined (my $default = $spec->default)) {
107 0         0 $values = [ $default ];
108 0         0 $items->{ $name } = $values;
109             }
110             }
111              
112 10 100 66     47 if ( not @$values and $spec->required) {
113 6         20 $errs->{ $type }->{ $name } = "missing";
114 6         17 next;
115             }
116              
117 4 50       14 if (not @$values) {
118 0         0 next;
119             }
120              
121 4 100 66     65 if ($spec->unique and (uniq @$values) != @$values) {
122 1         4 $errs->{ $type }->{ $name } = "not_unique";
123 1         5 next;
124             }
125              
126             }
127             else {
128              
129 60 100       174 if (not defined $value) {
130 33 50       127 if (defined (my $default = $spec->default)) {
131 0         0 $value = $default;
132 0         0 $items->{ $name } = $value;
133             }
134             }
135              
136 60 100 100     234 if ( not defined $value and $spec->required) {
137 4         14 $errs->{ $type }->{ $name } = "missing";
138 4         12 next;
139             }
140              
141 56 100       155 if (not defined $value) {
142 29         56 next;
143             }
144              
145 27         65 $values = [ $value ];
146             }
147              
148 35         93 my $def;
149 35 50       106 if (ref $param_type eq 'HASH') {
150 0         0 ($param_type, $def) = %$param_type;
151             }
152 35 50       149 my $code = $validate{ $param_type }
153             or die "Missing method for validation type $param_type";
154              
155 35 100       117 my $possible_values = $spec->mapping ? {} : [];
156 35 100       138 if (my $spec_values = $spec->values) {
157 22 100       79 if (my $op = $spec_values->{op}) {
    50          
158 17         55 my $args = {
159             runmode => "validation",
160             parameter => $name,
161             };
162 17   100     131 $possible_values = $run->cmd->$op($run, $args) || [];
163             }
164             elsif ($spec->mapping) {
165 5         21 $possible_values = $spec_values->{mapping};
166             }
167             else {
168 0         0 $possible_values = $values->{enum};
169             }
170             }
171              
172             my @to_check = $spec->mapping
173 35 100       937 ? map { [ $_ => $values->{ $_ } ] } keys %$values
  6         33  
174             : @$values;
175 35         92 for my $item (@to_check) {
176 37         77 my ($key, $v);
177 37 100       91 if ($spec->mapping) {
178 6         21 ($key, $v) = @$item;
179             }
180             else {
181 31         60 $v = $item;
182             }
183             # check type validity
184 37         105 my $ok = $code->($v, $def);
185 37 100       98 unless ($ok) {
186 3         18 $errs->{ $type }->{ $name } = "invalid $param_type";
187             }
188             # check static enums
189 37 100       135 if ($enum) {
190             my $code = $validate{enum}
191 7 50       26 or die "Missing method for validation type enum";
192 7         20 my $ok = $code->($v, $enum);
193 7 100       37 unless ($ok) {
194 1         4 $errs->{ $type }->{ $name } = "invalid enum";
195             }
196             }
197 37 50 33     129 if ($param_type eq 'file' and $v eq '-') {
198 0         0 $v = do { local $/; my $t = ; \$t };
  0         0  
  0         0  
  0         0  
199             # TODO does not work for multiple
200 0         0 $items->{ $name } = $v;
201             }
202              
203 37 100 66     233 if ($spec->mapping and keys %$possible_values) {
    100          
204 6         12 my $ok = 0;
205 6 100       26 if (exists $possible_values->{ $key }) {
206 3 100       11 if (my $list = $possible_values->{ $key }) {
207 2     2   12 $ok = any { $_ eq $v } @$list;
  2         6  
208             }
209             else {
210             # can have any value
211 1         3 $ok = 1;
212             }
213             }
214 6 100       28 unless ($ok) {
215 3         16 $errs->{ $type }->{ $name } = "invalid value";
216             }
217             }
218             elsif (@$possible_values) {
219             my $ok = any {
220 21 100   21   65 is_hashref($_) ? $_->{name} eq $v : $_ eq $v
221 15         82 } @$possible_values;
222 15 100       115 unless ($ok) {
223 2         12 $errs->{ $type }->{ $name } = "invalid value";
224             }
225             }
226             }
227             }
228 44 100       240 return (keys %$errs) ? 0 : 1;
229             }
230              
231             1;
232              
233             __END__