File Coverage

blib/lib/Declare/Constraints/Simple/Library/Referencial.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


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 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;