File Coverage

blib/lib/Data/FormValidator/Filters.pm

Criterion	Covered	Total	%
statement	78	89	87.6
branch	30	36	83.3
condition	1	2	50.0
subroutine	23	24	95.8
pod	2	19	10.5
total	134	170	78.8

#    Filters.pm - Common filters for use in Data::FormValidator.
#    This file is part of Data::FormValidator.
#
#    Author: Francis J. Lacoste
#    Maintainer: Mark Stosberg
#
#    Copyright (C) 1999,2000 iNsu Innovations Inc.
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms same terms as perl itself.

package Data::FormValidator::Filters;
use Exporter 'import';
use strict;

our $VERSION = 4.86;

our @EXPORT_OK = qw(
    filter_alphanum
    filter_decimal
    filter_digit
    filter_dollars
    filter_integer
    filter_lc
    filter_neg_decimal
    filter_neg_integer
    filter_phone
    filter_pos_decimal
    filter_pos_integer
    filter_quotemeta
    filter_sql_wildcard
    filter_strip
    filter_trim
    filter_uc
    filter_ucfirst
    FV_split
    FV_replace
);

our %EXPORT_TAGS = (
    filters => \@EXPORT_OK,
);

sub DESTROY {}

=pod

=head1 NAME

Data::FormValidator::Filters - Basic set of filters available in an Data::FormValidator profile.

=head1 SYNOPSIS

    use Data::FormValidator;

    %profile = (
        filters => 'trim',
        ...
    );

    my $results = Data::FormValidator->check(  \%data, \%profile );

=head1 DESCRIPTION

These are the builtin filters which may be specified as a name in the
I, I, and I parameters of the
input profile.

Filters are applied as the first step of validation, possibly modifying a copy
of the validation before any constraints are checked.

=head1 RECOMMENDED USE

As a long time maintainer and user of Data::FormValidator, I recommend that
filters be used with caution. They are immediately modifying the input
provided, so the original data is lost. The few I recommend include C,
which removes leading and trailing whitespace. I have this turned on by default
by using L. It's also generally safe to use
the C and C filters if you need that kind of data transformation.

Beyond simple filters, I recommend transforming the C<"valid"> hash returned
from validation if further changes are needed.

=head1 PROCEDURAL INTERFACE

You may also call these functions directly through the
procedural interface by either importing them directly or importing the whole
I<:filters> group. For example, if you want to access the I function
directly, you could either do:

    use Data::FormValidator::Filters (qw/filter_trim/);
    # or
    use Data::FormValidator::Filters (qw/:filters/);

    $string = filter_trim($string);

Notice that when you call filters directly, you'll need to prefix the filter name with
"filter_".

=head1 THE FILTERS

=head2 FV_split

  use Data::FormValidator::Filters qw(FV_split);

  # Validate every e-mail in a comma separated list

  field_filters => {
     several_emails  => FV_split(qr/\s*,\s*/),

     # Any pattern that can be used by the 'split' builtin works.
     tab_sep_field   => FV_split('\t'),
  },
  constraint_methods => {
    several_emails => email(),
  },

With this filter, you can split a field into multiple values. The constraint for
the field will then be applied to every value.

This filter has a different naming convention because it is a higher-order
function.  Rather than returning a value directly, it returns a code reference
to a standard Data::FormValidator filter.

After successfully being validated the values will appear as an arrayref.

=cut

sub FV_split {
    my $splitter = shift || die "nothing to split on!";
    return sub {
        my $value = shift;
        return undef unless defined $value;
        my @a = split $splitter, $value;
        return \@a;
    };
}

=head2 FV_replace

  use Data::FormValidator::Filters qw(FV_replace);

  field_filters => {
     first_name   => FV_replace(qr/Mark/,'Don'),
  },

FV_replace is a shorthand for writing simple find-and-replace filters.
The above filter would be translated to this:

 sub { my $v = shift; $v =~ s/Mark/Don/; $v }

For more complex filters, just write your own.

=cut

sub FV_replace {
    my ($find,$replace) = @_;
    return sub {
        my $v = shift;
        $v =~ s/$find/$replace/;
        return $v;
    };
}

=head2 trim

Remove white space at the front and end of the fields.

=cut

sub filter_trim {
    my $value = shift;
    return unless defined $value;

    # Remove whitespace at the front
    $value =~ s/^\s+//o;

    # Remove whitespace at the end
    $value =~ s/\s+$//o;

    return $value;
}

=pod

=head2 strip

Runs of white space are replaced by a single space.

=cut

sub filter_strip {
    my $value = shift;
    return unless defined $value;

    # Strip whitespace
    $value =~ s/\s+/ /g;

    return $value;
}

