App-MtAws

 view release on metacpan or  search on metacpan

lib/App/MtAws/ConfigEngine.pm  view on Meta::CPAN

			} else {
				defined(my $value = $data{$name})||confess;
				sprintf("%$format", $value);
			}
		} else {
			defined(my $value = $data{$match})||confess $spec;
			$value;
		}
	};

	$spec =~ s{%([\w\s]+)%} {$rep->($1)}ge if %data; # in new perl versions \w also means unicode chars..
	$spec;
}


sub errors_or_warnings_to_messages
{
	my ($self, $err) = @_;
	return unless defined $err;
	map {
		if (ref($_) eq ref({})) {

lib/App/MtAws/ConfigEngine.pm  view on Meta::CPAN

		config => hex_dump_string($filename), 'ERRNO';
	my %newconfig;
	local $_;
	my $lineno = 0;
	while (<$F>) {
		chomp;
		++$lineno;
		next if /^\s*$/;
		next if /^\s*\#/;
		my ($name, $value);
		 # we have there non-unicode data, so [ \t] can be replaced with \s. however i'll leave it for clarity
		if (($name, $value) = /^[ \t]*([A-Za-z0-9][A-Za-z0-9-]*)[ \t]*=[ \t]*(.*?)[ \t]*$/) {
			$newconfig{$name} = $value;
		} elsif (($name) = /^[ \t]*([A-Za-z0-9][A-Za-z0-9-]*)[ \t]*$/) {
			$newconfig{$name} = 1;
		} else {
			die exception 'invalid_config_line' => 'Cannot parse line in config file: %line% at %config% line %lineno%',
				lineno => $lineno, line => hex_dump_string($_), config => hex_dump_string($filename);
		}
	}
	close $F;

lib/App/MtAws/Exceptions.pm  view on Meta::CPAN

					sprintf("%$format", $value);
				}
			} else {
				':NULL:'
			}
		} else {
			defined($data{$match}) ? $data{$match} : ':NULL:';
		}
	};

	$spec =~ s{%([\w\s]+)%} {$rep->($1)}ge if %data; # in new perl versions \w also means unicode chars..
	$spec;
}



sub dump_error
{
	my ($where) = (@_, '');
	$where = defined($where) && length($where) ? " ($where)" : '';
	if (is_exception('cmd_error')) {

t/integration/config_read_config.t  view on Meta::CPAN

	is_deeply(read_as_config("${space}mykey1=myvalue\nmykey2=myvalue2"), $vars, "should trim spaces");

	is_deeply(read_as_config("mykey1${space}"), { mykey1 => 1}, "should trim spaces when no value");
	is_deeply(read_as_config("${space}mykey1"), { mykey1 => 1}, "should trim spaces when no value");
	is_deeply(read_as_config("${space}mykey1${space}"), { mykey1 => 1}, "should trim spaces when no value");
}


for my $notspace ("\xc2\xa0", "\xe2\x80\xaf", "\xc2\xa0\xe2\x80\xaf") {
	my $utfspace = decode("UTF-8", $notspace);
	ok ! defined eval { read_as_config("${notspace}mykey1"); 1 }, "should not trim unicode spaces when no value";
	is get_exception && get_exception->{code}, 'invalid_config_line';
	ok ! defined eval { read_as_config("mykey1${notspace}"); 1 }, "should not trim unicode spaces when no value";
	is get_exception && get_exception->{code}, 'invalid_config_line';
	ok ! defined eval { read_as_config("${notspace}mykey1${notspace}"); 1 }, "should not trim unicode spaces when no value";
	is get_exception && get_exception->{code}, 'invalid_config_line';

	ok ! defined eval { read_as_config("mykey1${notspace}=myvalue\nmykey2=myvalue2"); 1 }, "should not trim unicode spaces";
	is_deeply(
		read_as_config("mykey1=myvalue${notspace}\nmykey2=myvalue2"),
		{ 'mykey1' => "myvalue${utfspace}", 'mykey2' => 'myvalue2'},
		"should NOT trim unicode spaces"
	);
	is_deeply(
		read_as_config("mykey1=${notspace}myvalue\nmykey2=myvalue2"),
		{ 'mykey1' => "${utfspace}myvalue", 'mykey2' => 'myvalue2'},
		"should NOT trim unicode spaces"
	);
}

for my $badname ("!somename", 'some@name', 'some_name', '-somename', '--somename', '-', '--', '_', 'some-name-!', 'some name') {
	ok ! defined eval { read_as_config("$badname"); 1 }, "should deny invalid names";
	is get_exception && get_exception->{code}, 'invalid_config_line';
	ok ! defined eval { read_as_config(" $badname"); 1 }, "should deny invalid names";
	is get_exception && get_exception->{code}, 'invalid_config_line';
	ok ! defined eval { read_as_config("$badname=myvalue"); 1 }, "should deny invalid names";
	is get_exception && get_exception->{code}, 'invalid_config_line';

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

# 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);