1 package DBM::Deep::SQL::Hash;
4 use warnings FATAL => 'all';
7 use base 'DBM::Deep::SQL::Util';
9 use Digest::MD5 'md5_base64';
10 use Storable 'nfreeze', 'thaw';
15 eval { local $SIG{'__DIE__'}; tied( %{$_[0]} ) } || $_[0];
21 my $ks = $obj->_get_keys();
32 if (exists $obj->{'keys'})
34 my @ks = keys %{$obj->{'keys'}};
35 return (wantarray()) ? @ks : \@ks;
37 my $q = $obj->_select(
38 'table' => 'rec_hash_item',
39 'fields' => ['key_type', 'key_data'],
41 'hash' => $obj->{'id'},
46 my $kcache = $obj->{'keys'} = {};
48 foreach my $i (0..$#{$q})
62 $kcache->{$k} = undef;
67 my $ids = join(',', @textkey);
68 my $tq = $obj->_select(
69 'table' => 'rec_value_text',
70 'fields' => ['id', 'data'],
71 'where' => "id in ($ids)",
73 my %data = map {$_->[0] => $_->[1]} @$tq;
74 foreach my $x (0..$#textkey)
76 my $id = $textkey[$x];
77 my $i = $textkeypos[$x];
80 $kcache->{$nk} = undef;
83 return (wantarray()) ? @ks : \@ks;
89 my $hcode = md5_base64($k);
90 my $q = $obj->_select(
91 'table' => 'rec_hash_item',
92 'fields' => ['value_type', 'value_data', 'id', 'key_type', 'key_data'],
94 'hash' => $obj->{'id'},
100 my $kt = $q->[0]->[3];
103 $obj->_delete_sql('rec_value_text', {'id' => $q->[0]->[4]});
105 my $dt = $q->[0]->[0];
106 if ($dt eq 'text' || $dt eq 'data')
108 $obj->_delete_sql('rec_value_'. $dt, {'id' => $q->[0]->[1]});
110 elsif ($dt eq 'hash')
112 my $rec = $obj->_tiehash($q->[0]->[1]);
114 $obj->_delete_sql('rec_hash', {'id' => $q->[0]->[1]});
115 $obj->_delete_sql('rec_item', {'id' => $q->[0]->[1]});
117 elsif ($dt eq 'array')
119 my $rec = $obj->_tiearray($q->[0]->[1]);
121 $obj->_delete_sql('rec_array', {'id' => $q->[0]->[1]});
122 $obj->_delete_sql('rec_item', {'id' => $q->[0]->[1]});
124 $obj->_delete_sql('rec_hash_item', {'id' => $q->[0]->[2]});
126 delete $obj->{'cache'}->{$k};
127 if (exists $obj->{'keys'})
129 delete $obj->{'keys'}->{$k};
135 my ($obj, $k, $val) = @_;
136 $obj->{'cache'}->{$k} = $val;
137 if (exists $obj->{'keys'})
139 $obj->{'keys'}->{$k} = undef;
145 my ($obj, $k, $vref) = @_;
146 if (exists $obj->{'cache'}->{$k})
148 $$vref = $obj->{'cache'}->{$k};
157 if (exists $obj->{'cache'}->{$k})
161 my $hcode = md5_base64($k);
162 my $c = $obj->_select(
163 'table' => 'rec_hash_item',
164 'fields' => 'count(id)',
166 'hash' => $obj->{'id'},
167 'key_hash' => $hcode,
176 my $hcode = md5_base64($k);
177 my $q = $obj->_select(
178 'table' => 'rec_hash_item',
179 'fields' => ['value_type', 'value_data'],
181 'hash' => $obj->{'id'},
182 'key_hash' => $hcode,
187 my $dt = $q->[0]->[0];
188 my $val = $q->[0]->[1];
193 elsif ($dt eq 'text')
195 my $dq = $obj->_select(
196 'table' => 'rec_value_text',
202 return $dq->[0]->[0];
204 elsif ($dt eq 'data')
206 my $dq = $obj->_select(
207 'table' => 'rec_value_data',
215 my $rec = thaw($dq->[0]->[0]);
220 elsif ($dt eq 'array')
222 my $rec = $obj->_tiearray($val);
223 if ($obj->{'prefetch'})
225 (tied(@$rec))->_prefetch();
229 elsif ($dt eq 'hash')
231 my $rec = $obj->_tiehash($val);
232 if ($obj->{'prefetch'})
234 (tied(%$rec))->_prefetch();
245 my $pd = $obj->_select(
246 'table' => 'rec_hash_item',
247 'fields' => ['key_type', 'key_data', 'value_type', 'value_data'],
249 'hash' => $obj->{'id'},
259 foreach my $i (0..$#{$pd})
267 push @textkeypos, $i;
272 my $ids = join(',', @textkey);
273 my $tq = $obj->_select(
274 'table' => 'rec_value_text',
275 'fields' => ['id', 'data'],
276 'where' => "id in ($ids)",
278 my %data = map {$_->[0] => $_->[1]} @$tq;
279 foreach my $x (0..$#textkey)
281 my $id = $textkey[$x];
282 my $i = $textkeypos[$x];
283 $pd->[$i]->[1] = $data{$id};
295 elsif ($vt eq 'text')
300 elsif ($vt eq 'value')
305 elsif ($vt eq 'array')
307 my $rec = $obj->_tiearray($val);
308 if ($obj->{'prefetch'})
310 (tied(@$rec))->_prefetch();
314 elsif ($vt eq 'hash')
316 my $rec = $obj->_tiehash($val);
317 if ($obj->{'prefetch'})
319 (tied(@$rec))->_prefetch();
326 my $ids = join(',', @text);
327 my $tq = $obj->_select(
328 'table' => 'rec_value_text',
329 'fields' => ['id', 'data'],
330 'where' => "id in ($ids)",
332 my %data = map {$_->[0] => $_->[1]} @$tq;
333 foreach my $x (0..$#text)
336 my $k = $textpos[$x];
337 $hash{$k} = $data{$id};
342 my $ids = join(',', @data);
343 my $tq = $obj->_select(
344 'table' => 'rec_value_data',
345 'fields' => ['id', 'data'],
346 'where' => "id in ($ids)",
348 my %d = map {$_->[0] => $_->[1]} @$tq;
349 foreach my $x (0..$#data)
352 my $k = $datapos[$x];
355 $hash{$k} = thaw($d{$id});
359 return $obj->{'cache'} = \%hash;
368 $obj->{'cache'} = {};
376 my $obj = $tobj->_get_self();
378 if ($obj->_get_cache($k, \$val))
382 $val = $obj->_data($k);
385 $obj->_set_cache($k, $val);
392 my ($tobj, $k, $val) = @_;
394 my $obj = $tobj->_get_self();
396 $val = '' unless (defined $val);
399 unless ($obj->{'serialize'}) {
400 if ($val =~ /HASH/) {
401 my $id = $obj->_create('hash');
402 my $ta = $obj->_tiehash($id);
404 foreach my $k (keys %$val) {
405 $ta->{$k} = $val->{$k};
411 elsif ($val =~ /ARRAY/) {
412 my $id = $obj->_create('array');
413 my $ta = $obj->_tiearray($id);
415 foreach my $i (0..$#{$val}) {
416 $ta->[$i] = $val->[$i];
424 my $data = nfreeze($val);
425 $val = $obj->_create('value_data', {
431 elsif (length($val) > 255) {
432 $val = $obj->_create('value_data', {
440 my $hcode = md5_base64($k);
441 my $c = $obj->_select(
442 'table' => 'rec_hash_item',
443 'fields' => ['value_type', 'id'],
445 'hash' => $obj->{'id'},
446 'key_hash' => $hcode,
451 if ($c->[0]->[0] eq 'value') {
454 'table' => 'rec_hash_item',
457 'value_data' => $val,
460 'id' => $c->[0]->[1],
470 if (length($k) > 255) {
471 $k = $obj->_create('value_text', {
479 $obj->_create('hash_item', {
480 'hash' => $obj->{'id'},
481 'key_hash' => $hcode,
484 'value_data' => $val,
488 $obj->_set_cache($k, $dval);
495 my $obj = $tobj->_get_self();
496 $k = '' unless defined ($k);
497 return $obj->_exists($k);
503 my $obj = $tobj->_get_self();
510 my $obj = $tobj->_get_self();
517 my $obj = $tobj->_get_self();
520 $obj->{'keys_sorted'} = [sort $obj->_get_keys()];
521 return shift @{$obj->{'keys_sorted'}};
526 return each %{$obj->{'keys'}};
533 my $obj = $tobj->_get_self();
534 if ($obj->{'sort'} && exists $obj->{'keys_sorted'})
536 return shift @{$obj->{'keys_sorted'}};
540 return each %{$obj->{'keys'}};
552 my $obj = $tobj->_get_self();