view release on metacpan or  search on metacpan

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

	ismatch => ['z/example'],
	nomatch => ['tmp/pz/example/a'];


for my $s ("\xB5", "\xDF") { # Latin1
	ok ord($s) > 127;
	ok ord($s) <= 255;

	for my $u1 (0, 1) {
		my $s1 = $s;
		$u1 ? utf8::downgrade($s1) : utf8::upgrade($s1);
		for my $u2 (0, 1) {
			my $s2 = $s;
			$u2 ? utf8::downgrade($s2) : utf8::upgrade($s2);

			ok $s1 eq $s;
			ok $s1 eq $s2;

			check $s1,
				ismatch => [$s2],
				nomatch => ["tmp/$s2/a"];
		}
	}
}


# check empty pattern

check '',
	ismatch => ['a', 'a/b', 'a/b/c'];

my $a = 123;

$a =~ /123/;
check '',
	ismatch => ['a', 'a/b', 'a/b/c'];

$a =~ /4/;
check '',
	ismatch => ['a', 'a/b', 'a/b/c'];

#
# _patterns_to_regexp match_subdirs
#


for ('', 'a/', '/a/', 'a/b/', '/a/b/', '**', '/**', '/a/**', 'a**', 'a/b/**', 'a/b**') {
	my $F = App::MtAws::Filter->new();
	my ($re) = $F->_patterns_to_regexp({pattern => $_});
	ok $re->{match_subdirs}, "match subdirs [$_]";
}

for (' ', 'a/ ', '/a/ ', 'a/b/ ', '/a/b/ ', '*', '/*', '/a/*', 'a*', 'a/b/* *', 'a/b** *', 'a/b**c') {
	my $F = App::MtAws::Filter->new();
	my ($re) = $F->_patterns_to_regexp({pattern => $_});
	ok !$re->{match_subdirs}, "does not match subdirs [$_]";
}


#
# _patterns_to_regexp correctness of escapes
#


check 'z/ex.mple',
	ismatch => ['z/ex.mple'],
	nomatch => ['z/exNmple'];

check 'z/ex\\dmple',
	ismatch => ['z/ex\\dmple'],
	nomatch => ['z/ex1mple'];

check 'z/ex{1,2}mple',
	ismatch => ['z/ex{1,2}mple'],
	nomatch => ['z/exmple', 'z/exxmple'];

check 'z/ex[1|2]mple',
	ismatch => ['z/ex[1|2]mple'],
	nomatch => ['z/ex2mple', 'z/ex1mple'];

# simply test with fixtures

{
	my $F = {};
	App::MtAws::Filter::_init_substitutions($F, "\Q**\E" => '.*', "\Q*\E" => '[^/]*');
	is $F->{all_re}, '(\\\\\\*\\\\\\*|\\\\\\*)';
	cmp_deeply $F->{subst}, {'\\*' => '[^/]*','\\*\\*' => '.*'}, "substitutions work";

	$F = {};
	App::MtAws::Filter::_init_substitutions($F, "\Q*\E" => '[^/]*');
	is $F->{all_re}, '(\\\\\\*)';
	cmp_deeply $F->{subst}, {'\\*' => '[^/]*'}, "substitutions work";
}


#
# parse_filters
#

# simply test with fixtures

{
	my $F = App::MtAws::Filter->new();
	$F->parse_filters('-abc -dir/ +*.gz', '-!*.txt');
	cmp_deeply $F->{filters},
	[
		{
			'pattern' => 'abc',
			're' => qr/(^|\/)abc$/,
			'action' => '-',
			'match_subdirs' => '',
			'notmatch' => '',
		},
		{
			'pattern' => 'dir/',

			# Test::Deep problem here https://rt.cpan.org/Ticket/Display.html?id=85785
			# looks like perl 5.8.x issue with regexp stringification
			're' => do { my $s = '(^|/)dir\/'; qr/$s/ },

			'action' => '-',