has _class => (is => 'ro', predicate => '_has_class');
-has _member_cache => (is => 'rw', lazy_build => 1);
+has _set_over => (is => 'ro', required => 1, init_arg => 'set_over');
+
+## member cache (all members)
+
+has _member_cache => (
+ is => 'rw', lazy_build => 1,
+ predicate => '_member_cache_built',
+);
method _build__member_cache {
my $stream = $self->_new_raw_stream;
my @cache;
while (my ($raw) = $stream->next) {
- push @cache, $self->_inflate($raw);
+ my $obj = do {
+ if (my ($obj) = $self->_key_cache_get_raw($raw)) {
+ $self->_merge($obj, $raw)
+ } else {
+ $self->_inflate($raw)
+ }
+ };
+ push @cache, $obj;
}
\@cache;
}
+method _add_to_member_cache ($to_add) {
+ return unless $self->_member_cache_built;
+ push @{$self->_member_cache}, $to_add;
+}
+
+## key cache - by primary/unique key
+
+has _key_cache => (is => 'ro', default => sub { {} });
+
+method _add_to_key_cache ($to_add) {
+ $self->_key_cache->{$self->_object_to_id($to_add)} = $to_add;
+ return
+}
+
+method _key_cache_has_raw ($raw) {
+ exists $self->_key_cache->{$self->_raw_to_id($raw)}
+}
+
+method _key_cache_has_object ($obj) {
+ exists $self->_key_cache->{$self->_object_to_id($obj)}
+}
+
+method _key_cache_get_raw ($raw) {
+ my $id = $self->_raw_to_id($raw);
+ exists $self->_key_cache->{$id}
+ ? ($self->_key_cache->{$id})
+ : ()
+}
+
+method _key_cache_get_object ($obj) {
+ $self->_key_cache_get_raw($self->_deflate($obj))
+}
+
+## loading data
+
method _new_raw_stream {
$self->_store->new_select_command([])->execute;
}
+## thunking between the store representation and the set representation
+#
+# _inflate is raw data -> final repr
+# _deflate is final repr -> raw data
+# _merge takes final repr + raw data and updates the repr
+# (this is used for pk-generated values and later lazy loading)
+
method _inflate ($raw) {
bless($raw, $self->_class) if $self->_has_class;
$raw;
}
+method _deflate ($obj) {
+ +{ %$obj }
+}
+
+method _merge ($obj, $raw) {
+ @{$obj}{keys %$raw} = values %$raw;
+ $obj;
+}
+
+## methods to get ids
+
+method _raw_to_id ($raw) {
+ # XXX must escape this. or do something else.
+ join ';', map $raw->{$_}, @{$self->_set_over}
+}
+
+method _object_to_id ($obj) {
+ $self->_raw_to_id($self->_deflate($obj));
+}
+
method flatten {
@{$self->_member_cache};
}
Data::Perl::Stream::Array->new(array => $self->_member_cache);
}
+method add ($new) {
+ $self->_add_to_store($new);
+ $self->_add_to_caches($new);
+ $new;
+}
+
+method _add_to_store ($new) {
+ my $new_raw = $self->_deflate($new);
+ $self->_merge($new, $self->_store->new_insert_command($new_raw)->execute);
+ $self->_add_to_caches($new);
+ return
+}
+
+method _add_to_caches ($new) {
+ $self->_add_to_member_cache($new);
+ $self->_add_to_key_cache($new);
+}
+
1;
has "${type}_argument_order" => (is => 'ro', default => sub { [] });
}
+has 'insert_command_constructor' => (is => 'ro');
+
has "select_column_order" => (is => 'ro');
method new_select_command ($args) {
[ @{$args}{@{$self->${\"${type}_argument_order"}}} ]
}
-method _new_call_command ($type, $args) {
+method _new_command ($builder, $type, $args) {
my $has_meth = "has_${type}_sql";
die "${self}->${has_meth}" unless $self->$has_meth;
- $self->raw_store->new_call_command(
+ $self->$builder(
$self->${\"${type}_sql"},
- $self->_unwrap_args_for($type => $args)
+ $self->_unwrap_args_for($type => $args),
+ );
+}
+
+method _new_call_command ($type, $args) {
+ $self->_new_command(
+ sub { shift->raw_store->new_call_command(@_) },
+ $type => $args,
);
}
method new_insert_command ($args) {
- $self->_new_call_command(insert => $args);
+ my $builder = $self->insert_command_constructor;
+ $builder
+ ? $self->_new_command($builder => insert => $args)
+ : $self->_new_call_command(insert => $args);
}
method new_update_command ($args) {
--- /dev/null
+package DBIx::Data::Store::Command::Insert::LastInsertId;
+
+use Moose;
+use Method::Signatures::Simple;
+
+has 'id_column' => (is => 'ro', required => 1);
+
+has 'insert_call_command' => (is => 'ro', required => 1);
+
+has 'raw_store' => (is => 'ro', required => 1);
+
+method execute {
+ $self->insert_call_command->execute;
+ return { $self->id_column => $self->_get_last_insert_id }
+};
+
+method _get_last_insert_id {
+ # this should probably involve some sort of call to the raw
+ # store to get the command object from it, but meh
+ $self->raw_store->connection->run(sub {
+ shift->last_insert_id((undef) x 4)
+ });
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
sub make_set {
my ($set, $crud) = @_;
DBIx::Data::Collection::Set->new(
+ set_over => [ 'id' ],
store => DBIx::Data::Store::CRUD->new(
raw_store => DBIx::Data::Store->connect($dsn),
select_sql => q{SELECT id, name FROM person},
'Basic data with class out ok'
);
+$set = make_set {}, {
+ insert_sql => q{INSERT INTO person (name) VALUES (?) },
+ insert_argument_order => [ 'name' ],
+ insert_command_constructor => sub {
+ require DBIx::Data::Store::Command::Insert::LastInsertId;
+ my $self = shift;
+ DBIx::Data::Store::Command::Insert::LastInsertId->new(
+ id_column => 'id',
+ raw_store => $self->raw_store,
+ insert_call_command => $self->raw_store->new_call_command(@_)
+ );
+ }
+};
+
+my $doug = $set->add({ name => 'Doug' });
+
+use Devel::Dwarn;
+
+Dwarn $doug;
+
done_testing;
projects / dbsrgits/DBIx-Data-Store-old.git / commitdiff