Config::Tree::Env - Read configuration tree from environment variables

 # in Bash-like shell:

 % CONFIG_FOO__BAR=3 perl script.pl
 % CONFIG_FOO='{bar: 3}' perl script.pl; # same thing

 # in script.pl:

 use Config::Tree::Env;

 my $conf = Config::Tree::Env->new(
     # schema => ...,
     # include_path_re => qr/.../,
     # exclude_path_re => qr/.../,
     # env_path_separator => '__',
     # env_prefix => 'CONFIG_',
     # env_lowercase => 1,
     # env_as_yaml => 1,
     ro    => 0,
 );
 my $val = $conf->get('/foo/bar'); # 3
 $conf->cd('/foo');
 $conf->set('bar', 10); # same as set('/foo/bar', 10);

package Config::Tree::Env;

use Moose;
extends 'Config::Tree::Base';
use File::Slurp;
use Data::Schema;
use YAML::XS; # YAML.pm sucks: too strict for simple values, requiring ---, newline, etc

has _tree => (is => 'rw');
has _mtime => (is => 'rw');
has _loaded => (is => 'rw', default => 0);
has env_path_separator => (is => 'rw', default => '__');
has env_prefix => (is => 'rw', default => 'CONFIG_');
has env_lowercase => (is => 'rw', default => 1);
has env_as_yaml => (is => 'rw', default => 1);

sub BUILD {
    my ($self) = @_;
    # immediately load
    $self->get_tree_for('/');
    $self->name("env") unless $self->name;
}

sub _get_tree {
    my ($self) = @_;

    unless ($self->_loaded) {
        my $tree = {};

        my $sep = $self->env_path_separator;
        if (length($sep)) { $sep = qr/\Q$sep/ }
        my $prefix = $self->env_prefix;
        if (length($prefix)) { $prefix = qr/^\Q$prefix/ }

        for my $envname (keys %ENV) {
            my $name = $envname;
            next unless !$prefix || $name =~ s/$prefix//;
            $name =~ s!$sep!/!g if $sep;
            $name = lc($name) if $self->env_lowercase;

            my $val = $ENV{$envname};
            if ($self->env_as_yaml) {
                eval { $val = Load($val) };
                die "YAML parse error in environment variable $envname: $@" if $@;
            }

            my $t = $tree;
            my @path = grep {length} split m!/+!, $name;
            my $n = pop @path;
            for (@path) {
                if (!exists $t->{$_}) {
                    $t->{$_} = {};
                    $t = $t->{$_};
                } else {
                    die "Environment variable conflict with previous one(s): $envname";
                }
            }
            if (!exists($t->{$n})) {
                $t->{$n} = $val;
            } else {
                die "Environment variable conflict: $envname";
            }
        }

        $self->_tree($tree);
        #print Dump($tree);
        $self->_mtime(time);
        $self->_loaded(1);

    }
    ($self->_tree, $self->_mtime);
}

sub _format_validation_error {
    my ($self, $res) = @_;
    sprintf("%sconfig has %d error(s): `%s`",
            ($self->modified ? "modified " : ""),
            scalar(@{ $res->{errors} }),
            join(", ", @{ $res->{errors} }));
}

sub _save {
    my ($self) = @_;
    1;
}

__PACKAGE__->meta->make_immutable;
1;