line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
Declare::Constraints::Simple::Library::Referencial - Ref Constraints |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=cut |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
package Declare::Constraints::Simple::Library::Referencial; |
8
|
12
|
|
|
12
|
|
166
|
use warnings; |
|
12
|
|
|
|
|
25
|
|
|
12
|
|
|
|
|
511
|
|
9
|
12
|
|
|
12
|
|
99
|
use strict; |
|
12
|
|
|
|
|
27
|
|
|
12
|
|
|
|
|
602
|
|
10
|
|
|
|
|
|
|
|
11
|
12
|
|
|
12
|
|
70
|
use Declare::Constraints::Simple-Library; |
|
12
|
|
|
|
|
31
|
|
|
12
|
|
|
|
|
97
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 SYNOPSIS |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# scalar or array references |
16
|
|
|
|
|
|
|
my $scalar_or_array = IsRefType( qw(SCALAR ARRAY) ); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# scalar reference |
19
|
|
|
|
|
|
|
my $int_ref = IsScalarRef( IsInt ); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# accept mappings of ids to objects with "name" methods |
22
|
|
|
|
|
|
|
my $id_obj_map = |
23
|
|
|
|
|
|
|
IsHashRef( -keys => IsInt, |
24
|
|
|
|
|
|
|
-values => And( IsObject, |
25
|
|
|
|
|
|
|
HasMethods('name') )); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# an integer list |
28
|
|
|
|
|
|
|
my $int_list = IsArrayRef( IsInt ); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# accept code references |
31
|
|
|
|
|
|
|
my $is_closure = IsCodeRef; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# accept a regular expression |
34
|
|
|
|
|
|
|
my $is_regex = IsRegex; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 DESCRIPTION |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
This library contains those constraints that can test the validity of |
39
|
|
|
|
|
|
|
references and their types. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=head1 CONSTRAINTS |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head2 IsRefType(@types) |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
Valid if the value is a reference of a kind in C<@types>. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=cut |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
constraint 'IsRefType', |
50
|
|
|
|
|
|
|
sub { |
51
|
|
|
|
|
|
|
my (@types) = @_; |
52
|
|
|
|
|
|
|
return sub { |
53
|
|
|
|
|
|
|
return _false('Undefined Value') unless defined $_[0]; |
54
|
|
|
|
|
|
|
my @match = grep { ref($_[0]) eq $_ } @types; |
55
|
|
|
|
|
|
|
return scalar(@match) |
56
|
|
|
|
|
|
|
? _true |
57
|
|
|
|
|
|
|
: _false('No matching RefType'); |
58
|
|
|
|
|
|
|
}; |
59
|
|
|
|
|
|
|
}; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head2 IsScalarRef($constraint) |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
This is true if the value is a scalar reference. A possible constraint |
64
|
|
|
|
|
|
|
for the scalar references target value can be passed. E.g. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
my $test_integer_ref = IsScalarRef(IsInt); |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=cut |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
constraint 'IsScalarRef', |
71
|
|
|
|
|
|
|
sub { |
72
|
|
|
|
|
|
|
my @vc = @_; |
73
|
|
|
|
|
|
|
return sub { |
74
|
|
|
|
|
|
|
return _false('Undefined Value') unless defined $_[0]; |
75
|
|
|
|
|
|
|
return _false('Not a ScalarRef') |
76
|
|
|
|
|
|
|
unless ref($_[0]) eq 'SCALAR'; |
77
|
|
|
|
|
|
|
return _true unless @vc; |
78
|
|
|
|
|
|
|
my $result = _apply_checks(${$_[0]}, \@vc); |
79
|
|
|
|
|
|
|
return $result unless $result->is_valid; |
80
|
|
|
|
|
|
|
return _true; |
81
|
|
|
|
|
|
|
}; |
82
|
|
|
|
|
|
|
}; |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head2 IsArrayRef($constraint) |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
The value is valid if the value is an array reference. The contents of |
87
|
|
|
|
|
|
|
the array can be validated by passing an other C<$constraint> as |
88
|
|
|
|
|
|
|
argument. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
The stack or path part of C is C where |
91
|
|
|
|
|
|
|
C<$index> is the index of the failing element. |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=cut |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
constraint 'IsArrayRef', |
96
|
|
|
|
|
|
|
sub { |
97
|
|
|
|
|
|
|
my @vc = @_; |
98
|
|
|
|
|
|
|
return sub { |
99
|
|
|
|
|
|
|
return _false('Undefined Value') unless defined $_[0]; |
100
|
|
|
|
|
|
|
return _false('Not an ArrayRef') |
101
|
|
|
|
|
|
|
unless ref($_[0]) eq 'ARRAY'; |
102
|
|
|
|
|
|
|
for (0 .. $#{$_[0]}) { |
103
|
|
|
|
|
|
|
my $result = _apply_checks($_[0][$_], \@vc, $_); |
104
|
|
|
|
|
|
|
return $result unless $result->is_valid; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
return _true; |
107
|
|
|
|
|
|
|
}; |
108
|
|
|
|
|
|
|
}; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head2 IsHashRef(-keys => $constraint, -values => $constraint) |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
True if the value is a hash reference. It can also take two named |
113
|
|
|
|
|
|
|
parameters: C<-keys> can pass a constraint to check the hashes keys, |
114
|
|
|
|
|
|
|
C<-values> does the same for its values. |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
The stack or path part of C looks like |
117
|
|
|
|
|
|
|
C where C<$type> is either C or C |
118
|
|
|
|
|
|
|
depending on what was validated, and C<$key> being the key that didn't |
119
|
|
|
|
|
|
|
pass validation. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=cut |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
constraint 'IsHashRef', |
124
|
|
|
|
|
|
|
sub { |
125
|
|
|
|
|
|
|
my %def = @_; |
126
|
|
|
|
|
|
|
return sub { |
127
|
|
|
|
|
|
|
return _false('Undefined Value') unless defined $_[0]; |
128
|
|
|
|
|
|
|
return _false('Not a HashRef') unless ref($_[0]) eq 'HASH'; |
129
|
|
|
|
|
|
|
if (my $c = $def{'-values'}) { |
130
|
|
|
|
|
|
|
for (keys %{$_[0]}) { |
131
|
|
|
|
|
|
|
my $r = |
132
|
|
|
|
|
|
|
_apply_checks($_[0]{$_}, _listify($c), "val $_"); |
133
|
|
|
|
|
|
|
return $r unless $r->is_valid; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
if (my $c = $def{'-keys'}) { |
137
|
|
|
|
|
|
|
for (keys %{$_[0]}) { |
138
|
|
|
|
|
|
|
my $r = _apply_checks($_, _listify($c), "key $_"); |
139
|
|
|
|
|
|
|
return $r unless $r->is_valid; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
return _true; |
143
|
|
|
|
|
|
|
}; |
144
|
|
|
|
|
|
|
}; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head2 IsCodeRef() |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
Code references have to be valid to pass this constraint. |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=cut |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
constraint 'IsCodeRef', |
153
|
|
|
|
|
|
|
sub { |
154
|
|
|
|
|
|
|
return sub { |
155
|
|
|
|
|
|
|
return _false('Undefined Value') unless defined $_[0]; |
156
|
|
|
|
|
|
|
return _result((ref($_[0]) eq 'CODE'), 'Not a CodeRef'); |
157
|
|
|
|
|
|
|
}; |
158
|
|
|
|
|
|
|
}; |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=head2 IsRegex() |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
True if the value is a regular expression built with C. B |
163
|
|
|
|
|
|
|
however, that a simple string that could be used like C$rx/> will |
164
|
|
|
|
|
|
|
not pass this constraint. You can combine multiple constraints with |
165
|
|
|
|
|
|
|
L though. |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=cut |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
constraint 'IsRegex', |
170
|
|
|
|
|
|
|
sub { |
171
|
|
|
|
|
|
|
return sub { |
172
|
|
|
|
|
|
|
return _false('Undefined Value') unless defined $_[0]; |
173
|
|
|
|
|
|
|
return _result((ref($_[0]) eq 'Regexp'), |
174
|
|
|
|
|
|
|
'Not a Regular Expression'); |
175
|
|
|
|
|
|
|
}; |
176
|
|
|
|
|
|
|
}; |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head1 SEE ALSO |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
L, L |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=head1 AUTHOR |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
Robert 'phaylon' Sedlacek Cphaylon@dunkelheit.atE> |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
This module is free software, you can redistribute it and/or modify it |
189
|
|
|
|
|
|
|
under the same terms as perl itself. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=cut |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
1; |