File Coverage

blib/lib/Declare/Constraints/Simple/Library/General.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::General - General Constraints
4              
5             =cut
6              
7             package Declare::Constraints::Simple::Library::General;
8 12     12   92 use warnings;
  12         24  
  12         513  
9 12     12   64 use strict;
  12         25  
  12         468  
10              
11 12     12   65 use Declare::Constraints::Simple-Library;
  12         22  
  12         137  
12              
13 12     12   68 use Carp::Clan qw(^Declare::Constraints::Simple);
  12         18  
  12         100  
14              
15             =head1 SYNOPSIS
16              
17             # custom error messages
18             my $constraint =
19             And( Message( 'You need to specify a Value', IsDefined ),
20             Message( 'The specified Value is not an Int', IsInt ));
21              
22             # build results
23             my $valid = ReturnTrue;
24             my $invalid = ReturnFalse('Just because');
25              
26             =head1 DESCRIPTION
27              
28             This library is meant to contain those constraints and constraint-like
29             elements that apply generally to the whole framework.
30              
31             =head1 CONSTRAINTS
32              
33             =head2 Message($message, $constraint)
34              
35             Overrides the C set on the result object for failures in
36             C<$constraint>. For example:
37              
38             my $message = 'How hard is it to give me a number?';
39             my $constraint = Message($message, IsNumber);
40              
41             my $result = $constraint->('duh...');
42             print $result->message, "\n";
43              
44             The C constraint overrides the error message returned by it's
45             whole subtree, however, the C specification nearest to the point
46             of failure will win. So while this
47              
48             my $constraint = Message( 'Foo',
49             IsArrayRef( Message( 'Bar', IsInt )));
50              
51             my $result = $constraint->(['I am not an Integer']);
52             print $result->message;
53              
54             will print C, this
55              
56             my $result = $constraint->('I\'m not even an ArrayRef');
57             print $result->message;
58              
59             will output C.
60              
61             =cut
62              
63             constraint 'Message',
64             sub {
65             my ($msg, $c) = @_;
66             return sub {
67             return _with_message($msg, $c, @_);
68             };
69             };
70              
71             =head2 Scope($name, $constraint)
72              
73             Executes the passed C<$constraint> in a newly generated scope named
74             C<$name>.
75              
76             =cut
77              
78             constraint 'Scope',
79             sub {
80             my ($scope_name, $constraint) = @_;
81             return sub {
82             return _with_scope($scope_name, $constraint, @_);
83             };
84             };
85              
86             =head2 SetResult($scope, $name, $constraint)
87              
88             Stores the result ov an evaluation of C<$constraint> in C<$scope> under
89             C<$name>.
90              
91             =cut
92              
93             constraint 'SetResult',
94             sub {
95             my ($scope, $name, $constraint) = @_;
96             return sub {
97             my $result = $constraint->(@_);
98             _set_result($scope, $name, $result);
99             return $result;
100             };
101             };
102              
103             =head2 IsValid($scope, $name)
104              
105             Returns a true result if the result C<$name>, which has to have been stored
106             previously in the scope named C<$scope>, was valid.
107              
108             =cut
109              
110             constraint 'IsValid',
111             sub {
112             my ($scope, $name) = @_;
113             return sub {
114             _info("$scope:$name");
115             return _false unless _has_result($scope, $name);
116             my $result = _get_result($scope, $name);
117             return _result($result,
118             "Value '$name' in scope '$scope' is invalid");
119             };
120             };
121              
122             =head2 ReturnTrue()
123              
124             Returns a true result.
125              
126             =cut
127              
128             constraint 'ReturnTrue',
129             sub { return sub { _true } };
130              
131             =head2 ReturnFalse($msg)
132              
133             Returns a false result containing C<$msg> as error message.
134              
135             =cut
136              
137             constraint 'ReturnFalse',
138             sub { my $msg = shift; return sub { _false($msg) } };
139              
140             =head1 SEE ALSO
141              
142             L, L
143              
144             =head1 AUTHOR
145              
146             Robert 'phaylon' Sedlacek Cphaylon@dunkelheit.atE>
147              
148             =head1 LICENSE AND COPYRIGHT
149              
150             This module is free software, you can redistribute it and/or modify it
151             under the same terms as perl itself.
152              
153             =cut
154              
155             1;