=pod

=head2 digit

Remove non digits characters from the input.

=cut

sub filter_digit {
    my $value = shift;
    return unless defined $value;

    $value =~ s/\D//g;

    return $value;
}

=pod

=head2 alphanum

Remove non alphanumeric characters from the input.

=cut

sub filter_alphanum {
    my $value = shift;
    return unless defined $value;
    $value =~ s/\W//g;
    return $value;
}

=pod

=head2 integer

Extract from its input a valid integer number.

=cut

sub filter_integer {
    my $value = shift;
    return unless defined $value;
    $value =~ tr/0-9+-//dc;
    ($value) =~ m/([-+]?\d+)/;
    return $value;
}

=pod

=head2 pos_integer

Extract from its input a valid positive integer number.

Bugs: This filter won't extract "9" from "a9+", it will instead extract "9+"

=cut

sub filter_pos_integer {
    my $value = shift;
    return unless defined $value;
    $value =~ tr/0-9+//dc;
    ($value) =~ m/(\+?\d+)/;
    return $value;
}

=pod

=head2 neg_integer

Extract from its input a valid negative integer number.

Bugs: This filter will currently filter the case of "a9-" to become "9-",
which it should leave it alone.

=cut

sub filter_neg_integer {
    my $value = shift;
    return unless defined $value;
    $value =~ tr/0-9-//dc;
    ($value) =~ m/(-\d+)/;
    return $value;
}

=pod

=head2 decimal

Extract from its input a valid decimal number.

Bugs: Given "1,000.23", it will currently return "1.000.23"

=cut

sub filter_decimal {
    my $value = shift;
    return unless defined $value;
    # This is a localization problem, but anyhow...
    $value =~ tr/,/./;
    $value =~ tr/0-9.+-//dc;
    ($value) =~ m/([-+]?\d+\.?\d*)/;
    return $value;
}

=pod

=head2 pos_decimal

Extract from its input a valid positive decimal number.

Bugs: Given "1,000.23", it will currently return "1.000.23"

=cut

sub filter_pos_decimal {
    my $value = shift;
    return unless defined $value;
    # This is a localization problem, but anyhow...
    $value =~ tr/,/./;
    $value =~ tr/0-9.+//dc;
    ($value) =~ m/(\+?\d+\.?\d*)/;
    return $value;
}

=pod

=head2 neg_decimal

Extract from its input a valid negative decimal number.

Bugs: Given "1,000.23", it will currently return "1.000.23"

=cut

sub filter_neg_decimal {
    my $value = shift;
    return unless defined $value;
    # This is a localization problem, but anyhow...
    $value =~ tr/,/./;
    $value =~ tr/0-9.-//dc;
    ($value) =~ m/(-\d+\.?\d*)/;
    return $value;
}

=pod

=head2 dollars

Extract from its input a valid number to express dollars like currency.

Bugs: This filter won't currently remove trailing numbers like "1.234".

=cut

sub filter_dollars {
    my $value = shift;
    return unless defined $value;
    $value =~ tr/,/./;
    $value =~ tr/0-9.+-//dc;
    ($value) =~ m/(\d+\.?\d?\d?)/;
    return $value;
}

=pod

=head2 phone

Filters out characters which aren't valid for an phone number. (Only
accept digits [0-9], space, comma, minus, parenthesis, period and pound [#].)

=cut

sub filter_phone {
    my $value = shift;
    return unless defined $value;
    $value =~ s/[^\d,\(\)\.\s,\-#]//g;
    return $value;
}

=pod

=head2 sql_wildcard

Transforms shell glob wildcard (*) to the SQL like wildcard (%).

=cut

sub filter_sql_wildcard {
    my $value = shift;
    return unless defined $value;
    $value =~ tr/*/%/;
    return $value;
}

=pod

=head2 quotemeta

Calls the quotemeta (quote non alphanumeric character) builtin on its
input.

=cut

sub filter_quotemeta {
    return unless defined $_[0];
    quotemeta $_[0];
}

=pod

=head2 lc

Calls the lc (convert to lowercase) builtin on its input.

=cut

sub filter_lc {
    return unless defined $_[0];
    lc $_[0];
}

=pod

=head2 uc

Calls the uc (convert to uppercase) builtin on its input.

=cut

sub filter_uc {
    return unless defined $_[0];
    uc $_[0];
}

=pod

=head2 ucfirst

Calls the ucfirst (Uppercase first letter) builtin on its input.

=cut

sub filter_ucfirst {
    return unless defined $_[0];
    ucfirst $_[0];
}


1;

__END__