view release on metacpan or  search on metacpan

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

    }
    elsif ( $dup eq 'warn' ) {
        $logger->debug("warning condition: found duplicate @issues");
        push @$warn, "Duplicated value: @issues";
        $self->add_fixes( scalar @issues);
    }
    elsif ( $dup eq 'suppress' ) {
        $logger->debug("suppressing duplicates @issues");
        for (reverse @to_delete) { $self->remove($_) }
    }
    else {
        die "Internal error: duplicates is $dup";
    }
    return;
}

sub fetch_with_id ($self, @args) {
    my %args = _resolve_arg_shortcut(\@args, 'index');
    my $check = $self->_check_check( $args{check} );
    my $idx   = $args{index};

    $logger->trace( $self->name, " called for idx $idx" ) if $logger->is_trace;

    $idx = $self->{convert_sub}($idx)
        if ( defined $self->{convert_sub} and defined $idx );

    # try migration only once
    $self->_migrate unless $self->{migration_done};

    my $ok = 1;

    # check index only if it's unknown
    $ok = $self->check_idx( index => $idx, check => $check )
        unless $self->_defined($idx)
        or $check eq 'no';

    if ( $ok or $check eq 'no' ) {
        # create another method
        $self->create_default_content($idx); # no-op if idx exists

        $self->auto_vivify($idx) unless $self->_defined($idx);
        return $self->_fetch_with_id($idx);
    }
    else {
        Config::Model::Exception::WrongValue->throw(
            error  => join( "\n\t", @{ $self->{idx_error_list} } ),
            object => $self
        );
    }

    return;
}

sub get ($self, @args) {
    my %args = _resolve_arg_shortcut(\@args, 'path');
    my $path    = delete $args{path};
    my $autoadd = 1;
    $autoadd = $args{autoadd} if defined $args{autoadd};
    my $get_obj = delete $args{get_obj} || 0;
    $path =~ s!^/!!;
    my ( $item, $new_path ) = split m!/!, $path, 2;

    my $dcm = $args{dir_char_mockup};

    # $item =~ s($dcm)(/)g if $dcm ;
    if ($dcm) {
        while (1) {
            my $i = index( $item, $dcm );
            last if $i == -1;
            substr $item, $i, length($dcm), '/';
        }
    }

    return unless ( $self->exists($item) or $autoadd );

    $logger->trace("get: path $path, item $item");

    my $obj = $self->fetch_with_id( index => $item, %args );
    return $obj if ( ( $get_obj or $obj->get_type ne 'leaf' ) and not defined $new_path );
    return $obj->get( path => $new_path, get_obj => $get_obj, %args );
}

sub set ($self, $path, @args) {
    $path =~ s!^/!!;
    my ( $item, $new_path ) = split m!/!, $path, 2;
    return $self->fetch_with_id($item)->set( $new_path, @args );
}

sub copy ( $self, $from, $to ) {

    Config::Model::Exception::User->throw(
        object  => $self,
        message => "move: unknow from key $from"
    ) unless $self->exists($from);

    my $from_obj = $self->fetch_with_id($from);
    my $ok       = $self->check_idx($to);

    if ( $ok && $self->{cargo}{type} eq 'leaf' ) {
        $logger->trace( "AnyId: copy leaf value from " . $self->name . " $from to $to" );
        return $self->fetch_with_id($to)->store( $from_obj->fetch() );
    }
    elsif ($ok) {

        # node object
        $logger->trace( "AnyId: deep copy node from " . $self->name );
        my $target = $self->fetch_with_id($to);
        $logger->trace( "AnyId: deep copy node to " . $target->name );
        return $target->copy_from($from_obj);
    }
    else {
        Config::Model::Exception::WrongValue->throw(
            error  => join( "\n\t", @{ $self->{idx_error_list} } ),
            object => $self
        );
    }
    return;
}

sub fetch_all {
    my $self = shift;
    my @keys = $self->fetch_all_indexes;
    return map { $self->fetch_with_id($_); } @keys;
}

sub fetch_size {
    my $self = shift;
    return scalar $self->fetch_all_indexes;
}

sub fetch ($self, @args) {
    return join(',', $self->fetch_all_values(@args) );
}

sub fetch_value ($self, @args) {
    my %args = _resolve_arg_shortcut(\@args, 'idx');
    return $self->_fetch_value(%args, sub => 'fetch');
}

sub fetch_summary ($self, @args) {
    my %args = _resolve_arg_shortcut(\@args, 'idx');
    return $self->_fetch_value(%args, sub => 'fetch_summary');
}

sub _fetch_value ($self, %args) {