view release on metacpan or  search on metacpan

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

has element_name => ( is => 'ro', isa => 'Str' );
has parent       => ( is => 'ro', isa => 'Config::Model::Node', weak_ref => 1 );

has instance     => (
    is => 'ro',
    isa => 'Config::Model::Instance',
    weak_ref => 1,
    handles => [qw/show_message root_path/]
);

# needs_check defaults to 1 to trap undef mandatory values
has needs_check => ( is => 'rw', isa => 'Bool', default => 1 );

# index_value can be written to when move method is called. But let's
# not advertise this feature.
has index_value => (
    is      => 'rw',
    isa     => 'Str',
    trigger => sub ($self, @) { $self->{location} = $self->_location; },
);

has container => ( is => 'ro', isa => 'Ref', required => 1, weak_ref => 1 );

has container_type => ( is => 'ro', isa => 'Str', builder => '_container_type', lazy => 1 );

sub _container_type ($self) {
    my $p    = $self->parent;
    return defined $p
        ? $p->element_type( $self->element_name )
        : 'node';    # root node

}

has root => (
    is       => 'ro',
    isa      => 'Config::Model::Node',
    weak_ref => 1,
    builder  => '_root',
    lazy     => 1
);

sub _root ($self) {
    return $self->parent || $self;
}

has location       => ( is => 'ro', isa => 'Str', builder => '_location', lazy => 1 );
has location_short => ( is => 'ro', isa => 'Str', builder => '_location_short', lazy => 1 );

has backend_support_annotation => (
    is => 'ro',
    isa => 'Bool',
    builder  => '_backend_support_annotation',
    lazy     => 1
);

sub _backend_support_annotation ($self) {
    # this method is overridden in Config::Model::Node
    return $self->parent->backend_support_annotation;
};

has backup => (
    is => 'bare',
    isa => 'Maybe[HashRef]',
);

sub backup ($self) {
    return dclone($self->{backup});
}


sub notify_change ($self, %args) {

    return if $self->instance->initial_load and not $args{really};

    if ($change_logger->is_trace) {
        my @with = map { "'$_' -> '". ($args{$_} // '<undef>') ."'"  } sort keys %args;
        $change_logger->trace("called for ", $self->name, " from ",
                              join( ' ', caller ), " with ", join( ' ', @with ));
    }

    # needs_save may be overridden by caller
    $args{needs_save} //= 1;
    $args{path}       //= $self->location;
    $args{name}       //= $self->element_name if $self->element_name;
    $args{index}      //= $self->index_value if $self->index_value;

    # better use %args instead of @_ to forward arguments. %args eliminates duplicated keys
    $self->container->notify_change(%args);
    return;
}

sub _location ($self) {
    my $str = '';
    $str .= $self->parent->location if defined $self->parent;

    $str .= ' ' if $str;

    $str .= $self->composite_name;

    return $str;
}

sub _location_short ($self) {
    my $str = '';
    $str .= $self->parent->location_short if defined $self->parent;

    $str .= ' ' if $str;

    $str .= $self->composite_name_short;

    return $str;
}

#has composite_name => (is => 'ro', isa => 'Str' , builder => '_composite_name', lazy => 1);

sub composite_name ($self) {
    my $element = $self->element_name;
    $element = '' unless defined $element;

    my $idx = $self->index_value;
    return $element unless defined $idx;
    $idx = '"' . $idx . '"' if $idx =~ /\W/;

    return "$element:$idx";
}

sub composite_name_short ($self) {