Config-Model

 view release on metacpan or  search on metacpan

lib/Config/Model/Loader.pm  view on Meta::CPAN

        );
        if ($res) {
            Config::Model::Exception::Load->throw(
                object  => $element,
                command => $instructions,
                error => "Failed regexp '$value' on " . "element '"
                    . $element->name . "' : $res"
                );
        }
        return $element->store( value => $orig, check => $check );
    }
    else {
        $self->_log_cmd(
            $cmd, "Not applying regexp %qs on undefined value of %leaf.",
            $value, $element, $orig
        );
        return;
    }
}

sub _set_to_standard_value {
    my ( $self, $element, $value, $check, $instructions, $cmd ) = @_;
    # check value is done by store
    return $element->store($element->_fetch_std_no_check);
}

sub _store_file_in_value {
    my ( $self, $element, $value, $check, $instructions, $cmd ) = @_;

    if ($value eq '-') {
        ## no critic (InputOutput::ProhibitExplicitStdin)
        # user called a load function like .file(-), cannot use ARGV
        $element->store( value => join('',<STDIN>), check => $check );
        return 'ok';
    }

    my $path = $element->root_path->child($value);
    if ($path->is_file) {
        return $element->store( value => $path->slurp_utf8, check => $check );
    }
    else {
        Config::Model::Exception::Load->throw(
            object  => $element,
            command => $instructions,
            error => "cannot read file $value"
        );
    }
    return;
}

sub __data_from_vector {
    my ($data, @vector) = @_;
    for my $step (@vector) {
        $data = (ref($data) eq 'HASH') ? $data->{$step} : $data->[$step];
    }
    return $data;
}

sub __get_file_from_vector {
    my ($self, $element,$instructions,$raw_vector) =  @_;
    my @vector = split m![/]+!m, $raw_vector;
    my $cur = path('.');
    my $file;
    while (my $subpath = shift @vector) {
        my $new_path = $cur->child($subpath);
        if ($new_path->is_file) {
            $file = $new_path;
            last;
        }
        elsif ($new_path->is_dir) {
            $cur = $new_path;
        }
    }
    if (not defined $file) {
        my ( $element_name, $action, $f_arg, $id, $subaction, $value, $note )
            = @$instructions;
        Config::Model::Exception::Load->throw(
            object  => $element,
            command => "$element_name"
                . ( $action    ? "$action($f_arg)"    : '' )
                . ( $subaction ? "$subaction($value)" : '' ),
            error   => qq!Load error: Cannot find file in $value!
        );
    }
    return ($file, @vector);
}

sub _store_json_vector_in_value {
    my ( $self, $element, $value, $check, $instructions, $cmd ) = @_;
    my ($file, @vector) = $self->__get_file_from_vector($element,$instructions,$value);
    my $data = __load_json_file($file);
    return $element->store(
        value => __data_from_vector($data, @vector),
        check => $check
    );
}

sub _store_yaml_vector_in_value {
    my ( $self, $element, $value, $check, $instructions, $cmd ) = @_;
    my ($file, @vector) = $self->__get_file_from_vector($element,$instructions,$value);
    _lazy_load(".yaml()", "YAML::PP");
    my @data = YAML::PP->new()->load_file($file->stringify);
    return $element->store(
        value => __data_from_vector(\@data, @vector),
        check => $check
    );
}

sub _store_ini_vector_in_value {
    my ( $self, $element, $value, $check, $instructions, $cmd ) = @_;
    _lazy_load(".ini()", "Config::INI::Reader");

    my ($file, @vector) = $self->__get_file_from_vector($element,$instructions,$value);
    if (scalar @vector > 2) {
        die "$element calls .ini with too many elements in subpath @vector. Max is 2\n";
    }
    my $data = Config::INI::Reader->read_file($file->stringify);
    return $element->store(
        value => __data_from_vector($data, @vector),
        check => $check
    );



( run in 1.042 second using v1.01-cache-2.11-cpan-71847e10f99 )