view release on metacpan or  search on metacpan

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

}

sub move_up ($self, $key) {
    if ( not $self->ordered ) {
        $logger->warn("called move_up on unordered hash");
        return;
    }

    Config::Model::Exception::User->throw(
        object  => $self,
        message => "move_up: unknow key $key"
    ) unless exists $self->{data}{$key};

    my $list = $self->{list};

    # we start from 1 as we can't move up idx 0
    for ( my $idx = 1 ; $idx < scalar @$list ; $idx++ ) {
        if ( $list->[$idx] eq $key ) {
            $list->[$idx] = $list->[ $idx - 1 ];
            $list->[ $idx - 1 ] = $key;
            $self->notify_change( note => "moved up key '$key'" );
            last;
        }
    }

    # notify_change is placed in the loop so the notification
    # is not sent if the user tries to move up idx 0
    return;
}

sub move_down ($self, $key) {
    if ( not $self->ordered ) {
        $logger->warn("called move_down on unordered hash");
        return;
    }

    Config::Model::Exception::User->throw(
        object  => $self,
        message => "move_down: unknown key $key"
    ) unless exists $self->{data}{$key};

    my $list = $self->{list};

    # we end at $#$list -1  as we can't move down last idx
    for ( my $idx = 0 ; $idx < scalar @$list - 1 ; $idx++ ) {
        if ( $list->[$idx] eq $key ) {
            $list->[$idx] = $list->[ $idx + 1 ];
            $list->[ $idx + 1 ] = $key;
            $self->notify_change( note => "moved down key $key" );
            last;
        }
    }

    # notify_change is placed in the loop so the notification
    # is not sent if the user tries to move past last idx
    return;
}

sub _load_data_from_hash ($self, %args) {
    my $data = $args{data};
    my %backup = %$data ;

    my @ordered_keys;
    my $from = '';

    my $order_key = '__'.$self->element_name.'_order';
    if ( $self->{ordered} and (defined $data->{$order_key} or defined $data->{__order} )) {
        @ordered_keys = @{ delete $data->{$order_key} or delete $data->{__order} };
        $from      = ' with '.$order_key;
    }
    elsif ( $self->{ordered} and (not $data->{__skip_order} and keys %$data > 1)) {
        $logger->warn(
            "HashId " . $self->location . ": loading ordered "
            . "hash from hash ref without special key '__order'. Element "
            . "order is not defined. If needed, this warning can be suppressed by passing "
            . " key '__skip_order' set to 1."
        );
        $from = ' without '.$order_key;
    }
    delete $data->{__skip_order};

    if (@ordered_keys) {
        my %data_keys = map { $_ => 1 ; } keys %$data;
        my @left_keys;
        foreach my $k (@ordered_keys) {
            push @left_keys, $k unless delete $data_keys{$k};
        }
        if ( %data_keys or @left_keys) {
            my @msg ;
            push @msg, "Unlisted keys in __order:", keys %data_keys if %data_keys;
            push @msg, "Extra keys in __order:", @left_keys if @left_keys;
            Config::Model::Exception::LoadData->throw(
                object     => $self,
                message    => "load_data: ordered keys mistmatch: @msg",
                wrong_data => \%backup,
            );
        }
    }
    my @load_keys = @ordered_keys ? @ordered_keys : sort keys %$data;

    $logger->info(
        "HashId load_data (" . $self->location .
            ") will load idx @load_keys from hash ref $from"
    );
    my $res = 0;
    foreach my $elt (@load_keys) {
        my $obj = $self->fetch_with_id($elt);
        $res += $obj->load_data( %args, data => $data->{$elt} ) if defined $data->{$elt};
    }
    return !!$res;
}

sub load_data ($self, @args) {
    my %args = @args > 1 ? @args : ( data => $args[0] );
    my $data  = delete $args{data};
    my $check = $self->_check_check( $args{check} );

    if ( ref($data) eq 'HASH' ) {
        return $self->_load_data_from_hash(data => $data, %args);
    }
    elsif ( ref($data) eq 'ARRAY' ) {
        my $res = 0;
        $logger->info(
            "HashId load_data (" . $self->location . ") will load idx 0..$#$data from array ref" );
        $self->notify_change( note => "Converted ordered data to non ordered", really => 1) unless $self->ordered;
        my $idx = 0;
        while ( $idx < @$data ) {
            my $elt = $data->[ $idx++ ];
            my $obj = $self->fetch_with_id($elt);
            $res += $obj->load_data( %args, data => $data->[ $idx++ ] );
        }
        return !!$res;
    }
    elsif ( defined $data ) {

        # we can skip undefined data
        my $expected = $self->{ordered} ? 'array' : 'hash';
        Config::Model::Exception::LoadData->throw(
            object     => $self,
            message    => "load_data called with non $expected ref arg",
            wrong_data => $data,
        );
    }
    return;
}

__PACKAGE__->meta->make_immutable;

1;

# ABSTRACT: Handle hash element for configuration model

__END__

=pod