view release on metacpan or  search on metacpan

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

};

sub impose(@)
{
	my ($name, $value) = @_;
	assert_option for $name;
	my $opt = $context->{options}->{$name};
	$opt->{source} = 'impose';
	$opt->{value} = $value;
	return $name;
};


sub lists(@)
{
	my @a = @_;
	grep { my $o = $_; first { $_ eq $o->{name} } @a; } @{$context->{option_list}};
}

sub raw_option($)
{
	my ($name) = @_;
	assert_option for $name;
	confess "option not present" unless defined($context->{options}->{$name}->{value});
	return $context->{options}->{$name};
};

sub custom($$)
{
	my ($name, $value) = @_;
	confess if ($context->{options}->{$name});
	$context->{options}->{$name} = {source => 'set', value => $value, name => $name, seen => 1 };
	return $name;
};


sub error($;%)
{
	my ($name, %data) = @_;
	push @{$context->{errors}},
		defined($context->{messages}->{$name}) ?
			{ format => $name, %data } :
			(%data ? confess("message '$name' is undefined") : $name);
	return;
};

sub warning($;%)
{
	my ($name, %data) = @_;
	push @{$context->{warnings}},
		defined($context->{messages}->{$name}) ?
			{ format => $name, %data } :
			(%data ? confess("message '$name' is undefined") : $name);
	return;
};

sub read_config
{
	my ($self, $filename) = @_;
	-f $filename or
		die exception 'config_file_is_not_a_file' => "Config file is not a file: %config%",
		config => hex_dump_string($filename);
	open (my $F, "<:crlf", $filename) or
		die exception 'cannot_read_config' => "Cannot read config file: %config%, errno=%errno%",
		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;
	return \%newconfig;
}

1;