view release on metacpan or  search on metacpan

lib/Aion/Env/Etc.pm  view on Meta::CPAN

package Aion::Env::Etc;

use common::sense;

use YAML::Syck qw//;

use Aion::Env AION_ENV_ETC_PATH => (default => 'etc/include.yml');
use Aion::Env APP_ENV => (default => 'prod');

our %etc = %{ -e AION_ENV_ETC_PATH? parse(AION_ENV_ETC_PATH): () };

sub import {
	my ($cls, $name, %kw) = @_;
	my $isa = delete $kw{isa};
	my $is_default = exists $kw{default};
	my $default = delete $kw{default};
	my $key = delete $kw{key} // lc($name) =~ y/_/./r;
	die sprintf "Unknown keyword%s: %s",
		scalar keys %kw == 1? '': 's',
	 	join ", ", sort keys %kw if keys %kw;

	my ($val, $key_exists) = by_key(\%etc, $key);
	die "$name is'nt defined!" if !$key_exists and !$is_default;

	my $pkg = caller;
	my $val = $key_exists? $val: $default;

	if($isa) {
	   	if(UNIVERSAL::isa($isa, "Aion::Type")) { $isa->validate($val, $name) }
	   	else {
			local $_ = $val;
			die UNIVERSAL::can($isa, "get_message")? $isa->get_message($val): "$name type is'nt isa!" unless $isa->();
		}
	}
	
	constant->import("$pkg\::$name", $val);
}

# Считывает и парсит конфигурационный файл с включениями
sub parse {
	my ($path) = @_;

	my $etc;
	my @S = $path;
	while(@S) {
		my $path = shift @S;
		open my $f, '<:utf8', $path or die "$path :$!";
		read $f, my $buf, -s $f;
		close $f;
		$buf =~ s!\$\{([a-z_]\w*)\}! val($ENV{$1} // $Aion::Env::env{$1}) !gie;
		my $include = YAML::Syck::Load($buf); undef $buf;
		push @S, @{$include->{includes}};
		%$include = (%$include, %{$include->{'when@' . APP_ENV}});
		$etc = merge_hashes($path, undef, $etc, $include);
	}

	$etc
}

# Рекурсивное объединение двух хешей
sub merge_hashes {
	my ($file, $path, $x, $y) = @_;

	my %val = %$x;
	for my $k (keys %$y) {
		if(exists $val{$k}) {
			my $a_path = $path? "$path.$k": $k;
			die "$file > $a_path: x is'nt hash" if ref $val{$k} ne 'HASH';
			die "$file > $a_path: y is'nt hash" if ref $y->{$k} ne 'HASH';
			$val{$k} = merge_hashes($file, $a_path, $val{$k}, $y->{$k});
		}
		else { $val{$k} = $y->{$k} }
	}

	\%val
}

# Добавляет бэкслеши
sub val {
	my ($s) = @_;
	$s =~ s/[\\"']/\\$&/g;
	$s =~ s/\n/\\n/g;
	$s =~ s/\r/\\r/g;
	$s =~ s/\t/\\t/g;
	$s
}

# Получить значение по ключу
sub by_key($$) {
	my ($hash, $path) = @_;
	exists $hash->{$_}? $hash = $hash->{$_}: return undef, 0 for split /\./, $path;
	return $hash, 1;
}

1;

__END__

=encoding utf-8

=head1 NAME

Aion::Env::Etc - creates a constant associated with a key from configuration files

=head1 SYNOPSIS

etc/include.yml file: