Data-Model

 view release on metacpan or  search on metacpan

lib/Data/Model/Driver/Memory.pm  view on Meta::CPAN

        my $results = $self->fetch($schema, $id);
        next unless $results;        
        $resultlist{$key} = $results->[0];
    }
    \%resultlist;
}

sub get {
    my $self = shift;
    my $results = $self->fetch(@_);
    return unless $results;
    return $self->_generate_result_iterator($results), +{};
}

sub set {
    my($self, $schema, $key, $columns, %args) = @_;

    # initilaize

    # check unique
    if (@{ $schema->key } && grep { defined $_ } @{ $key }) {
        my $result_id_list = $self->get_record_id_list($schema, $key, +{});
        Carp::croak 'not unique columns' if @{ $result_id_list };
    }
    if (scalar(%{ $schema->unique })) {
        while (my($unique_name, $unique_columns) = each %{ $schema->unique }) {
            my $index = [];
            for my $column (@{ $unique_columns }) {
                push @{ $index }, $columns->{$column};
            }
            my $result_id_list = $self->get_record_id_list($schema, undef, +{ index => { $unique_name => $ index } });
            Carp::croak 'not unique columns' if @{ $result_id_list };
        }
    }

    # delete old record

    # record_id
    my $record_id = $self->generate_record_id($schema);

    # auto_increment
    if ($self->_set_auto_increment($schema, $columns, sub { $self->generate_auto_increment($schema) })) {
        # remake $key
        $key = $schema->get_key_array_by_hash($columns);
    }

    # write to index, key and unique
    $self->set_memory_index($schema, $key, $columns, $record_id);

    # write data
    my $data = $self->load_data($schema);
    $data->{records}->{$record_id} = +{ %{ $columns } };
}

sub replace {
    my($self, $schema, $key, $columns, %args) = @_;
    $self->delete($schema, $key, +{}, %args);
    $self->set($schema, $key, $columns, %args);
}

sub update {
    my($self, $schema, $old_key, $key, $old_columns, $columns, $changed_columns, %args) = @_;

    # fetch record id
    my $result_id_list = $self->get_record_id_list($schema, $old_key, +{});
    return unless $result_id_list && @{ $result_id_list };
    return if @{ $result_id_list } != 1; # not unique key
    my $id = $result_id_list->[0];

    # reindex
    $self->delete_memory_index($schema, $old_key, $old_columns, $id);
    $self->set_memory_index($schema, $key, $columns, $id);

    # set data
    my $data = $self->load_data($schema);
    $data->{records}->{$id} = +{ %{ $columns } };
}

sub _uodate_delete_visitor {
    my($self, $schema, $key, $query, $code) = @_;

    # fetch record id
    my $result_id_list = $self->get_record_id_list($schema, $key, $query);
    return unless $result_id_list && @{ $result_id_list };

    my $results = $self->get_result_list($schema, $query, $result_id_list);
    return unless $results && @{ $results };

    # delete data
    my $data = $self->load_data($schema);
    my @rows;
    for my $id ( map { $_->[0] } @{ $results }) {
        my @ret = $code->($data, $id);
        push @rows, @ret if @ret;
    }
    return @rows ? [ @rows ] : undef;
}

sub update_direct {
    my($self, $schema, $key, $query, $columns, %args) = @_;

    $self->_uodate_delete_visitor(
        $schema, $key, $query, 
        sub {
            my($data, $id) = @_;
            $self->delete_memory_index($schema, $key, $data->{records}->{$id}, $id);
            while (my($key, $val) = each %{ $columns }) {
                $data->{records}->{$id}->{$key} = $val;
            }
            $key = $schema->get_key_array_by_hash($data->{records}->{$id});
            $self->set_memory_index($schema, $key, $data->{records}->{$id}, $id);
        }
    );
}


sub delete {
    my($self, $schema, $key, $columns, %args) = @_;

    $self->_uodate_delete_visitor(
        $schema, $key, $columns, 
        sub {
            my($data, $id) = @_;
            $self->delete_memory_index($schema, $key, $data->{records}->{$id}, $id);
            delete $data->{records}->{$id};
        }
    );
}

## for memory index

sub get_record_id_list {
    my($self, $schema, $key, $columns) = @_;

    my $result_id_list = [];
    if ($key) {
        $result_id_list = $self->get_memory_index($schema, 'key', undef, $key);
    } else {
        # hash
        $columns ||= +{};
        if (exists $columns->{index} && ref($columns->{index}) eq 'HASH') {
            my($index, $index_key) = %{ $columns->{index} };
            $index_key = [ $index_key ] unless ref($index_key) eq 'ARRAY';
            for my $index_type (qw/ unique index /) {
                if (exists $schema->$index_type->{$index}) {
                    $result_id_list = $self->get_memory_index($schema, $index_type, $index, $index_key);
                    last;
                }
            }
        } else {
            my $data = $self->load_data($schema);
            $result_id_list = [
                sort { $a <=> $b } keys %{ $data->{records} }
            ];
        }
    }
    $result_id_list;
}



( run in 0.542 second using v1.01-cache-2.11-cpan-5511b514fd6 )