Config-Model
view release on metacpan or search on metacpan
Config::Model::Node, or Config::Model::HashId or Config::Model::ListId.
Bug fixes:
* Value: skip notification if migrate yields an empty value
* Model: use logger for tracing legacy translation
2.061 2014-09-23
Bug fix release:
* ValueComputer: leave $@ and $! alone in formula.
Also skip variables like '$ foo'
2.060 2014-08-19
Bug fix release:
* value.t: avoid smoke test failures
* Avoid new perl 5.20 warning (Debian #758320)
* Value: improved notify change message (computed vs preset vs default)
* fix pod doc in cme (RT 97605, Debian #756433)
list:=a,b,c instead of list=a,b,c
Other changes:
* Dumper: use new syntax when dumping a list of value (i.e. list:=a,b,c)
* Instance: don't print change if old and new value are undef
2.051 2014-03-06
* cme: fix command like "cme modify foo ~~ <load_instructions>"
* ValueComputer: formula with eval no longer mess with $& and ${^MATCH}
variables used in regexp
2.050 2014-02-27
* Restore NAME section in Config::Model::Manual::* man pages
2.049 2014-02-26
Bug fix and minor new feature release:
* C::M::AnyThing: added has_warning fallback method (always return 0)
* Dpkg/Control/Source.pl : added XS-Python-Version ans X-Python-Version
(first steo to solve Debian #624321)
* Debian Dpkg Meta model: package filter is computed from group-filter
OR private policy
* Framework changes:
* reworked warp registration mechanism (Changed inherited WarpedThing into
delegation to Warper)
* t/debian*.t: Put back Apt::Pkg test to avoid smoke test failure
* ValueComputer: Fixed bug to allow temporary variables and $_ in eval'ed
formulas
1.242 2011-04-07
* Application changes:
* dpkg control: added Build-Conflicts field
* dpkg: Added model for debian/source/options and debian/clean files
* Framework changes:
* Value: don't perform value check when fetching standard or default value
* Backend/Plainfile: now support list element in the form of multi line file.
* Application changes:
* Debian::Dependency: don't check debhelper
* Debian::Copyright: removed license keyword warnings. (fix Debian #610242), lots
of other bug fixes (including debian bug #609889 #610231)
* Framework changes:
* AnyId: added migrate_keys_from to migrate list or hash content
during updgrades.
* ObjTreeScanner: Added node_dispatch_cb parameter to setup callback
dedicated to specific configuration classes.
* ValueComputer: added 'undef_is' to allow undef value in formulas. Useful for
complex migration scenario where migration can come from several alternative parmeters.
* FuseUI: Fix bug that disabled write in a boolean value
1.229 2011-01-10
* config-edit: added -apply-fixes option
* Value: can specify wider replace instruction by using regexp as
key of the 'replace' parameter
* Debian::Dpkg::Copyright: updtead to new CANDIDATE DEP-5
specification. Copyright files written for older
0.613 2007-09-25
* IdElementReference.pm: Changes the API of IdElementReference so
that API is more explicit (Like the API change for
ValueComputer). This change is backward compatible (model
translation)
* ValueComputer.pm: Now compute paramater must use explicit
parameters for compute formula, variables and replace. Backward
compatibility is kept by translating old compute declaration in
Model.pm
* Model.pm (include_class): permission, level and description
parameters can also be declared within the element declaration.
(i.e. at the same level than 'type' )
* IdElementReference.pm (): A reference to a list will now take
into account the values of the list instead of the indexes of the
* examples/fstab/fstab_test.pl (produce_fstab): added curses
interface example (need to install Config::Model::CursesUI to
work)
* config-model: added possibility to use the curses interface
provided by Config::Model::CursesUI (if this one is installed)
* ValueComputer.pm: Modified so compute may return an undef value
if one of the variable (extracted from the configuration data) of
the formula is undefined. In other word, propagate undef instead
of croaking.
* Searcher.pm: Lots of bug fixes
(get_searchable_elements): new method
(prepare): new method. Search is now done in 3 moves: create the
searcher object, prepare the search, and run the search
* Value.pm: removed unique_value parameter which was a bad idea
for a check list implementation. Moved reference handling into new
IdElementReference class
lib/Config/Model.pm view on Meta::CPAN
if ( ref( $info->{$old_name} ) eq 'ARRAY' ) {
my $compute_info = delete $info->{$old_name};
$legacy_logger->debug(
"translate_compute_info $elt_name input:\n",
Data::Dumper->Dump( [$compute_info], [qw/compute_info/] )
) if $legacy_logger->is_debug;
$self->show_legacy_issue([ "$config_class_name->$elt_name: specifying compute info with ",
"an array ref is deprecated" ]);
my ( $user_formula, %var ) = @$compute_info;
my $replace_h;
foreach ( keys %var ) { $replace_h = delete $var{$_} if ref( $var{$_} ) };
# cleanup user formula
$user_formula =~ s/\$(\w+)\{/\$replace{/g;
# cleanup variable
foreach ( values %var ) { s/\$(\w+)\{/\$replace{/g };
# change the hash *in* the info structure
$info->{$new_name} = {
formula => $user_formula,
variables => \%var,
};
$info->{$new_name}{replace} = $replace_h if defined $replace_h;
$legacy_logger->debug(
"translate_warp_info $elt_name output:\n",
Data::Dumper->Dump( [ $info->{$new_name} ], [ 'new_' . $new_name ] )
) if $legacy_logger->is_debug;
}
return;
lib/Config/Model.pm view on Meta::CPAN
return \%result;
}
#
# New subroutine "get_migrate_doc" extracted - Tue Jun 5 13:31:20 2012.
#
sub get_migrate_doc {
my ( $self, $elt_name, $desc, $migr ) = @_;
my $mv = $migr->{variables};
my $mform = $migr->{formula};
if ( $mform =~ /\n/) { $mform =~ s/^/ /mg; $mform = "\n\n$mform\n\n"; }
else { $mform = "'C<$mform>' " }
my $mdoc = "Note: $elt_name $desc ${mform}and with: \n\n=over\n\n=item *\n\n"
. join( "\n\n=item *\n\n", map { qq!C<\$$_> => C<$mv->{$_}>! } sort keys %$mv );
if ( my $rep = $migr->{replace} ) {
$mdoc .= "\n\n=item *\n\n"
. join( "\n\n=item *\n\n", map { qq!C<\$replace{$_}> => C<$rep->{$_}>! } sort keys %$rep );
}
lib/Config/Model/AnyId.pm view on Meta::CPAN
add_fixes => 'add',
flush_fixes => [ mul => 0 ],
}
);
# Some idea for improvement
# suggest => 'foo' or '$bar foo'
# creates a method analog to next_id (or next_id but I need to change
# run_user_command) that suggest the next id as foo_<nb> where
# nb is incremented each time, or compute the passed formula
# and performs the same
my @common_int_params = qw/min_index max_index max_nb auto_create_ids/;
has \@common_int_params => ( is => 'ro', isa => 'Maybe[Int]' );
my @common_hash_params = qw/default_with_init/;
has \@common_hash_params => ( is => 'ro', isa => 'Maybe[HashRef]' );
my @common_list_params = qw/allow_keys default_keys auto_create_keys/;
has \@common_list_params => (
lib/Config/Model/CheckList.pm view on Meta::CPAN
=item *
A check list where the available choices are the specified choice and
the choice of C<refer_to_3_lists> and a hash whose name is specified
by the value of the C<indirection> configuration parameter (this
example is admittedly convoluted):
refer_to_check_list_and_choice => {
type => 'check_list',
computed_refer_to => {
formula => '- refer_to_2_list + - $var',
variables => {
var => '- indirection '
}
},
choice => [qw/A1 A2 A3/],
},
=back
=head1 Methods
lib/Config/Model/Exception.pm view on Meta::CPAN
my $self = shift;
return "Error: cannot find configuration file " . $self->file . "\n";
}
package Config::Model::Exception::Formula 2.155;
use Mouse;
extends 'Config::Model::Exception::Model';
sub _desc { 'error in computation formula of the configuration model'}
package Config::Model::Exception::Internal 2.155;
use Mouse;
extends 'Config::Model::Exception::Fatal';
sub _desc { 'internal error' }
1;
lib/Config/Model/IdElementReference.pm view on Meta::CPAN
);
}
my $rft = $self->{refer_to};
my $crft = $self->{computed_refer_to} || {};
my %c_args = %$crft;
my $refer_path =
defined $rft
? $rft
: delete $c_args{formula};
# split refer_path on + then create as many ValueComputer as
# required
my @references = split /\s+\+\s+/, $refer_path;
foreach my $single_path (@references) {
push @{ $self->{compute} }, Config::Model::ValueComputer->new(
formula => $single_path,
variables => {},
%c_args,
value_object => $self->{config_elt},
value_type => 'string' # a reference is always a string
);
}
return $self;
}
lib/Config/Model/IdElementReference.pm view on Meta::CPAN
$logger->debug( "Setting choice to '", join( "','", @res ), "'" );
$config_elt->setup_reference_choice(@res);
}
sub reference_info {
my $self = shift;
my $str = "choice was retrieved with: ";
foreach my $compute_obj ( @{ $self->{compute} } ) {
my $path = $compute_obj->formula;
$path = defined $path ? "'$path'" : 'undef';
$str .= "\n\tpath $path";
$str .= "\n\t" . $compute_obj->compute_info;
}
return $str;
}
sub compute_obj {
my $self = shift;
return @{ $self->{compute} };
}
sub reference_path {
my $self = shift;
return map { $_->formula } @{ $self->{compute} };
}
__PACKAGE__->meta->make_immutable;
1;
# ABSTRACT: Refer to id element(s) and extract keys
__END__
lib/Config/Model/IdElementReference.pm view on Meta::CPAN
type => 'leaf',
value_type => 'reference', # provided by tConfig::Model::IdElementReference
refer_to => '! host'
},
# master_nic is one NIC of the master host
master_nic => {
type => 'leaf',
value_type => 'reference', # provided by tConfig::Model::IdElementReference
computed_refer_to => { # provided by Config::Model::ValueComputer
formula => ' ! host:$h ip_nic ',
variables => { h => '- master_host' }
}
},
# provided by Config::Model::ValueComputer
master_ip => {
type => 'leaf',
value_type => 'string',
compute => {
formula => '$ip',
variables => {
h => '- master_host',
nic => '- master_nic',
ip => '! host:$h ip_nic:$nic'
}
}
},
],
);
lib/Config/Model/IdElementReference.pm view on Meta::CPAN
C<refer_to> is used to specify a hash element that is used as a
reference. C<refer_to> points to an array or hash element in the
configuration tree using the path syntax (See
L<Config::Model::Role::Grab/grab> for details).
=item computed_refer_to
When C<computed_refer_to> is used, the path is computed using values
from several elements in the configuration tree. C<computed_refer_to>
is a hash with 2 mandatory elements: C<formula> and C<variables>.
=back
The available choice of this (computed or not) reference value is made
from the available keys of the C<referred_to> hash element or the values
of the C<referred_to> array element.
The example means the the value must correspond to an existing host:
value_type => 'reference',
refer_to => '! host'
This example means the the value must correspond to an existing lan
within the host whose Id is specified by hostname:
value_type => 'reference',
computed_refer_to => {
formula => '! host:$a lan',
variables => { a => '- hostname' }
}
If you need to combine possibilities from several hash, use the "C<+>"
token to separate 2 paths:
value_type => 'reference',
computed_refer_to => {
formula => '! host:$a lan + ! host:foobar lan',
variables => { a => '- hostname' }
}
You can specify C<refer_to> or C<computed_refer_to> with a C<choice>
argument so the possible enum value will be the combination of the
specified choice and the referred_to values.
=head1 Methods
=head2 reference_info
lib/Config/Model/Value.pm view on Meta::CPAN
$self->migrate_from($mig_ref);
}
else {
Config::Model::Exception::Model->throw(
object => $self,
error => "migrate_from value must be a hash ref not $mig_ref"
);
}
my @migrate_data;
foreach (qw/formula variables replace use_eval undef_is/) {
push @migrate_data, $_, $mig_ref->{$_} if defined $mig_ref->{$_};
}
$self->{_migrate_from} = Config::Model::ValueComputer->new(
@migrate_data,
value_object => $self,
value_type => $self->{value_type} );
# resolve any recursive variables before registration
my $v = $self->{_migrate_from}->compute_variables;
lib/Config/Model/Value.pm view on Meta::CPAN
if ($path) {
Config::Model::Exception::User->throw(
object => $self,
message => "set() called with a value with non-empty path: '$path'"
);
}
return $self->store(@data);
}
#These methods are important when this leaf value is used as a warp
#master, or a variable in a compute formula.
# register a dependency, This information may be used by external
# tools
sub register_dependency {
my $self = shift;
my $slave = shift;
unshift @{ $self->{depend_on_me} }, $slave;
# weaken only applies to the passed reference, and there's no way
lib/Config/Model/Value.pm view on Meta::CPAN
which does not need to be written in the configuration file.
=item write_as
Array ref. Reserved for boolean value. Specify how to write a boolean value.
Default is C<[0,1]> which may not be the most readable. C<write_as> can be
specified as C<['false','true']> or C<['no','yes']>.
=item compute
Computes a value according to a formula and other values. By default
a computed value cannot be set. See L<Config::Model::ValueComputer> for
computed value declaration.
=item migrate_from
This is a special parameter to cater for smooth configuration
upgrade. This parameter can be used to copy the value of a deprecated
parameter to its replacement. See L</Upgrade> for details.
=item convert => [uc | lc ]
lib/Config/Model/Value.pm view on Meta::CPAN
'old_url' => {
type => 'leaf',
value_type => 'uniline',
status => 'deprecated',
},
'host' => {
type => 'leaf',
value_type => 'uniline',
# the formula must end with '$1' so the result of the capture is used
# as the host value
migrate_from => {
formula => '$old =~ m!http://([\w\.]+)!; $1 ;',
variables => {
old => '- old_url'
},
use_eval => 1,
},
},
'path' => {
type => 'leaf',
value_type => 'uniline',
migrate_from => {
formula => '$old =~ m!http://[\w\.]+(/.*)!; $1 ;',
variables => {
old => '- old_url'
},
use_eval => 1,
},
},
=head1 EXCEPTION HANDLING
When an error is encountered, this module may throw the following
lib/Config/Model/ValueComputer.pm view on Meta::CPAN
use vars qw($compute_grammar $compute_parser);
use feature qw/postderef signatures/;
no warnings qw/experimental::postderef experimental::signatures/;
my $logger = get_logger("ValueComputer");
# allow_override is intercepted and handled by Value object
has formula => ( is => 'ro', isa => 'Str', required => 1 );
has value_type => ( is => 'ro', isa => 'Str', required => 1 );
# value_object is mostly used for error messages
has value_object => (
is => 'ro',
isa => 'Config::Model::AnyThing',
required => 1,
weak_ref => 1,
handles => [qw/grab grab_value location index element/],
);
lib/Config/Model/ValueComputer.pm view on Meta::CPAN
: undef;
}
sub BUILD {
my $self = shift;
# create parser if needed
$compute_parser ||= Parse::RecDescent->new($compute_grammar);
$logger->trace("called with formula: $self->{formula}");
# must make a first pass at computation to subsitute index and
# element values. leaves $xxx outside of &index or &element untouched
my $result_r =
$compute_parser->pre_compute( $self->{formula}, 1, $self->{value_object},
$self->{variables}, $self->{replace}, 'yes', $self->need_quote, );
$logger->trace("pre_formula: ". ($result_r ? $$result_r : ' pre_compute failed, using original formula'));
$self->{pre_formula} = $result_r ? $$result_r : $self->{formula};
return;
}
sub compute ($self, %args) {
my $check = $args{check} || 'yes';
my $pre_formula = $self->{pre_formula};
$logger->trace("called with pre_formula: $pre_formula");
my $variables = $self->compute_variables( check => $check );
die "internal error" unless defined $variables;
my $result;
my @parser_args = (
$self->{value_object}, $variables, $self->{replace}, $check, $self->{need_quote},
$self->undef_replacement
);
if ( $self->{use_eval}
or $self->{value_type} =~ /(integer|number|boolean)/ ) {
$logger->trace("will use eval");
my $all_defined = 1;
my %__vars;
foreach my $key ( sort keys %$variables ) {
# no need to get variable if not used in formula;
next unless index( $pre_formula, $key ) > 0;
my $vr = _value_from_object( $key, @parser_args );
my $v = $$vr;
$v = $self->undef_replacement unless defined $v;
$logger->debug( "compute: var $key -> ", ( defined $v ? $v : '<undef>' ) );
# security: $v are stored in %__vars hash, so they are
# used by eval'ed code, but not directly eval'ed
if ( defined $v ) { $__vars{$key} = $v }
else { $all_defined = 0; }
}
if ($all_defined) {
my $formula = $pre_formula;
$formula =~ s/\$([_a-zA-Z]\w*)/defined $__vars{$1} ? "\$__vars{$1}" : "\$$1" /eg;
$logger->debug("compute: evaluating '$formula'");
$result = eval $formula; ## no critic (ProhibitStringyEval)
if ($@) {
Config::Model::Exception::Formula->throw(
object => $self->{value_object},
error => "Eval of formula '$formula' failed:\n$@"
. "Make sure that your element is indeed "
. "'$self->{value_type}'"
);
}
}
}
else {
$logger->trace("calling parser with compute on pre_formula $pre_formula");
my $formula_r = $compute_parser->compute( $pre_formula, 1, @parser_args );
$result = $$formula_r;
#$result = $self->{computed_formula} = $formula;
}
$logger->debug( "compute result is '" . ( defined $result ? $result : '<undef>' ) . "'" );
return $result;
}
sub compute_info ($self, %args) {
my $check = $args{check} || 'yes';
$logger->trace("compute_info called with $self->{formula}");
my $orig_variables = $self->{variables};
my $variables = $self->compute_variables;
my $str = "value is computed from '$self->{formula}'";
return $str unless defined $variables;
if (%$variables) {
$str .= ", where ";
foreach my $k ( sort keys %$variables ) {
my $u_val = $variables->{$k};
if ( ref($u_val) ) {
foreach (sort keys %$u_val) {
$str .= "\n\t\t'\$$k" . "{$_} is converted to '$orig_variables->{$k}{$_}'";
lib/Config/Model/ValueComputer.pm view on Meta::CPAN
: $obj->get_type eq 'hash' ? '<hash>'
: $obj->get_type eq 'list' ? '<list>'
: $obj->fetch( check => $check );
}
$str .= "\n\t\t'$k' from path '$orig_variables->{$k}' is ";
$str .= defined $val ? "'$val'" : 'undef';
}
}
}
#$str .= " (evaluated as '$self->{computed_formula}')"
# if $self->{formula} ne $self->{computed_formula} ;
return $str;
}
# internal. resolves variables that contains $foo or &bar
# returns a hash of variable names -> variable path
sub compute_variables ($self, %args) {
my $check = $args{check} || 'yes';
# a shallow copy should be enough as we don't allow
lib/Config/Model/ValueComputer.pm view on Meta::CPAN
element => [
[qw/av bv/] => {
type => 'leaf',
value_type => 'integer',
},
compute_int => {
type => 'leaf',
value_type => 'integer',
compute => {
formula => '$a + $b',
variables => { a => '- av', b => '- bv'}
},
},
],
);
my $inst = $model->instance(root_class_name => 'MyClass' );
my $root = $inst->config_root ;
# put data
$root->load( steps => 'av=33 bv=9' );
print "Computed value is ",$root->grab_value('compute_int'),"\n";
# Computed value is 42
=head1 DESCRIPTION
This class provides a way to compute a configuration value. This
computation uses a formula and some other configuration values from
the configuration tree.
The computed value can be overridden, in other words, the computed
value can be used as a default value.
=head1 Computed value declaration
A computed value must be declared in a 'leaf' element. The leaf element
must have a C<compute> argument pointing to a hash ref.
This array ref contains:
=over
=item *
A string formula that use variables and replace function.
=item *
A set of variable and their relative location in the tree (using the
notation explained in
L<grab method|Config::Model::Role::Grab/grab">
=item *
An optional set of replace rules.
lib/Config/Model/ValueComputer.pm view on Meta::CPAN
=back
B<Note>: A variable must point to a valid location in the configuration
tree. Even when C<&index()> or C<$replace{}> is used. After substitution
of these functions, the string is used as a path (See
L<grab|Config::Model::Role::Grab/grab">) starting from the
computed value. Hence the path must begin with C<!> to go back to root
node, or C<-> to go up a level.
=head2 Compute formula
The first element of the C<compute> array ref must be a string that
contains the computation algorithm (i.e. a formula for arithmetic
computation for integer values or a string template for string
values).
This string or formula should contain variables (like C<$foo> or
C<$bar>). Note that these variables are not interpolated by Perl.
For instance:
'My cat has $nb legs'
'$m * $c**2'
This string or formula may also contain:
=over
=item *
The index value of the current object : C<&index> or C<&index()>.
=item *
The index value of a parent object: C<&index(-)>. Ancestor index value can be retrieved
lib/Config/Model/ValueComputer.pm view on Meta::CPAN
If you need to perform more complex operations than substitution, like
extraction with regular expressions, you can force an eval done by
Perl with C<< use_eval => 1 >>. In this case, the result of the eval
is used as the computed value.
For instance:
# extract host from url
compute => {
formula => '$old =~ m!http://[\w\.]+(?::\d+)?(/.*)!; $1 ;',
variables => { old => '- url' } ,
use_eval => 1 ,
},
# capitalize
compute => {
formula => 'uc($old)',
variables => { old => '- small_caps' } ,
use_eval => 1
}
=head2 Compute variables
Compute variables are a set of C<< key => value >> pairs that define
the variables used in the specified formula. The key is a variable name used in
the string that represents the formula. The value is a string that is used to get
the correct L<Value|Config::Model::Value> object.
In this numeric example, C<result> default value is C<av + bv>:
element => [
av => {
type => 'leaf',
value_type => 'integer'
},
bv => {
type => 'leaf',
value_type => 'integer'
},
result => {
type => 'leaf',
value_type => 'integer',
compute => {
formula => '$a + $b' ,
variables => { a => '- av', b => '- bv' },
}
}
]
In this string example, the default value of the C<Comp> element is
actually a string made of "C<macro is >" and the value of the
"C<macro>" element of the object located 2 nodes above:
comp => {
type => 'leaf',
value_type => 'string',
compute => {
formula => '"macro is $m"' ,
variables => { m => '- - macro' }
}
}
=head2 Compute replace
Sometime, using the value of a tree leaf is not enough and you need to
substitute a replacement for any value you can get. This replacement
can be done using a hash like notation within the formula using the
C<%replace> hash.
For instance, if you want to display a summary of a config, you can do :
compute_with_replace => {
formula => '$replace{$who} is the $replace{$what} of $replace{$country}',
variables => {
who => '! who' ,
what => '! what' ,
country => '- country',
},
replace => {
chief => 'president',
America => 'USA'
}
}
=head2 Complex formula
C<&index>, C<&element>, and replace can be combined. But the
argument of C<&element> or C<&index> can only be a value object
specification (I.e. something like 'C<- - foo>'), it cannot be a value
replacement of another C<&element> or C<&index>.
I.e. C<&element($foo)> is ok, but C<&element(&index($foo))> is not allowed.
=head2 computed variable
Compute variables can themselves be computed :
compute => {
formula => 'get_element is $replace{$s}, indirect value is \'$v\'',
variables => {
s => '! $where',
where => '! where_is_element',
v => '! $replace{$s}',
}
replace => {
m_value_element => 'm_value',
compute_element => 'compute'
}
}
lib/Config/Model/ValueComputer.pm view on Meta::CPAN
In some case, a computed value must be interpreted as a default value
and the user must be able to override this computed default value. In
this case, you must use C<< allow_override => 1 >> with the
compute parameter:
computed_value_with_override => {
type => 'leaf',
value_type => 'string',
compute => {
formula => '"macro is $m"' ,
variables => { m => '- - macro' } ,
allow_override => 1,
}
}
This computed default value is written to the configuration file.
This default value may be already known by the application so the computed value
should B<not> be written to the configuration file. The computed value is interesting
because it cab be shown to the user. In this case, use the C<use_as_upstream_default>
parameter:
compute_known_upstream => {
type => 'leaf',
value_type => 'string',
compute => {
formula => '"macro is $m"' ,
variables => { m => '- - macro' } ,
use_as_upstream_default => 1,
}
}
C<use_as_upstream_default> implies C<allow_override>.
=head2 Undefined variables
You may need to compute value where one of the variables (i.e. other configuration
parameter) is undefined. By default, any formula yields an undefined value if one
variable is undefined.
You may change this behavior with C<undef_is> parameter. With this
parameter, you can specify a "fallback" value that is used in your
formula instead of an undefined variable.
The most useful fallback values are:
undef_is => "''", # for string values
undef_is => 0 , # for integers, boolean values
Example:
Source => {
type => 'leaf',
value_type => 'string',
mandatory => 1,
migrate_from => {
use_eval => 1,
formula => '$old || $older ;',
undef_is => "''",
variables => {
older => '- Original-Source-Location',
old => '- Upstream-Source'
}
},
},
[qw/Upstream-Source Original-Source-Location/] => {
value_type => 'string',
status => 'deprecated',
lib/Config/Model/ValueComputer.pm view on Meta::CPAN
=head2 String substitution
[qw/sav sbv/] => {
type => 'leaf',
value_type => 'string',
},
compute_string => {
type => 'leaf',
value_type => 'string',
compute => {
formula => 'meet $a and $b',
variables => { '- sav', b => '- sbv' }
},
},
=head2 Computation with on-the-fly replacement
compute_with_replace => {
type => 'leaf',
value_type => 'string',
compute => {
formula =>
'$replace{$who} is the $replace{$what} of $replace{$country}',
variables => {
who => '! who',
what => '! what',
country => '- country',
},
replace => {
chief => 'president',
America => 'USA'
},
lib/Config/Model/ValueComputer.pm view on Meta::CPAN
Extract the host name from an URL:
url => {
type => 'leaf',
value_type => 'uniline'
},
extract_host_from_url => {
type => 'leaf',
value_type => 'uniline',
compute => {
formula => '$old =~ m!http://([\w\.]+)!; $1 ;',
variables => { old => '- url' },
use_eval => 1,
},
},
=head2 copy hash example
Copying a hash may not be useful, but the using C<&index()> in a variable can be. Here's an example
where the hashes contain leaves.
lib/Config/Model/ValueComputer.pm view on Meta::CPAN
'type' => 'node'
},
},
copy_to => {
'type' => 'hash',
'index_type' => 'string',
'cargo' => {
'type' => 'leaf',
'value_type' => 'uniline',
'compute' => {
'formula' => '$copied',
'variables' => {
'copied' => '- copy_from:&index()'
}
},
},
},
Hash copy is also possible when the hash contains node. Here's an example where
the data to be copied is stored within a node. The main class has 2 hash elements:
lib/Config/Model/ValueComputer.pm view on Meta::CPAN
]
Here the class to copy to:
'name' => 'To',
'element' => [
name => {
'type' => 'leaf',
'value_type' => 'uniline',
'compute' => {
'formula' => '$copied',
'variables' => {
'copied' => '! copy_from:&index(-) name'
}
},
}
]
=head1 AUTHOR
Dominique Dumont, (ddumont at cpan dot org)
lib/Config/Model/models/Multistrap.pl view on Meta::CPAN
{
'description' => 'whether to add the /suite to be explicit about where apt needs to look for packages.',
'type' => 'leaf',
'upstream_default' => '0',
'value_type' => 'boolean'
},
'unpack',
{
'convert' => 'lc',
'migrate_from' => {
'formula' => '$old',
'variables' => {
'old' => '- forceunpack'
}
},
'summary' => 'extract all downloaded archives',
'type' => 'leaf',
'upstream_default' => '1',
'value_type' => 'boolean'
},
'sections',
t/check_list.t view on Meta::CPAN
},
refer_to_2_list => {
type => 'check_list',
refer_to => '- my_hash + - my_hash2 + - my_hash3'
},
refer_to_check_list_and_choice => {
type => 'check_list',
computed_refer_to => {
formula => '- refer_to_2_list + - $var',
variables => { var => '- indirection ' },
},
choice => [qw/A1 A2 A3/],
},
indirection => { type => 'leaf', value_type => 'string' },
dumb_list => {
type => 'list',
cargo => { type => 'leaf', value_type => 'string' }
$model->augment_config_class(
name => 'Master',
element => [
# uses to test .set_to_std_value
two => {
type => 'leaf',
value_type => 'uniline',
compute => {
allow_override => 1,
use_eval => 1,
formula => '1+1;'
}
},
]
);
my $inst = $model->instance(
root_class_name => 'Master',
instance_name => 'test1'
);
ok( $inst, "created dummy instance" );
t/recursive_warp_value.t view on Meta::CPAN
follow => '- macro',
rules => [
A => { default => 'm1_A' },
B => { default => 'm1_B' },
C => { default => 'm1_C' } ] }
},
compute => {
type => 'leaf',
value_type => 'string',
compute => {
formula => 'macro is $m, my slot is &slot',
variables => { 'm' => '! macro'}
}
},
# second level warp (kinda recursive and scary ...)
m2a => {
type => 'leaf',
value_type => 'string',
warp => {
follow => '- m1',
t/smooth_upgrade.t view on Meta::CPAN
choice => [qw/cds perl ini custom/],
status => 'deprecated',
description => 'deprecated_p is replaced by new_from_deprecated',
},
'new_from_deprecated' => {
type => 'leaf',
value_type => 'enum',
choice => [qw/cds_file perl_file ini_file augeas custom/],
migrate_from => {
formula => '$replace{$old}',
variables => { old => '- deprecated_p' },
replace => {
perl => 'perl_file',
ini => 'ini_file',
cds => 'cds_file',
},
},
},
'hidden_p' => {
t/smooth_upgrade.t view on Meta::CPAN
'old_url' => {
type => 'leaf',
value_type => 'uniline',
status => 'deprecated',
},
'host' => {
type => 'leaf',
value_type => 'uniline',
mandatory => 1,
migrate_from => {
formula => '$old =~ m!http://([\w\.]+)!; $1 ;',
variables => { old => '- old_url' },
use_eval => 1,
},
},
'port' => {
type => 'leaf',
value_type => 'uniline',
migrate_from => {
formula => '$old =~ m!http://[\w\.]+:(\d+)!; $1 ;',
variables => { old => '- old_url' },
use_eval => 1,
},
},
'path' => {
type => 'leaf',
value_type => 'uniline',
migrate_from => {
formula => '$old =~ m!http://[\w\.]+(?::\d+)?(/.*)!; $1 ;',
variables => { old => '- old_url' },
use_eval => 1,
},
},
],
);
my $inst = $model->instance(
root_class_name => 'Master',
t/value_compute.t view on Meta::CPAN
Test::Log::Log4perl-> ignore_priority('INFO');
$model->create_config_class(
name => "Slave",
element => [
find_node_element_name => {
type => 'leaf',
value_type => 'string',
compute => {
formula => '&element(-)',
},
},
location_function_in_formula => {
type => 'leaf',
value_type => 'string',
compute => {
formula => '&location',
},
},
check_node_element_name => {
type => 'leaf',
value_type => 'boolean',
compute => {
formula => '"&element(-)" eq "foo2"',
},
},
[qw/av bv/] => {
type => 'leaf',
value_type => 'integer',
compute => {
variables => { p => '! &element' },
formula => '$p',
},
},
Licenses => {
type => 'hash',
index_type => 'string',
cargo => {
type => 'node',
config_class_name => 'LicenseSpec'
}
},
] );
# Tx to Ilya Arosov
$model->create_config_class(
'name' => 'TestIndex',
'element' => [
name => {
'type' => 'leaf',
'value_type' => 'uniline',
'compute' => {
'formula' => '$my_name is my name',
'variables' => {
'my_name' => '! index_function_target:&index(-) name'
}
},
} ] );
$model->create_config_class(
'name' => 'TargetIndex',
'element' => [
name => {
t/value_compute.t view on Meta::CPAN
'element' => [
'text',
{
'value_type' => 'string',
'type' => 'leaf',
'compute' => {
'replace' => {
'GPL-1+' => "yada yada GPL-1+\nyada yada",
'Artistic' => "yada yada Artistic\nyada yada",
},
'formula' => '$replace{&index(-)}',
'allow_override' => '1',
undef_is => '',
},
},
short_name_from_index => {
'type' => 'leaf',
'value_type' => 'string',
compute => {
'formula' => '&index( - );',
'use_eval' => 1,
},
},
short_name_from_above1 => {
'type' => 'leaf',
'value_type' => 'uniline',
compute => {
'formula' => '&element( - - )',
},
},
short_name_from_above2 => {
'type' => 'leaf',
'value_type' => 'uniline',
compute => {
'formula' => '&element( -- )',
},
},
short_name_from_above3 => {
'type' => 'leaf',
'value_type' => 'uniline',
compute => {
'formula' => '&element( -2 )',
},
},
]
);
$model->create_config_class(
name => "Master",
element => [
[qw/av bv/] => {
type => 'leaf',
class => 'Config::Model::Value',
value_type => 'integer',
},
compute_int => {
type => 'leaf',
class => 'Config::Model::Value',
value_type => 'integer',
compute => {
formula => '$a + $b',
variables => { a => '- av', b => '- bv' }
},
min => -4,
max => 4,
},
[qw/sav sbv/] => {
type => 'leaf',
class => 'Config::Model::Value',
value_type => 'string',
},
one_var => {
type => 'leaf',
class => 'Config::Model::Value',
value_type => 'string',
compute => {
formula => '&element().$bar',
variables => { bar => '- sbv' }
},
},
one_wrong_var => {
type => 'leaf',
class => 'Config::Model::Value',
value_type => 'string',
compute => {
formula => '$bar',
variables => { bar => '- wrong_v' }
},
},
meet_test => {
type => 'leaf',
class => 'Config::Model::Value',
value_type => 'string',
compute => {
formula => 'meet $a and $b',
variables => { a => '- sav', b => '- sbv' }
},
},
compute_with_override => {
type => 'leaf',
class => 'Config::Model::Value',
value_type => 'integer',
compute => {
formula => '$a + $b',
variables => { a => '- av', b => '- bv' },
allow_override => 1,
},
min => -4,
max => 4,
},
compute_with_warning => {
type => 'leaf',
class => 'Config::Model::Value',
value_type => 'integer',
compute => {
formula => '$a + $b',
variables => { a => '- av', b => '- bv' },
allow_override => 1,
},
warn_if => {
positive_test => {
code => 'defined $_ && $_ < 0;',
msg => 'should be positive',
fix => '$_ = 0;'
}
},
min => -4,
max => 4,
},
compute_with_override_and_fix => {
type => 'leaf',
class => 'Config::Model::Value',
value_type => 'uniline',
compute => {
formula => 'def value',
allow_override => 1,
},
warn_unless => {
device_file => {
code => 'm/def/;',
msg => "not default value",
fix => '$_ = undef;'
}
}
},
# emulate imon problem where /dev/lcd0 is the default value and may not be found
compute_with_override_and_powerless_fix => {
type => 'leaf',
class => 'Config::Model::Value',
value_type => 'uniline',
compute => {
formula => q"my $l = '/dev/lcd-imon'; -e $l ? $l : '/dev/lcd0';",
use_eval => 1,
allow_override => 1,
},
warn_if => {
not_lcd_imon => {
code => q!my $l = '/dev/lcd-imon';defined $_ and -e $l and $_ ne $l ;!,
msg => "not lcd-foo.txt",
fix => '$_ = undef;'
},
},
t/value_compute.t view on Meta::CPAN
msg => "not good value",
fix => '$_ = undef;'
}
}
},
compute_with_upstream => {
type => 'leaf',
class => 'Config::Model::Value',
value_type => 'integer',
compute => {
formula => '$a + $b',
variables => { a => '- av', b => '- bv' },
use_as_upstream_default => 1,
},
},
compute_no_var => {
type => 'leaf',
value_type => 'string',
compute => { formula => '&element()', },
},
[qw/bar foo2/] => {
type => 'node',
config_class_name => 'Slave'
},
'url' => {
type => 'leaf',
value_type => 'uniline',
},
'host' => {
type => 'leaf',
value_type => 'uniline',
compute => {
formula => '$url =~ m!http://([\w\.]+)!; $1 ;',
variables => { url => '- url' },
use_eval => 1,
},
},
'with_tmp_var' => {
type => 'leaf',
value_type => 'uniline',
compute => {
formula => 'my $tmp = $url; $tmp =~ m!http://([\w\.]+)!; $1 ;',
variables => { url => '- url' },
use_eval => 1,
},
},
'Upstream-Contact' => {
'cargo' => {
'value_type' => 'uniline',
'migrate_from' => {
'formula' => '$maintainer',
'variables' => {
'maintainer' => '- Upstream-Maintainer:&index'
}
},
'type' => 'leaf'
},
'type' => 'list',
},
'Upstream-Maintainer' => {
'cargo' => {
'value_type' => 'uniline',
'migrate_from' => {
'formula' => '$maintainer',
'variables' => {
'maintainer' => '- Maintainer:&index'
}
},
'type' => 'leaf'
},
'status' => 'deprecated',
'type' => 'list'
},
'Maintainer' => {
t/value_compute.t view on Meta::CPAN
'value_type' => 'uniline',
'type' => 'leaf'
},
'type' => 'list',
},
'Source' => {
'value_type' => 'string',
'mandatory' => '1',
'migrate_from' => {
'use_eval' => '1',
'formula' => '$old || $older ;',
undef_is => "''",
'variables' => {
'older' => '- Original-Source-Location',
'old' => '- Upstream-Source'
}
},
'type' => 'leaf',
},
'Source2' => {
'value_type' => 'string',
'mandatory' => '1',
'compute' => {
'use_eval' => '1',
'formula' => '$old || $older ;',
undef_is => "''",
'variables' => {
'older' => '- Original-Source-Location',
'old' => '- Upstream-Source'
}
},
'type' => 'leaf',
},
[qw/Upstream-Source Original-Source-Location/] => {
'value_type' => 'string',
t/value_compute.t view on Meta::CPAN
'config_class_name' => 'TestIndex',
'type' => 'node'
},
},
'OtherMaintainer' => { type => 'leaf', value_type => 'uniline' },
'Vcs-Browser' => {
'type' => 'leaf',
'value_type' => 'uniline',
'compute' => {
'allow_override' => '1',
'formula' =>
'$maintainer =~ /pkg-(perl|ruby-extras)/p ? "http://anonscm.debian.org/gitweb/?p=${^MATCH}/packages/$pkgname.git" : undef ;',
'use_eval' => '1',
'variables' => {
'maintainer' => '- OtherMaintainer',
'pkgname' => '- Source'
} }
},
# see Debian bug https://bugs.debian.org/1015913
'Source-with-dir-problem' => {
'type' => 'leaf',
'value_type' => 'uniline',
'compute' => {
'allow_override' => '1',
'formula' => 'use Cwd; getcwd =~ m!/booya(\w[\w+\-\.]{1,})$!; $1;',
'use_eval' => '1'
},
# kinda impossible, but that's the point
'match' => 'booya',
mandatory => 1,
},
] );
my $inst = $model->instance(
t/value_compute.t view on Meta::CPAN
no warnings qw/once/;
$::RD_HINT = 1 if $args->{'rd-hint'};
$::RD_TRACE = 1 if $args->{'rd-trace'};
}
my $object = $root->fetch_element('one_var');
my $rules = { bar => '- sbv', };
my $srules = { bv => 'rbv' };
my $ref = $parser->pre_value( '$bar', 1, $object, $rules, $srules );
is( $$ref, '$bar', "test pre_compute parser on a very small formula: '\$bar'" );
$ref = $parser->value( '$bar', 1, $object, $rules, $srules );
is( $$ref, undef, "test compute parser on a very small formula with undef variable" );
$root->fetch_element('sbv')->store('bv');
$ref = $parser->value( '$bar', 1, $object, $rules, $srules );
is( $$ref, 'bv', "test compute parser on a very small formula: '\$bar'" );
$ref = $parser->pre_value( '$replace{$bar}', 1, $object, $rules, $srules );
is( $$ref, '$replace{$bar}', "test pre-compute parser with substitution" );
$ref = $parser->value( '$replace{$bar}', 1, $object, $rules, $srules );
is( $$ref, 'rbv', "test compute parser with substitution" );
my $txt = 'my stuff is $bar, indeed';
$ref = $parser->pre_compute( $txt, 1, $object, $rules, $srules );
is( $$ref, $txt, "test pre_compute parser with a string" );
t/value_compute.t view on Meta::CPAN
$code =~ s/&location\(\)/$object->location/e;
is( $$ref, $code, "test pre_compute parser with code" );
$ref = $parser->compute( $txt, 1, $object, $rules, $srules );
is( $$ref, 'my stuff is bv, indeed', "test compute parser with a string" );
$txt = 'local stuff is element:&element!';
$ref = $parser->pre_compute( $txt, 1, $object, $rules, $srules );
is( $$ref, 'local stuff is element:one_var!', "test pre_compute parser with function (&element)" );
# In fact, function is formula is handled only by pre_compute.
$ref = $parser->compute( $txt, 1, $object, $rules, $srules );
is( $$ref, $txt, "test compute parser with function (&element)" );
## test integer formula
my $result = $compute_int->fetch;
is( $result, undef, "test that compute returns undef with undefined variables" );
$av->store(1);
$bv->store(2);
$result = $compute_int->fetch;
is( $result, 3, "test result : computed integer is $result (a: 1, b: 2)" );
eval { $compute_int->store(4); };
t/value_compute.t view on Meta::CPAN
is( $root->grab_value( step => 'Source' ), 'foobar', "check migrate_from with undef_is" );
subtest "check Source2 compute with undef_is" => sub {
my $v;
my $xp = Test::Log::Log4perl->expect([ 'User', (warn => qr/deprecated/) x 2]);
$v = $root->grab_value( step => 'Source2' );
is( $v, 'foobar', "check result of compute with undef_is" );
};
foreach (qw/bar foo2/) {
my $path = "$_ location_function_in_formula";
is( $root->grab_value($path), $path, "check &location with $path" );
}
# test formula with tmp variable
my $tmph = $root->fetch_element('with_tmp_var');
is( $tmph->fetch, 'foo.bar', "check extracted host with temp variable" );
my $lic_gpl = $root->grab('Licenses:"GPL-1+"');
is( $lic_gpl->grab_value('text'), "yada yada GPL-1+\nyada yada",
"check replacement with &index()" );
is( $lic_gpl->grab('text')->fetch_custom, undef,
"check computed custom value" );
t/value_compute.t view on Meta::CPAN
"Bond007 is my name",
'variable with &index(-)'
);
$root->load(
'OtherMaintainer="Debian Ruby Extras Maintainers <pkg-ruby-extras-maintainers@lists.alioth.debian.org>" Source=ruby-pygments.rb'
);
is(
$root->grab_value("Vcs-Browser"),
'http://anonscm.debian.org/gitweb/?p=pkg-ruby-extras/packages/ruby-pygments.rb.git',
'test compute with complex regexp formula'
);
$root->store_element_value("Vcs-Browser",undef);
$root->load(
'OtherMaintainer="Debian Perl Group <pkg-perl-maintainers@lists.alioth.debian.org>" Source=libconfig-model-perl'
);
is(
$root->grab_value("Vcs-Browser"),
'http://anonscm.debian.org/gitweb/?p=pkg-perl/packages/libconfig-model-perl.git',
'test compute with complex regexp formula'
);
$root->store_element_value("Vcs-Browser",'');
is(
$root->grab_value("Vcs-Browser"),
'http://anonscm.debian.org/gitweb/?p=pkg-perl/packages/libconfig-model-perl.git',
'test compute with complex regexp formula'
);
# Debian #810768, test a variable containing quote
$root->load(
q!OtherMaintainer="Bla Bla O'bla <pkg-perl-maintainers@lists.alioth.debian.org>" Source=libconfig-model-perl!
);
is(
$root->grab_value("Vcs-Browser"),
'http://anonscm.debian.org/gitweb/?p=pkg-perl/packages/libconfig-model-perl.git',
'test compute with complex regexp formula'
);
subtest "check warning with computed value and overide" => sub {
my $xp = Test::Log::Log4perl->expect([ 'User', warn => qr/should be positive/ ]);
my $cww = $root->fetch_element('compute_with_warning');
$av->store(-2);
$bv->store(-1);
$cww->fetch;
is($cww->has_warning, 1, "check has_warning after check");
is($cww->perform_compute, -3);
t/value_refer_to.t view on Meta::CPAN
element => [
host => {
type => 'leaf',
value_type => 'reference',
refer_to => '! host'
},
if => {
type => 'leaf',
value_type => 'reference',
computed_refer_to => {
formula => ' ! host:$h if ',
variables => { h => '- host' }
}
},
ip => {
type => 'leaf',
value_type => 'string',
compute => {
formula => '$ip',
variables => {
ip => '! host:$h if:$card ip',
h => '- host',
card => '- if'
}
}
}
]
);
t/warped_value.t view on Meta::CPAN
big_compute => {
type => 'hash',
index_type => 'string',
cargo => {
type => 'leaf',
value_type => 'string',
compute => {
variables => {
'm' => '! macro',
},
formula => 'macro is $m, my idx: &index, '
. 'my element &element, '
. 'upper element &element( - ), '
. 'up idx &index( - )',
}
},
},
big_replace => {
type => 'leaf',
value_type => 'string',
compute => {
formula => 'trad idx $replace{&index(-)}',
replace => {
l1 => 'level1',
l2 => 'level2'
} }
},
[qw/bar foo foo2/] => {
type => 'node',
config_class_name => 'Slave'
},
macro_replace => {
type => 'hash',
index_type => 'string',
cargo => {
type => 'leaf',
value_type => 'string',
compute => {
formula => 'trad macro is $replace{$m}',
variables => { 'm' => '! macro', },
replace => {
A => 'macroA',
B => 'macroB',
C => 'macroC'
},
}
},
}
],
t/warped_value.t view on Meta::CPAN
B => {
default => 'Bv',
level => 'normal',
choice => [qw/Av Bv Cv/] } }
},
},
Comp => {
type => 'leaf',
value_type => 'string',
compute => {
formula => 'macro is $m',
variables => { 'm' => '- - macro' },
},
},
warped_by_location => {
type => 'leaf',
value_type => 'uniline',
default => 'slaved',
warp => {
rules => [ '&location =~ /recursive/', { 'default' => 'rslaved' } ]
},
t/warped_value.t view on Meta::CPAN
C => {
choice => [qw/Cv/],
level => 'normal',
help => { Cv => 'Cv help' },
} ] }
},
'compute' => {
type => 'leaf',
value_type => 'string',
compute => {
formula => 'macro is $m, my element is &element',
variables => { 'm' => '! macro' },
},
},
'var_path' => {
type => 'leaf',
value_type => 'string',
mandatory => 1, # will croak if value cannot be computed
compute => {
formula => 'get_element is $replace{$s}, indirect value is \'$v\'',
variables => {
's' => '! $where',
where => '! where_is_element',
v => '! $replace{$s}',
},
replace => {qw/m_value_element m_value compute_element compute/} }
},
'class' => {
type => 'hash',
t/warped_value.t view on Meta::CPAN
'follow' => { 'c_a_check' => '- ClientAliveCheck' },
'rules' => [ '$c_a_check == 1', { 'level' => 'normal' } ]
},
'type' => 'leaf'
},
# a bit dumb, but required to test warp from computed value
'compute_simple' => {
type => 'leaf',
value_type => 'string',
compute => {
formula => 'my element is &element',
},
},
warped_from_computed_value => {
type => 'leaf',
value_type => 'string',
level => 'hidden',
default => 'hello',
warp => {
follow => { c => '- compute_simple' },
rules => [ '$c =~ /simple/' => { level => 'normal', }, ]
t/warped_value.t view on Meta::CPAN
],
"check names of values using 'macro' element"
);
Config::Model::Exception::Any->Trace(1);
throws_ok { $root->fetch_element('var_path')->fetch; }
qr/'! where_is_element' is undef/,
'reading var_path while where_is_element variable is undef';
# set one variable of the formula
$root->fetch_element('where_is_element')->store('get_element');
is( $root->fetch_element('var_path')->fetch(check => 'no'), undef, 'reading var_path while where_is_element is defined' );
throws_ok { $root->fetch_element('var_path')->fetch; }
qr/Undefined mandatory value/, 'reading var_path while get_element variable is undef';
# set the other variable of the formula
$root->fetch_element('get_element')->store('m_value_element');
is(
$root->fetch_element('var_path')->fetch(),
'get_element is m_value, indirect value is \'Cv\'',
"reading var_path through m_value element"
);
# modify the other variable of the formula
$root->fetch_element('get_element')->store('compute_element');
is(
$root->fetch_element('var_path')->fetch(),
'get_element is compute, indirect value is \'macro is C, my element is compute\'',
"reading var_path through compute element"
);
$root->fetch_element('ClientAliveCheck')->store(0);
( run in 0.347 second using v1.01-cache-2.11-cpan-26ccb49234f )