1 package DBIx::Data::Collection::Set;
4 use Method::Signatures::Simple;
5 use Data::Perl::Stream::Array;
6 use Scalar::Util qw(weaken refaddr);
8 has _store => (is => 'ro', required => 1, init_arg => 'store');
10 has _class => (is => 'ro', predicate => '_has_class', init_arg => 'class');
12 has _set_over => (is => 'ro', required => 1, init_arg => 'set_over');
14 ## member cache (all members)
16 has _member_cache => (
17 is => 'ro', lazy_build => 1,
18 predicate => '_member_cache_built',
19 writer => '_set_member_cache',
22 method _build__member_cache {
23 my $stream = $self->_new_raw_stream;
25 while (my ($raw) = $stream->next) {
27 if (my ($obj) = $self->_key_cache_get_raw($raw)) {
28 # can't just $self->_merge($obj, $raw) since $obj might have changed
29 $self->_refresh($obj, $raw)
31 $self->_add_to_key_cache($self->_inflate($raw))
36 $self->_notify_observers(all_members => \@cache);
40 method _add_to_member_cache ($to_add) {
41 return $to_add unless $self->_member_cache_built;
42 push @{$self->_member_cache}, $to_add;
46 method _remove_from_member_cache ($to_remove) {
47 return $to_remove unless $self->_member_cache_built;
48 @{$self->_member_cache} = grep $_ ne $to_remove, @{$self->_member_cache};
52 ## key cache - by primary/unique key
54 has _key_cache => (is => 'ro', default => sub { {} });
56 method _add_to_key_cache ($to_add) {
57 $self->_key_cache->{$self->_object_to_id($to_add)} = $to_add;
61 method _remove_from_key_cache ($to_remove) {
62 # should return $to_remove
63 delete $self->_key_cache->{$self->_object_to_id($to_remove)}
66 method _key_cache_has_raw ($raw) {
67 exists $self->_key_cache->{$self->_raw_to_id($raw)}
70 method _key_cache_has_object ($obj) {
71 exists $self->_key_cache->{$self->_object_to_id($obj)}
74 method _key_cache_get_raw ($raw) {
75 $self->_key_cache_get_id($self->_raw_to_id($raw))
78 method _key_cache_get_object ($obj) {
79 $self->_key_cache_get_id($self->_object_to_id($obj))
82 method _key_cache_get_object_spec ($spec) {
83 # see _object_spec_to_id for doc of what the difference is
84 $self->_key_cache_get_id($self->_object_spec_to_id($spec))
87 method _key_cache_get_id ($id) {
88 exists $self->_key_cache->{$id}
89 ? ($self->_key_cache->{$id})
93 method _all_key_cache_members {
94 values %{$self->_key_cache}
99 has _observer_callbacks => (
100 is => 'ro', default => sub { {} },
103 method _notify_observers ($event, $payload) {
104 my $oc = $self->_observer_callbacks;
105 foreach my $refaddr (keys %$oc) {
106 my ($obj, $cb) = @{$oc->{$refaddr}};
107 unless (defined $obj) { # weak ref was garbage collected
108 delete $oc->{$refaddr};
111 $obj->$cb($self, $event, $payload);
116 method _register_observer ($obj, $cb) {
117 my $entry = [ $obj, $cb ];
119 $self->_observer_callbacks->{refaddr($obj)} = $entry;
123 method _setup_observation_of ($other) {
124 $other->_register_observer($self, method ($from, $event, $payload) {
125 if ($event eq 'add' or $event eq 'get') {
126 $self->_add_to_caches($payload);
127 } elsif ($event eq 'remove') {
128 $self->_remove_from_caches($payload);
129 } elsif ($event eq 'all_members') {
130 # separate arrayref since future add will trigger push()
131 $self->_set_member_cache([ @$payload ]);
137 ## thunking between the store representation and the set representation
139 # _inflate is raw data -> final repr
140 # _deflate is final repr -> raw data
141 # _merge takes final repr + raw data and updates the repr
142 # (this is used for pk-generated values and later lazy loading)
144 # _deflate_spec is attributes of final repr -> raw data
146 method _inflate ($raw) {
147 bless($raw, $self->_class) if $self->_has_class;
151 method _deflate ($obj) {
155 method _merge ($obj, $raw) {
156 @{$obj}{keys %$raw} = values %$raw;
160 method _refresh ($obj, $raw) {
161 # if $obj has been changed but not flushed we'd destroy data doing
162 # a blind merge - but if $obj has change tracking of some sort then
163 # we -could- do something safely, so this method exists to be mangled
168 method _deflate_spec ($spec) {
172 ## methods to get ids
174 method _raw_to_id ($raw) {
175 # XXX must escape this. or do something else.
176 join ';', map $raw->{$_}, @{$self->_set_over}
179 method _object_to_id ($obj) {
180 $self->_raw_to_id($self->_deflate($obj))
183 method _object_spec_to_id ($spec) {
184 # intentionally C&P from _raw_to - this is not the same thing. If a column
185 # were mapped to an attribute of a different name, the raw would have the
186 # column name as a key but an object spec would have the attribute name
187 join ';', map $spec->{$_}, @{$self->_set_over}
190 ## array-ish operations - i.e. get all members
192 method _new_raw_stream {
193 $self->_store->new_select_command([])->execute
197 @{$self->_member_cache};
201 Data::Perl::Stream::Array->new(array => $self->_member_cache);
207 if (my ($got) = $self->_key_cache_get_object_spec($spec)) {
210 if (my ($raw) = $self->_get_from_store($self->_deflate_spec($spec))) {
211 return $self->_notify_observers(
212 get => $self->_add_to_key_cache($self->_inflate($raw))
215 return undef # we aren't handling cache misses here yet
218 method _get_from_store ($raw) {
219 $self->_store->new_select_single_command($raw)->execute
225 $self->_add_to_store($new);
226 $self->_add_to_caches($new);
227 $self->_notify_observers(add => $new);
231 method _add_to_store ($new) {
232 my $new_raw = $self->_deflate($new);
233 $self->_merge($new, $self->_store->new_insert_command($new_raw)->execute);
237 method _add_to_caches ($new) {
238 $self->_add_to_member_cache($new);
239 $self->_add_to_key_cache($new);
245 method remove ($old) {
246 $self->_remove_from_store($old);
247 $self->_remove_from_caches($old);
248 $self->_notify_observers(remove => $old);
252 method _remove_from_store ($old) {
253 $self->_store->new_delete_single_command($self->_deflate($old))->execute
256 method _remove_from_caches ($old) {
257 $self->_remove_from_member_cache($old);
258 $self->_remove_from_key_cache($old);
264 method _update_in_store ($obj) {
265 # this is currently a call command but we should think about it
266 # being a row command so that we can have RETURNING or other
267 # mechanisms handle things like set-on-update datetime values
268 $self->_store->new_update_single_command($self->_deflate($obj))->execute