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 )