lib/DBIx/Data/Collection/Set.pm

   1 package DBIx::Data::Collection::Set;
   2
   3 use Moose;
   4 use Method::Signatures::Simple;
   5 use Data::Perl::Stream::Array;
   6
   7 has _store => (is => 'ro', required => 1, init_arg => 'store');
   8
   9 has _class => (is => 'ro', predicate => '_has_class');
  10
  11 has _set_over => (is => 'ro', required => 1, init_arg => 'set_over');
  12
  13 ## member cache (all members)
  14
  15 has _member_cache => (
  16   is => 'rw', lazy_build => 1,
  17   predicate => '_member_cache_built',
  18 );
  19
  20 method _build__member_cache {
  21   my $stream = $self->_new_raw_stream;
  22   my @cache;
  23   while (my ($raw) = $stream->next) {
  24     my $obj = do {
  25       if (my ($obj) = $self->_key_cache_get_raw($raw)) {
  26         $self->_merge($obj, $raw)
  27       } else {
  28         $self->_add_to_key_cache($self->_inflate($raw))
  29       }
  30     };
  31     push @cache, $obj;
  32   }
  33   \@cache
  34 }
  35
  36 method _add_to_member_cache ($to_add) {
  37   return $to_add unless $self->_member_cache_built;
  38   push @{$self->_member_cache}, $to_add;
  39   $to_add
  40 }
  41
  42 method _remove_from_member_cache ($to_remove) {
  43   return $to_remove unless $self->_member_cache_built;
  44   @{$self->_member_cache} = grep $_ ne $to_remove, @{$self->_member_cache};
  45   $to_remove
  46 }
  47
  48 ## key cache - by primary/unique key
  49
  50 has _key_cache => (is => 'ro', default => sub { {} });
  51
  52 method _add_to_key_cache ($to_add) {
  53   $self->_key_cache->{$self->_object_to_id($to_add)} = $to_add;
  54   $to_add
  55 }
  56
  57 method _remove_from_key_cache ($to_remove) {
  58   # should return $to_remove
  59   delete $self->_key_cache->{$self->_object_to_id($to_remove)}
  60 }
  61
  62 method _key_cache_has_raw ($raw) {
  63   exists $self->_key_cache->{$self->_raw_to_id($raw)}
  64 }
  65
  66 method _key_cache_has_object ($obj) {
  67   exists $self->_key_cache->{$self->_object_to_id($obj)}
  68 }
  69
  70 method _key_cache_get_raw ($raw) {
  71   $self->_key_cache_get_id($self->_raw_to_id($raw))
  72 }
  73
  74 method _key_cache_get_object ($obj) {
  75   $self->_key_cache_get_id($self->_object_to_id($obj))
  76 }
  77
  78 method _key_cache_get_object_spec ($spec) {
  79   # see _object_spec_to_id for doc of what the difference is
  80   $self->_key_cache_get_id($self->_object_spec_to_id($spec))
  81 }
  82
  83 method _key_cache_get_id ($id) {
  84   exists $self->_key_cache->{$id}
  85     ? ($self->_key_cache->{$id})
  86     : ()
  87 }
  88
  89 ## thunking between the store representation and the set representation
  90 #
  91 # _inflate is raw data -> final repr
  92 # _deflate is final repr -> raw data
  93 # _merge takes final repr + raw data and updates the repr
  94 #    (this is used for pk-generated values and later lazy loading)
  95 #
  96 # _deflate_spec is attributes of final repr -> raw data
  97
  98 method _inflate ($raw) {
  99   bless($raw, $self->_class) if $self->_has_class;
 100   $raw
 101 }
 102
 103 method _deflate ($obj) {
 104   +{ %$obj }
 105 }
 106
 107 method _merge ($obj, $raw) {
 108   @{$obj}{keys %$raw} = values %$raw;
 109   $obj
 110 }
 111
 112 method _deflate_spec ($spec) {
 113   $spec
 114 }
 115
 116 ## methods to get ids
 117
 118 method _raw_to_id ($raw) {
 119   # XXX must escape this. or do something else.
 120   join ';', map $raw->{$_}, @{$self->_set_over}
 121 }
 122
 123 method _object_to_id ($obj) {
 124   $self->_raw_to_id($self->_deflate($obj))
 125 }
 126
 127 method _object_spec_to_id ($spec) {
 128   # intentionally C&P from _raw_to - this is not the same thing. If a column
 129   # were mapped to an attribute of a different name, the raw would have the
 130   # column name as a key but an object spec would have the attribute name
 131   join ';', map $spec->{$_}, @{$self->_set_over}
 132 }
 133
 134 ## array-ish operations - i.e. get all members
 135
 136 method _new_raw_stream {
 137   $self->_store->new_select_command([])->execute
 138 }
 139
 140 method flatten {
 141   @{$self->_member_cache};
 142 }
 143
 144 method as_stream {
 145   Data::Perl::Stream::Array->new(array => $self->_member_cache);
 146 }
 147
 148 ## load single row
 149
 150 method get ($spec) {
 151   if (my ($got) = $self->_key_cache_get_object_spec($spec)) {
 152     return $got
 153   }
 154   if (my ($raw) = $self->_get_from_store($self->_deflate_spec($spec))) {
 155     return $self->_add_to_key_cache($self->_inflate($raw))
 156   }
 157   return undef # we aren't handling cache misses here yet
 158 }
 159
 160 method _get_from_store ($raw) {
 161   $self->_store->new_select_single_command($raw)->execute
 162 }
 163
 164 ## add to set
 165
 166 method add ($new) {
 167   $self->_add_to_store($new);
 168   $self->_add_to_caches($new);
 169   $new
 170 }
 171
 172 method _add_to_store ($new) {
 173   my $new_raw = $self->_deflate($new);
 174   $self->_merge($new, $self->_store->new_insert_command($new_raw)->execute);
 175   $new
 176 }
 177
 178 method _add_to_caches ($new) {
 179   $self->_add_to_member_cache($new);
 180   $self->_add_to_key_cache($new);
 181   $new
 182 }
 183
 184 ## remove from set
 185
 186 method remove ($old) {
 187   $self->_remove_from_store($old);
 188   $self->_remove_from_caches($old);
 189   $old
 190 }
 191
 192 method _remove_from_store ($old) {
 193   $self->_store->new_delete_command($self->_deflate($old))->execute
 194 }
 195
 196 method _remove_from_caches ($old) {
 197   $self->_remove_from_member_cache($old);
 198   $self->_remove_from_key_cache($old);
 199   $old
 200 }
 201
 202 ## update
 203
 204 method _update_in_store ($obj) {
 205   # this is currently a call command but we should think about it
 206   # being a row command so that we can have RETURNING or other
 207   # mechanisms handle things like set-on-update datetime values
 208   $self->_store->new_update_command($self->_deflate($obj))->execute
 209 }
 210
 211 1;