view release on metacpan or  search on metacpan

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

#!/usr/bin/env perl

# mt-aws-glacier - Amazon Glacier sync client
# Copyright (C) 2012-2014  Victor Efimov
# http://mt-aws.com (also http://vs-dev.com) vs@vs-dev.com
# License: GPLv3
#
# This file is part of "mt-aws-glacier"
#
#    mt-aws-glacier is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    mt-aws-glacier is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.



use strict;
use warnings;
use utf8;
use Test::More tests => 1069;
use Test::Deep;
use Encode;
use FindBin;
use lib map { "$FindBin::RealBin/$_" } qw{../lib ../../lib};
use TestUtils 'w_fatal';
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'}];