File Coverage

blib/lib/Declare/Constraints/Simple/Library/Scalar.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Declare::Constraints::Simple::Library::Scalar - Scalar Constraints
4              
5             =cut
6              
7             package Declare::Constraints::Simple::Library::Scalar;
8 12     12   90 use warnings;
  12         23  
  12         419  
9 12     12   63 use strict;
  12         23  
  12         602  
10              
11 12     12   66 use Declare::Constraints::Simple-Library;
  12         95  
  12         99  
12              
13 12     12   73 use Carp::Clan qw(^Declare::Constraints::Simple);
  12         25  
  12         83  
14              
15             =head1 SYNOPSIS
16              
17             # match one of a set of regexes
18             my $some_regexes = Matches(qr/foo/, qr/bar/);
19              
20             # allow only defined values
21             my $is_defined = IsDefined;
22              
23             # between 5 and 50 chars
24             my $five_to_fifty = HasLength(5, 50);
25              
26             # match against a set of values
27             my $command_constraint = IsOneOf(qw(create update delete));
28              
29             # check for trueness
30             my $is_true = IsTrue;
31              
32             # simple equality
33             my $is_foo = IsEq('foo');
34              
35             =head1 DESCRIPTION
36              
37             This library contains all constraints to validate scalar values.
38              
39             =head1 CONSTRAINTS
40              
41             =head2 Matches(@regex)
42              
43             my $c = Matches(qr/foo/, qr/bar/);
44              
45             If one of the parameters matches the expression, this is true.
46              
47             =cut
48              
49             constraint 'Matches',
50             sub {
51             my @rx = @_;
52             croak 'Matches needs at least one Regexp as argument'
53             unless @rx;
54             for (@rx) {
55             croak 'Matches only takes Regexps as arguments'
56             unless ref($_) eq 'Regexp';
57             }
58             return sub {
59             return _false('Undefined Value') unless defined $_[0];
60             for (@rx) {
61             return _true if $_[0] =~ /$_/;
62             }
63             return _false('Regex does not match');
64             };
65             };
66              
67             =head2 IsDefined()
68              
69             True if the value is defined.
70              
71             =cut
72              
73             constraint 'IsDefined',
74             sub {
75             return sub {
76             return _result((defined($_[0]) ? 1 : 0), 'Undefined Value');
77             };
78             };
79              
80             =head2 HasLength([$min, [$max]])
81              
82             Is true if the value has a length above C<$min> (which defaults to 1> and,
83             if supplied, under the value of C<$max>. A simple
84              
85             my $c = HasLength;
86              
87             checks if the value has a length of at least 1.
88              
89             =cut
90              
91             constraint 'HasLength',
92             sub {
93             my ($min, $max) = @_;
94             $min = 1 unless defined $min;
95             $max = 0 unless defined $max;
96             return sub {
97             my ($val) = @_;
98             return _false('Undefined Value') unless defined $val;
99             return _false('Value too short') unless $min <= length($val);
100             return _true unless $max;
101             return _result(((length($val) <= $max) ? 1 : 0),
102             'Value too long');
103             };
104             };
105              
106             =head2 IsOneOf(@values)
107              
108             True if one of the C<@values> equals the passed value. C values
109             work with this too, so
110              
111             my $c = IsOneOf(1, 2, undef);
112              
113             will return true on an undefined value.
114              
115             =cut
116              
117             constraint 'IsOneOf',
118             sub {
119             my @vals = @_;
120             return sub {
121             for (@vals) {
122             unless (defined $_) {
123             return _true unless defined $_[0];
124             next;
125             }
126             next unless defined $_[0];
127             return _true if $_[0] eq $_;
128             }
129             return _false('No Value matches');
130             };
131             };
132              
133             =head2 IsTrue()
134              
135             True if the value evulates to true in boolean context.
136              
137             =cut
138              
139             constraint 'IsTrue',
140             sub {
141             return sub { $_[0] ? _true : _false('Value evaluates to False') };
142             };
143              
144             =head2 IsEq($comparator)
145              
146             Valid if the value is C the C<$comparator>.
147              
148             =cut
149              
150             constraint 'IsEq',
151             sub {
152             my ($compare) = @_;
153             return sub {
154             return _result(
155             ($compare eq $_[0]),
156             "'$_[0]' does not equal '$compare'"
157             );
158             };
159             };
160              
161             =head1 SEE ALSO
162              
163             L, L
164              
165             =head1 AUTHOR
166              
167             Robert 'phaylon' Sedlacek Cphaylon@dunkelheit.atE>
168              
169             =head1 LICENSE AND COPYRIGHT
170              
171             This module is free software, you can redistribute it and/or modify it
172             under the same terms as perl itself.
173              
174             =cut
175              
176             1;