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