1 package DBIx::Data::Collection::Set;
4 use Method::Signatures::Simple;
5 use Data::Perl::Stream::Array;
6 use Data::Perl::Collection::Set;
7 use Scalar::Util qw(weaken refaddr);
12 _inflate => 'inflate',
13 _deflate => 'deflate',
15 _refresh => 'refresh',
16 _deflate_spec => 'deflate_spec',
17 _merge_spec => 'merge_spec',
20 require DBIx::Data::Store::SimpleInflator;
22 $args->{class} = $self->_class if $self->_has_class;
23 DBIx::Data::Store::SimpleInflator->new($args)
27 has _store => (is => 'ro', required => 1, init_arg => 'store');
29 has _class => (is => 'ro', predicate => '_has_class', init_arg => 'class');
31 has _set_over => (is => 'ro', required => 1, init_arg => 'set_over');
33 ## member cache (all members)
35 has _member_cache => (
36 is => 'ro', lazy_build => 1,
37 predicate => '_member_cache_built',
38 writer => '_set_member_cache',
41 method _build__member_cache {
42 my $stream = $self->_new_raw_stream;
44 while (my ($raw) = $stream->next) {
46 if (my ($obj) = $self->_key_cache_get_raw($raw)) {
47 # can't just $self->_merge($obj, $raw) since $obj might have changed
48 $self->_refresh($obj, $raw)
50 $self->_add_to_key_cache($self->_inflate($raw))
55 $self->_notify_observers(all_members => \@cache);
59 method _add_to_member_cache ($to_add) {
60 return $to_add unless $self->_member_cache_built;
61 push @{$self->_member_cache}, $to_add;
65 method _remove_from_member_cache ($to_remove) {
66 return $to_remove unless $self->_member_cache_built;
67 @{$self->_member_cache} = grep $_ ne $to_remove, @{$self->_member_cache};
71 ## key cache - by primary/unique key
73 has _key_cache => (is => 'ro', default => sub { {} });
75 method _add_to_key_cache ($to_add) {
76 $self->_key_cache->{$self->_object_to_id($to_add)} = $to_add;
80 method _remove_from_key_cache ($to_remove) {
81 # should return $to_remove
82 delete $self->_key_cache->{$self->_object_to_id($to_remove)}
85 method _key_cache_has_raw ($raw) {
86 exists $self->_key_cache->{$self->_raw_to_id($raw)}
89 method _key_cache_has_object ($obj) {
90 exists $self->_key_cache->{$self->_object_to_id($obj)}
93 method _key_cache_get_raw ($raw) {
94 $self->_key_cache_get_id($self->_raw_to_id($raw))
97 method _key_cache_get_object ($obj) {
98 $self->_key_cache_get_id($self->_object_to_id($obj))
101 method _key_cache_get_object_spec ($spec) {
102 # see _object_spec_to_id for doc of what the difference is
103 $self->_key_cache_get_id($self->_object_spec_to_id($spec))
106 method _key_cache_get_id ($id) {
107 exists $self->_key_cache->{$id}
108 ? ($self->_key_cache->{$id})
112 method _all_key_cache_members {
113 values %{$self->_key_cache}
116 method _set_key_cache_members ($members) {
117 %{$self->_key_cache} = (map +($self->_object_to_id($_) => $_), @$members);
123 has _observer_callbacks => (
124 is => 'ro', default => sub { {} },
127 method _notify_observers ($event, $payload) {
128 my $oc = $self->_observer_callbacks;
129 foreach my $refaddr (keys %$oc) {
130 my ($obj, $cb) = @{$oc->{$refaddr}};
131 unless (defined $obj) { # weak ref was garbage collected
132 delete $oc->{$refaddr};
135 $obj->$cb($self, $event, $payload);
140 method _register_observer ($obj, $cb) {
141 my $entry = [ $obj, $cb ];
143 $self->_observer_callbacks->{refaddr($obj)} = $entry;
147 method _setup_observation_of ($other) {
148 $other->_register_observer($self, method ($from, $event, $payload) {
149 if ($event eq 'add' or $event eq 'get') {
150 $self->_add_to_caches($payload);
151 } elsif ($event eq 'remove') {
152 $self->_remove_from_caches($payload);
153 } elsif ($event eq 'all_members') {
154 # separate arrayref since future add will trigger push()
155 $self->_set_caches([ @$payload ]);
162 ## methods to get ids
164 method _raw_to_id ($raw) {
165 # XXX must escape this. or do something else.
166 join ';', map $raw->{$_}, @{$self->_set_over}
169 method _object_to_id ($obj) {
170 $self->_raw_to_id($self->_deflate($obj))
173 method _object_spec_to_id ($spec) {
174 # intentionally C&P from _raw_to - this is not the same thing. If a column
175 # were mapped to an attribute of a different name, the raw would have the
176 # column name as a key but an object spec would have the attribute name
177 join ';', map $spec->{$_}, @{$self->_set_over}
180 ## array-ish operations - i.e. get all members
182 method _new_raw_stream {
183 $self->_store->new_select_command({})->execute
187 @{$self->_member_cache};
191 Data::Perl::Stream::Array->new(array => $self->_member_cache);
194 # theoretically inefficient except that if we're being asked this then
195 # either the data should have been pre-loaded or we're going to get all
199 scalar $self->flatten
203 Data::Perl::Collection::Set->new(
204 members => [ map $sub->($_), $self->flatten ]
208 method _set_caches ($members) {
209 $self->_set_member_cache($members);
210 $self->_set_key_cache_members($members);
217 if (my ($got) = $self->_key_cache_get_object_spec($spec)) {
220 if (my ($raw) = $self->_get_from_store($self->_deflate_spec($spec))) {
221 return $self->_notify_observers(
222 get => $self->_add_to_key_cache($self->_inflate($raw))
225 return undef # we aren't handling cache misses here yet
228 method _get_from_store ($raw) {
229 $self->_store->new_select_single_command($raw)->execute
235 $self->_add_to_store($new);
236 $self->_add_to_caches($new);
237 $self->_notify_observers(add => $new);
241 method _add_to_store ($new) {
242 my $new_raw = $self->_deflate($new);
243 $self->_merge($new, $self->_store->new_insert_command($new_raw)->execute);
247 method _add_to_caches ($new) {
248 $self->_add_to_member_cache($new);
249 $self->_add_to_key_cache($new);
255 method remove ($old) {
256 $self->_remove_from_store($old);
257 $self->_remove_from_caches($old);
258 $self->_notify_observers(remove => $old);
262 method _remove_from_store ($old) {
263 $self->_store->new_delete_single_command($self->_deflate($old))->execute
266 method _remove_from_caches ($old) {
267 $self->_remove_from_member_cache($old);
268 $self->_remove_from_key_cache($old);
274 method _update_in_store ($obj) {
275 # this is currently a call command but we should think about it
276 # being a row command so that we can have RETURNING or other
277 # mechanisms handle things like set-on-update datetime values
278 $self->_store->new_update_single_command($self->_deflate($obj))->execute
281 # I do wonder if we needed _merge_spec or if we'd be better off with
282 # just using the raw merge routine ...
284 method _update_set_in_store ($spec) {
285 $self->_store->new_update_command($self->_deflate_spec($spec))->execute;
286 if ($self->_member_cache_built) {
287 my $cache = $self->_member_cache;
288 foreach my $obj (@{$cache}) {
289 $self->_merge_spec($obj, $spec);
291 $self->_notify_observers(all_members => $cache);
296 method _remove_set_from_store {
297 $self->_store->new_delete_command->execute;
298 $self->_set_caches([]);
299 $self->_notify_observers(all_members => []);