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 )