File Coverage

blib/lib/Brick/Regexes.pm
Criterion Covered Total %
statement 20 22 90.9
branch 1 4 25.0
condition 2 5 40.0
subroutine 6 7 85.7
pod n/a
total 29 38 76.3


line stmt bran cond sub pod time code
1             package Brick::Regexes;
2 5     5   36 use strict;
  5         11  
  5         167  
3              
4 5     5   28 use base qw(Exporter);
  5         11  
  5         459  
5 5     5   31 use vars qw($VERSION);
  5         8  
  5         255  
6              
7             $VERSION = '0.228';
8              
9             package Brick::Bucket;
10 5     5   29 use strict;
  5         10  
  5         166  
11              
12 5     5   28 use Carp qw(croak);
  5         20  
  5         1392  
13              
14             =encoding utf8
15              
16             =head1 NAME
17              
18             Brick - This is the description
19              
20             =head1 SYNOPSIS
21              
22             use Brick::Constraints;
23              
24             =head1 DESCRIPTION
25              
26             See C for the general discussion of constraint
27             creation.
28              
29             =head2 Utilities
30              
31             =over 4
32              
33             =item _matches_regex( HASHREF )
34              
35             Create a code ref to apply a regular expression to the named field.
36              
37             field - the field to apply the regular expression to
38             regex - a reference to a regular expression object ( qr// )
39              
40             =cut
41              
42             sub _matches_regex
43             {
44 2     2   5 my( $bucket, $setup ) = @_;
45              
46 2         15 my @caller = $bucket->__caller_chain_as_list();
47              
48 2 50       4 unless( eval { $setup->{regex}->isa( ref qr// ) } )
  2         19  
49             {
50 0         0 croak( "Argument to $caller[0]{'sub'} must be a regular expression object" );
51             }
52              
53             $bucket->add_to_bucket ( {
54             name => $setup->{name} || $caller[0]{'sub'},
55             description => ( $setup->{description} || "Match a regular expression" ),
56             fields => [ $setup->{field} ],
57             code => sub {
58             die {
59             message => "[$_[0]->{ $setup->{field} }] did not match the pattern",
60             failed_field => $setup->{field},
61             failed_value => $_[0]->{ $setup->{field} },
62             handler => $caller[0]{'sub'},
63 0 0   0     } unless $_[0]->{ $setup->{field} } =~ m/$setup->{regex}/;
64             },
65 2   33     33 } );
      50        
66              
67             }
68              
69             =back
70              
71             =head1 TO DO
72              
73             Regex::Common support
74              
75             =head1 SEE ALSO
76              
77             TBA
78              
79             =head1 SOURCE AVAILABILITY
80              
81             This source is in Github:
82              
83             https://github.com/briandfoy/brick
84              
85             =head1 AUTHOR
86              
87             brian d foy, C<< >>
88              
89             =head1 COPYRIGHT
90              
91             Copyright © 2007-2018, brian d foy . All rights reserved.
92              
93             You may redistribute this under the terms of the Artistic License 2.0.
94              
95             =cut
96              
97             1;