File Coverage

blib/lib/Brick/Strings.pm
Criterion Covered Total %
statement 12 29 41.3
branch 0 4 0.0
condition 0 6 0.0
subroutine 4 10 40.0
pod n/a
total 16 49 32.6


line stmt bran cond sub pod time code
1             package Brick::Strings;
2 5     5   30 use strict;
  5         30  
  5         251  
3              
4 5     5   26 use base qw(Exporter);
  5         6  
  5         584  
5 5     5   29 use vars qw($VERSION);
  5         8  
  5         336  
6              
7             $VERSION = '0.905';
8              
9             package Brick::Bucket;
10 5     5   26 use strict;
  5         7  
  5         2393  
11              
12             =encoding utf8
13              
14             =head1 NAME
15              
16             Brick::General - constraints for domain-nonspecific stuff
17              
18             =head1 SYNOPSIS
19              
20             use Brick;
21              
22             =head1 DESCRIPTION
23              
24             =over 4
25              
26             =item $bucket->value_length_is_exactly( HASHREF )
27              
28             exact_length
29              
30             =cut
31              
32             sub _value_length_is_exactly {
33 0     0     my( $bucket, $setup ) = @_;
34              
35 0           $setup->{minimum_length} = $setup->{exact_length};
36 0           $setup->{maximum_length} = $setup->{exact_length};
37              
38 0           $bucket->_value_length_is_between( $setup );
39             }
40              
41             =item $bucket->value_length_is_greater_than( HASHREF )
42              
43             minimum_length
44              
45             =cut
46              
47             sub _value_length_is_equal_to_greater_than {
48 0     0     my( $bucket, $setup ) = @_;
49              
50 0           my @caller = $bucket->__caller_chain_as_list();
51              
52              
53             $bucket->add_to_bucket( {
54             name => $setup->{name} || $caller[0]{'sub'},
55             description => "Length must be $setup->{minimum_length} or more characters",
56             code => sub {
57             die {
58             message => "[$_[0]->{ $setup->{field} }] isn't $setup->{minimum_length} or more characters",
59             handler => $caller[0]{'sub'},
60             failed_field => $setup->{field},
61             failed_value => $_[0]->{ $setup->{field} },
62             } unless $setup->{minimum_length} <= length( $_[0]->{ $setup->{field} } )
63 0 0   0     },
64 0   0       } );
65             }
66              
67             =item $bucket->value_length_is_less_than( HASHREF )
68              
69             maximum_length
70              
71             =cut
72              
73             sub _value_length_is_equal_to_less_than {
74 0     0     my( $bucket, $setup ) = @_;
75              
76 0           my @caller = $bucket->__caller_chain_as_list();
77              
78             $bucket->add_to_bucket( {
79             name => $setup->{name} || $caller[0]{'sub'},
80             description => "Length must be $setup->{maximum_length} or fewer characters",
81             code => sub {
82             die {
83             message => "[$_[0]->{ $setup->{field} }] isn't $setup->{maximum_length} or fewer characters",
84             handler => $caller[0]{'sub'},
85             failed_field => $setup->{field},
86             failed_value => $_[0]->{ $setup->{field} },
87             } unless length( $_[0]->{ $setup->{field} } ) <= $setup->{maximum_length}
88 0 0   0     },
89 0   0       } );
90             }
91              
92             =item $bucket->value_length_is_between( HASHREF )
93              
94             minimum_length
95             maximum_length
96              
97             =cut
98              
99             sub _value_length_is_between {
100 0     0     my( $bucket, $setup ) = @_;
101              
102 0           local $setup->{name} = '';
103              
104 0           my $min = $bucket->_value_length_is_equal_to_greater_than( $setup );
105              
106 0           my $max = $bucket->_value_length_is_equal_to_less_than( $setup );
107              
108 0           my $composed = $bucket->__compose_satisfy_all( $min, $max );
109             }
110              
111             =back
112              
113             =head1 TO DO
114              
115             TBA
116              
117             =head1 SEE ALSO
118              
119             TBA
120              
121             =head1 SOURCE AVAILABILITY
122              
123             This source is in Github:
124              
125             https://github.com/briandfoy/brick
126              
127             =head1 AUTHOR
128              
129             brian d foy, C<< >>
130              
131             =head1 COPYRIGHT
132              
133             Copyright © 2007-2026, brian d foy . All rights reserved.
134              
135             You may redistribute this under the terms of the Artistic License 2.0.
136              
137             =cut
138              
139             1;