package Brannigan::Validations;
our $VERSION = "0.9";
$VERSION = eval $VERSION;
use strict;
use warnings;
=head1 NAME
Brannigan::Validations - Built-in validation methods for Brannigan.
=head1 VERSION
version 0.9
=head1 DESCRIPTION
This module contains all built-in validation methods provided natively
by the L input validation/parsing system.
=head1 GENERAL PURPOSE VALIDATION METHOD
All these methods receive the value of a parameter, and other values
that explicilty define the requirements. They return a true value if the
parameter's value passed the test, or a false value otherwise.
=head2 required( $value, $boolean )
If C<$boolean> has a true value, this method will check that a required
parameter was indeed provided; otherwise (i.e. if C<$boolean> is not true)
this method will simply return a true value to indicate success.
You should note that if a parameter is required, and a non-true value is
received (i.e. 0 or the empty string ""), this method considers the
requirement as fulfilled (i.e. it will return true). If you need to make sure
your parameters receive true values, take a look at the C validation
method.
Please note that if a parameter is not required and indeed isn't provided
with the input parameters, any other validation methods defined on the
parameter will not be checked.
=cut
sub required {
my ($class, $value, $boolean) = @_;
return if $boolean && !defined $value;
return 1;
}
=head2 forbidden( $value, $boolean )
If C<$boolean> has a true value, this method will check that a forbidden
parameter was indeed NOT provided; otherwise (i.e. if C<$boolean> has a
false value), this method will do nothing and simply return true.
=cut
sub forbidden {
my ($class, $value, $boolean) = @_;
defined $value && $boolean ? return : 1;
}
=head2 is_true( $value, $boolean )
If C<$boolean> has a true value, this method will check that C<$value>
has a true value (so, C<$value> cannot be 0 or the empty string); otherwise
(i.e. if C<$boolean> has a false value), this method does nothing and
simply returns true.
=cut
sub is_true {
my ($class, $value, $boolean) = @_;
$boolean && !$value ? return : 1;
}
=head2 length_between( $value, $min_length, $max_length )
Makes sure the value's length (stringwise) is inside the range of
C<$min_length>-C<$max_length>, or, if the value is an array reference,
makes sure it has between C<$min_length> and C<$max_length> items.
=cut
sub length_between {
my ($class, $value, $min, $max) = @_;
my $length = ref $value eq 'ARRAY' ? @$value : length($value);
$length < $min || $length > $max ? return : 1;
}
=head2 min_length( $value, $min_length )
Makes sure the value's length (stringwise) is at least C<$min_length>, or,
if the value is an array reference, makes sure it has at least C<$min_length>
items.
=cut
sub min_length {
my ($class, $value, $min) = @_;
my $length = ref $value eq 'ARRAY' ? @$value : length($value);
return 1 unless defined $min && $min >= 0;
!$value && $min || $length < $min ? return : 1;
}
=head2 max_length( $value, $max_length )
Makes sure the value's length (stringwise) is no more than C<$max_length>,
or, if the value is an array reference, makes sure it has no more than
C<$max_length> items.
=cut
sub max_length {
my ($class, $value, $max) = @_;
my $length = ref $value eq 'ARRAY' ? @$value : length($value);
$length > $max ? return : 1;
}
=head2 exact_length( $value, $length )
Makes sure the value's length (stringwise) is exactly C<$length>, or,
if the value is an array reference, makes sure it has exactly C<$exact_length>
items.
=cut
sub exact_length {
my ($class, $value, $exlength) = @_;
return unless $value;
my $length = ref $value eq 'ARRAY' ? @$value : length($value);
$length != $exlength ? return : 1;
}
=head2 integer( $value, $boolean )
If boolean is true, makes sure the value is an integer.
=cut
sub integer {
my ($class, $value, $boolean) = @_;
$boolean && $value !~ m/^\d+$/ ? return : 1;
}
=head2 value_between( $value, $min_value, $max_value )
Makes sure the value is between C<$min_value> and C<$max_value>.
=cut
sub value_between {
my ($class, $value, $min, $max) = @_;
!defined($value) || $value < $min || $value > $max ? return : 1;
}
=head2 min_value( $value, $min_value )
Makes sure the value is at least C<$min_value>.
=cut
sub min_value {
my ($class, $value, $min) = @_;
$value < $min ? return : 1;
}
=head2 max_value( $value, $max )
Makes sure the value is no more than C<$max_value>.
=cut
sub max_value {
my ($class, $value, $max) = @_;
$value > $max ? return : 1;
}
=head2 array( $value, $boolean )
If C<$boolean> is true, makes sure the value is actually an array reference.
=cut
sub array {
my ($class, $value, $boolean) = @_;
$boolean ? ref $value eq 'ARRAY' ? 1 : return : ref $value eq 'ARRAY' ? return : 1;
}
=head2 hash( $value, $boolean )
If C<$boolean> is true, makes sure the value is actually a hash reference.
=cut
sub hash {
my ($class, $value, $boolean) = @_;
$boolean ? ref $value eq 'HASH' ? 1 : return : ref $value eq 'HASH' ? return : 1;
}
=head2 one_of( $value, @values )
Makes sure a parameter's value is one of the provided acceptable values.
=cut
sub one_of {
my ($class, $value, @values) = @_;
foreach (@values) {
return 1 if $value eq $_;
}
return;
}
=head2 matches( $value, $regex )
Returns true if C<$value> matches the regular express (C) provided.
Will return false if C<$regex> is not a regular expression.
=cut
sub matches {
my ($class, $value, $regex) = @_;
return unless ref $regex eq 'Regexp';
$value =~ $regex ? 1 : return;
}
=head1 USEFUL PASSPHRASE VALIDATION METHODS
The following validations are useful for passphrase strength validations:
=head2 min_alpha( $value, $integer )
Returns a true value if C<$value> is a string that has at least C<$integer>
alphabetic (C and C) characters.
=cut
sub min_alpha {
my ($class, $value, $integer) = @_;
my @matches = ($value =~ m/[A-Za-z]/g);
scalar @matches >= $integer ? 1 : return;
}
=head2 max_alpha( $value, $integer )
Returns a true value if C<$value> is a string that has at most C<$integer>
alphabetic (C and C) characters.
=cut
sub max_alpha {
my ($class, $value, $integer) = @_;
my @matches = ($value =~ m/[A-Za-z]/g);
scalar @matches <= $integer ? 1 : return;
}
=head2 min_digits( $value, $integer )
Returns a true value if C<$value> is a string that has at least
C<$integer> digits (C<0-9>).
=cut
sub min_digits {
my ($class, $value, $integer) = @_;
my @matches = ($value =~ m/[0-9]/g);
scalar @matches >= $integer ? 1 : return;
}
=head2 max_digits( $value, $integer )
Returns a true value if C<$value> is a string that has at most
C<$integer> digits (C<0-9>).
=cut
sub max_digits {
my ($class, $value, $integer) = @_;
my @matches = ($value =~ m/[0-9]/g);
scalar @matches <= $integer ? 1 : return;
}
=head2 min_signs( $value, $integer )
Returns a true value if C<$value> has at least C<$integer> special or
sign characters (e.g. C<%^&!@#>, or basically anything that isn't C).
=cut
sub min_signs {
my ($class, $value, $integer) = @_;
my @matches = ($value =~ m/[^A-Za-z0-9]/g);
scalar @matches >= $integer ? 1 : return;
}
=head2 max_signs( $value, $integer )
Returns a true value if C<$value> has at most C<$integer> special or
sign characters (e.g. C<%^&!@#>, or basically anything that isn't C).
=cut
sub max_signs {
my ($class, $value, $integer) = @_;
my @matches = ($value =~ m/[^A-Za-z0-9]/g);
scalar @matches <= $integer ? 1 : return;
}
=head2 max_consec( $value, $integer )
Returns a true value if C<$value> does not have a sequence of consecutive
characters longer than C<$integer>. Consequtive characters are either
alphabetic (e.g. C) or numeric (e.g. C<1234>).
=cut
sub max_consec {
my ($class, $value, $integer) = @_;
# the idea here is to break the string intoto an array of characters,
# go over each character in the array, starting at the first one,
# and making sure that character does not begin a sequence longer
# than allowed ($integer). This means we have recursive loops here,
# because for every character, we compare it to the following character
# and while they form a sequence, we move to the next pair and compare
# them until the sequence is broken. To make it a tad faster, our
# outer loop won't go over the entire characters array, but only
# up to the last character that might possibly form an invalid
# sequence. This character would be positioned $integer+1 characters
# from the end.
my @chars = split(//, $value);
for (my $i = 0; $i <= scalar(@chars) - $integer - 1; $i++) {
my $fc = $i; # first character for comparison
my $sc = $i + 1; # second character for comparison
my $sl = 1; # sequence length
while ($sc <= $#chars && ord($chars[$sc]) - ord($chars[$fc]) == 1) {
# characters are in sequence, increase counters
# and compare next pair
$sl++;
$fc++;
$sc++;
}
return if $sl > $integer;
}
return 1;
}
=head2 max_reps( $value, $integer )
Returns a true value if C<$value> does not contain a sequence of a repeated
character longer than C<$integer>. So, for example, if C<$integer> is 3,
then "aaa901" will return true (even though there's a repetition of the
'a' character it is not longer than three), while "9bbbb01" will return
false.
=cut
sub max_reps {
my ($class, $value, $integer) = @_;
# the idea here is pretty much the same as in max_consec but
# we truely compare each pair of characters
my @chars = split(//, $value);
for (my $i = 0; $i <= scalar(@chars) - $integer - 1; $i++) {
my $fc = $i; # first character for comparison
my $sc = $i + 1; # second character for comparison
my $sl = 1; # sequence length
while ($sc <= $#chars && $chars[$sc] eq $chars[$fc]) {
# characters are in sequence, increase counters
# and compare next pair
$sl++;
$fc++;
$sc++;
}
return if $sl > $integer;
}
return 1;
}
=head2 max_dict( $value, $integer, [ \@dict_files ] )
Returns a true value if C<$value> does not contain a dictionary word
longer than C<$integer>. By default, this method will look for the Unix
dict files C, C and C.
You can supply more dictionary files to look for with an array reference
of full paths.
So, for example, if C<$integer> is 3, then "a9dog51" will return true
(even though "dog" is a dictionary word, it is not longer than three),
but "a9punk51" will return false, as "punk" is longer.
WARNING: this method is known to not work properly when used in certain
environments such as C, I'm investigating the issue.
=cut
sub max_dict {
my ($class, $value, $integer, $dict_files) = @_;
# the following code was stolen from the CheckDict function of
# Data::Password by Ariel Brosh (RIP) and Oded S. Resnik
$dict_files ||= [];
unshift(@$dict_files, qw!/usr/dict/words /usr/share/dict/words /usr/share/dict/linux.words!);
foreach (@$dict_files) {
open (DICT, $_) || next;
while (my $dict_line = ) {
chomp $dict_line;
next if length($dict_line) <= $integer;
if (index(lc($value), lc($dict_line)) > -1) {
close(DICT);
return;
}
}
close(DICT);
}
return 1;
}
=head1 SEE ALSO
L, L.
=head1 AUTHOR
Ido Perlmuter, C<< >>
=head1 BUGS
Please report any bugs or feature requests to C, or through
the web interface at L. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Brannigan::Validations
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L
=item * AnnoCPAN: Annotated CPAN documentation
L
=item * CPAN Ratings
L
=item * Search CPAN
L
=back
=head1 LICENSE AND COPYRIGHT
Copyright 2010 Ido Perlmuter.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1;