package HTML::FormFu::Constraint::Regex; use strict; use base 'HTML::FormFu::Constraint'; use Regexp::Common; __PACKAGE__->mk_accessors(qw/ regex common /); sub constrain_value { my ( $self, $value ) = @_; return 1 if !defined $value || $value eq ''; my $regex; if ( defined $self->regex ) { $regex = $self->regex; } elsif ( defined $self->common ) { my @common = ref $self->common ? @{ $self->common } : ( $self->common ); $regex = shift @common; $regex = $RE{$regex}; for (@common) { $regex = $regex->{ ref $_ ? join( $;, %$_ ) : $_ }; } } else { $regex = qr/.*/; } my $ok = $value =~ $regex; return $self->not ? !$ok : $ok; } 1; __END__ =head1 NAME HTML::FormFu::Constraint::Regex - Regex Constraint =head1 DESCRIPTION Regular expression-based constraint. =head1 METHODS =head2 regex Arguments: $regex Arguments: $string =head2 common Arguments: \@parts Used to build a L regex. The following definition is equivalent to C<< $RE{URI}{HTTP}{-scheme => 'https?'} >> type: Regex common: - URI - HTTP - { '-scheme': 'https?' } =head1 SEE ALSO Is a sub-class of, and inherits methods from L L =head1 AUTHOR Carl Franks C Based on the original source code of L, by Sebastian Riedel, C. =head1 LICENSE This library is free software, you can redistribute it and/or modify it under the same terms as Perl itself.