view release on metacpan or  search on metacpan

t/unit/filter.t  view on Meta::CPAN

use App::MtAws::Filter;
use Data::Dumper;



# to make sure we're not affected by
# http://perldoc.perl.org/perl5180delta.html#New-Restrictions-in-Multi-Character-Case-Insensitive-Matching-in-Regular-Expression-Bracketed-Character-Classes
my %special_chars = ( # KEY should match KEY but should not match VALUE
	'ss' => 'ß',
	'ß' => 'ss',
);

is length('ß'), 1; # make sure we're running unicode

#
# _filters_to_pattern
#

sub assert_parse_filter_error($$)
{
	my ($data, $err) = @_;
	my $F = App::MtAws::Filter->new();
	ok ! defined $F->_filters_to_pattern($data);
	is $F->{error}, $err;
}

sub assert_parse_filter_ok(@)
{
	my ($expected, @data) = (pop, @_);
	my $F = App::MtAws::Filter->new();
	ok !$F->{error};
	cmp_deeply [$F->_filters_to_pattern(@data)], $expected;
}


my @spaces = ('', ' ', '  ');
my @onespace = ('', ' ');

for my $before (@spaces) {
	for my $after (@spaces) {
		for my $sign (qw/+ -/) {
			for my $last (@spaces) {
				assert_parse_filter_ok "${before}${sign}${after}*.gz${last}", [{ action => $sign, pattern =>'*.gz'}];
			}
		}
	}
}

for my $exclamation ('', '!') {
	for my $between (' ', '  ') {
		for my $before (@onespace) {
			for my $after (@onespace) {
				for my $last (@onespace) {
					my ($res, $err);

					assert_parse_filter_ok "${before}+${after}${exclamation}*.gz${last}${between}${before}-${after}*.txt${last}",
						[{ action => '+', pattern => "${exclamation}*.gz"}, { action => '-', pattern => '*.txt'}];

					assert_parse_filter_ok
						"${before}+${after}${exclamation}*.gz${last}${between}${before}-${after}*.txt${last}",
						"${before}-${after}*.jpeg${last}${between}${before}+${after}*.png${last}",
						[{ action => '+', pattern => "${exclamation}*.gz"}, { action => '-', pattern => '*.txt'},
						{ action => '-', pattern => '*.jpeg'}, { action => '+', pattern => '*.png'}];

					assert_parse_filter_ok
						"${before}+${after}${exclamation}*.gz${last}${between}${before}-${after}*.txt${last}",
						"${before}-${after}*.jpeg${last}${between}",
						[{ action => '+', pattern => "${exclamation}*.gz"}, { action => '-', pattern => '*.txt'}, { action => '-', pattern => '*.jpeg'}];

					assert_parse_filter_ok
						"${between}${before}-${after}*.txt${last}",
						"${before}-${after}*.jpeg${last}${between}${before}+${after}*.png${last}",
						[{ action => '-', pattern => '*.txt'}, { action => '-', pattern => '*.jpeg'}, { action => '+', pattern => '*.png'}];
				}
			}
		}
	}
}

assert_parse_filter_ok "+", [ { action => '+', pattern => ''} ];
assert_parse_filter_ok "-", [ { action => '-', pattern => ''} ];
assert_parse_filter_ok "+data/ -", [ { action => '+', pattern => 'data/'}, { action => '-', pattern => ''} ];
assert_parse_filter_ok "++", [ { action => '+', pattern => '+'} ];
assert_parse_filter_ok "+++", [ { action => '+', pattern => '++'} ];
assert_parse_filter_ok "--", [ { action => '-', pattern => '-'} ];
assert_parse_filter_ok "---", [ { action => '-', pattern => '--'} ];
assert_parse_filter_ok "+ ", [ { action => '+', pattern => ''} ];
assert_parse_filter_ok " + ", [ { action => '+', pattern => ''} ];
assert_parse_filter_ok "  +  ", [ { action => '+', pattern => ''} ];

assert_parse_filter_ok "-+", [ { action => '-', pattern => '+'} ];
assert_parse_filter_ok "+-", [ { action => '+', pattern => '-'} ];

assert_parse_filter_ok "-data/  +  ", [  { action => '-', pattern => 'data/'}, { action => '+', pattern => ''} ];
assert_parse_filter_ok "-data/  +", [  { action => '-', pattern => 'data/'}, { action => '+', pattern => ''} ];
assert_parse_filter_ok "-data/  ++", [  { action => '-', pattern => 'data/'}, { action => '+', pattern => '+'} ];
assert_parse_filter_ok "-data/  -+", [  { action => '-', pattern => 'data/'}, { action => '-', pattern => '+'} ];


for my $first (qw/+ -/) {
	for my $second (qw/+ -/) {
		for my $before (@spaces) {
			for my $after (@spaces) {
				assert_parse_filter_ok "${second}*data/ ${before}${first}${after}${second}${before}",
					[  { action => $second, pattern => '*data/'}, { action => $first, pattern => $second} ];
			}
		}
	}
}

assert_parse_filter_error ' +z  p +a', 'p +a';
assert_parse_filter_error '+z z', 'z';
assert_parse_filter_error '', '';
assert_parse_filter_error ' ', ' ';

#
# _patterns_to_regexp regexp correctness
#

sub check
{
	my ($filter, %lists) = @_;
	my $F = App::MtAws::Filter->new();
	my ($re) = $F->_patterns_to_regexp({pattern => $filter});
	for (@{$lists{ismatch}}) {
		my $orig_utf_flag = utf8::is_utf8($_);
		$_ = "/$_";
		is utf8::is_utf8($_), $orig_utf_flag;
		ok $re->{notmatch} ? ($_ !~ $re->{re}) : ($_ =~ $re->{re}), "[$filter], [$re->{re}],$_";
	}
	for (@{$lists{nomatch}}) {
		my $orig_utf_flag = utf8::is_utf8($_);
		$_ = "/$_";