1use strict;
2
3package HTML::FormFu::Constraint::Regex;
4$HTML::FormFu::Constraint::Regex::VERSION = '2.07';
5# ABSTRACT: Regex Constraint
6
7use Moose;
8use MooseX::Attribute::Chained;
9extends 'HTML::FormFu::Constraint';
10
11use Regexp::Common;
12
13has common   => ( is => 'rw', traits => ['Chained'] );
14has regex    => ( is => 'rw', traits => ['Chained'] );
15has anchored => ( is => 'rw', traits => ['Chained'] );
16
17sub constrain_value {
18    my ( $self, $value ) = @_;
19
20    return 1 if !defined $value || $value eq '';
21
22    my $regex;
23
24    if ( defined $self->regex ) {
25        $regex = $self->regex;
26    }
27    elsif ( defined $self->common ) {
28        my @common
29            = ref $self->common
30            ? @{ $self->common }
31            : $self->common;
32
33        $regex = shift @common;
34        $regex = $RE{$regex};
35
36        for (@common) {
37            $regex = $regex->{ ref $_ ? join( $;, %$_ ) : $_ };
38        }
39    }
40    else {
41        $regex = qr/.*/;
42    }
43
44    if ( $self->anchored ) {
45        $regex = qr{^$regex\z};
46    }
47
48    my $ok = $value =~ $regex;
49
50    return $self->not ? !$ok : $ok;
51}
52
53__PACKAGE__->meta->make_immutable;
54
551;
56
57__END__
58
59=pod
60
61=encoding UTF-8
62
63=head1 NAME
64
65HTML::FormFu::Constraint::Regex - Regex Constraint
66
67=head1 VERSION
68
69version 2.07
70
71=head1 DESCRIPTION
72
73Regular expression-based constraint.
74
75=head1 METHODS
76
77=head2 regex
78
79Arguments: $regex. In a config file, enclose the regex in a string, like this: C<regex: '^[-_+=!\w\d]*\z'>.
80
81Arguments: $string
82
83=head2 common
84
85Arguments: \@parts
86
87Used to build a L<Regexp::Common> regex.
88
89The following definition is equivalent to
90C<< $RE{URI}{HTTP}{-scheme => 'https?'} >>
91
92    type: Regex
93    common:
94      - URI
95      - HTTP
96      - { '-scheme': 'https?' }
97
98=-head2 anchored
99
100Arguments: bool
101
102If true, uses C<^> and C<\z> to anchor the L</regex> or L</common>
103to the start and end of the submitted value.
104
105=head1 SEE ALSO
106
107Is a sub-class of, and inherits methods from L<HTML::FormFu::Constraint>
108
109L<HTML::FormFu>
110
111=head1 AUTHOR
112
113Carl Franks C<cfranks@cpan.org>
114
115Based on the original source code of L<HTML::Widget::Constraint::Regex>, by
116Sebastian Riedel, C<sri@oook.de>.
117
118=head1 LICENSE
119
120This library is free software, you can redistribute it and/or modify it under
121the same terms as Perl itself.
122
123=head1 AUTHOR
124
125Carl Franks <cpan@fireartist.com>
126
127=head1 COPYRIGHT AND LICENSE
128
129This software is copyright (c) 2018 by Carl Franks.
130
131This is free software; you can redistribute it and/or modify it under
132the same terms as the Perl 5 programming language system itself.
133
134=cut
135