[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / SQL / Hash.pm

package DBM::Deep::SQL::Hash;

use strict;
use warnings FATAL => 'all';

BEGIN {
	use base 'DBM::Deep::SQL::Util';

	use Digest::MD5 'md5_base64';
	use Storable 'nfreeze', 'thaw';
}

sub _get_self
{
	eval { local $SIG{'__DIE__'}; tied( %{$_[0]} ) } || $_[0];
}

sub _clear
{
	my ($obj) = @_;
	my $ks = $obj->_get_keys();
	foreach my $k (@$ks)
	{
		$obj->_delete($k);
	}
	$obj->{'cache'} = {};
}

sub _get_keys
{
	my ($obj) = @_;
	if (exists $obj->{'keys'})
	{
		my @ks = keys %{$obj->{'keys'}};
		return (wantarray()) ? @ks : \@ks;
	}
	my $q = $obj->_select(
		'table' => 'rec_hash_item',
		'fields' => ['key_type', 'key_data'],
		'where' => {
			'hash' => $obj->{'id'},
		},
	);
	my @textkey = ();
	my @textkeypos = ();
	my $kcache = $obj->{'keys'} = {};
	my @ks = ();
	foreach my $i (0..$#{$q})
	{
		my $row = $q->[$i];
		my $kt = $row->[0];
		my $k = $row->[1];
		if ($kt eq 'text')
		{
			push @ks, undef;
			push @textkey, $k;
			push @textkeypos, $i;
		}
		else
		{
			push @ks, $k;
			$kcache->{$k} = undef;
		}
	}
	if (scalar @textkey)
	{
		my $ids = join(',', @textkey);
		my $tq = $obj->_select(
			'table' => 'rec_value_text',
			'fields' => ['id', 'data'],
			'where' => "id in ($ids)",
		);
		my %data = map {$_->[0] => $_->[1]} @$tq;
		foreach my $x (0..$#textkey)
		{
			my $id = $textkey[$x];
			my $i = $textkeypos[$x];
			my $nk = $data{$id};
			$ks[$i] = $nk;
			$kcache->{$nk} = undef;
		}
	}
	return (wantarray()) ? @ks : \@ks;
}

sub _delete
{
	my ($obj, $k) = @_;
	my $hcode = md5_base64($k);
	my $q = $obj->_select(
		'table' => 'rec_hash_item',
		'fields' => ['value_type', 'value_data', 'id', 'key_type', 'key_data'],
		'where' => {
			'hash' => $obj->{'id'},
			'key_hash' => $hcode,
		},
	);
	if (scalar @$q)
	{
		my $kt = $q->[0]->[3];
		if ($kt eq 'text')
		{
			$obj->_delete_sql('rec_value_text', {'id' => $q->[0]->[4]});
		}
		my $dt = $q->[0]->[0];
		if ($dt eq 'text' || $dt eq 'data')
		{
			$obj->_delete_sql('rec_value_'. $dt, {'id' => $q->[0]->[1]});
		}
		elsif ($dt eq 'hash')
		{
			my $rec = $obj->_tiehash($q->[0]->[1]);
			%$rec = ();
			$obj->_delete_sql('rec_hash', {'id' => $q->[0]->[1]});
			$obj->_delete_sql('rec_item', {'id' => $q->[0]->[1]});
		}
		elsif ($dt eq 'array')
		{
			my $rec = $obj->_tiearray($q->[0]->[1]);
			@$rec = ();
			$obj->_delete_sql('rec_array', {'id' => $q->[0]->[1]});
			$obj->_delete_sql('rec_item', {'id' => $q->[0]->[1]});
		}
		$obj->_delete_sql('rec_hash_item', {'id' => $q->[0]->[2]});
	}
	delete $obj->{'cache'}->{$k};
	if (exists $obj->{'keys'})
	{
		delete $obj->{'keys'}->{$k};
	}
}

sub _set_cache
{
	my ($obj, $k, $val) = @_;
	$obj->{'cache'}->{$k} = $val;
	if (exists $obj->{'keys'})
	{
		$obj->{'keys'}->{$k} = undef;
	}
}

sub _get_cache
{
	my ($obj, $k, $vref) = @_;
	if (exists $obj->{'cache'}->{$k})
	{
		$$vref = $obj->{'cache'}->{$k};
		return 1;
	}
	return undef;
}

sub _exists
{
	my ($obj, $k) = @_;
	if (exists $obj->{'cache'}->{$k})
	{
		return 1;
	}
	my $hcode = md5_base64($k);
	my $c = $obj->_select(
		'table' => 'rec_hash_item',
		'fields' => 'count(id)',
		'where' => {
			'hash' => $obj->{'id'},
			'key_hash' => $hcode,
		},
	)->[0]->[0];
	return $c;
}

sub _data
{
	my ($obj, $k) = @_;
	my $hcode = md5_base64($k);
	my $q = $obj->_select(
		'table' => 'rec_hash_item',
		'fields' => ['value_type', 'value_data'],
		'where' => {
			'hash' => $obj->{'id'},
			'key_hash' => $hcode,
		},
	);
	if (scalar @$q)
	{
		my $dt = $q->[0]->[0];
		my $val = $q->[0]->[1];
		if ($dt eq 'value')
		{
			return $val;
		}
		elsif ($dt eq 'text')
		{
			my $dq = $obj->_select(
				'table' => 'rec_value_text',
				'fields' => 'data',
				'where' => {
					'id' => $val,
				},
			);
			return $dq->[0]->[0];
		}
		elsif ($dt eq 'data')
		{
			my $dq = $obj->_select(
				'table' => 'rec_value_data',
				'fields' => 'data',
				'where' => {
					'id' => $val,
				},
			);
			if (scalar @$dq)
			{
				my $rec = thaw($dq->[0]->[0]);
				return $rec;
			}
			return undef;
		}
		elsif ($dt eq 'array')
		{
			my $rec = $obj->_tiearray($val);
			if ($obj->{'prefetch'})
			{
				(tied(@$rec))->_prefetch();
			}
			return $rec;
		}
		elsif ($dt eq 'hash')
		{
			my $rec = $obj->_tiehash($val);
			if ($obj->{'prefetch'})
			{
				(tied(%$rec))->_prefetch();
			}
			return $rec;
		}
	}
	return undef;
}

sub _prefetch
{
	my ($obj) = @_;
	my $pd = $obj->_select(
		'table' => 'rec_hash_item',
		'fields' => ['key_type', 'key_data', 'value_type', 'value_data'],
		'where' => {
			'hash' => $obj->{'id'},
		},
	);
	my @data = ();
	my @datapos = ();
	my @text = ();
	my @textpos = ();
	my %hash = ();
	my @textkey = ();
	my @textkeypos = ();
	foreach my $i (0..$#{$pd})
	{
		my $row = $pd->[$i];
		my $kt = $row->[0];
		my $k = $row->[1];
		if ($kt eq 'text')
		{
			push @textkey, $k;
			push @textkeypos, $i;
		}
	}
	if (scalar @textkey)
	{
		my $ids = join(',', @textkey);
		my $tq = $obj->_select(
			'table' => 'rec_value_text',
			'fields' => ['id', 'data'],
			'where' => "id in ($ids)",
		);
		my %data = map {$_->[0] => $_->[1]} @$tq;
		foreach my $x (0..$#textkey)
		{
			my $id = $textkey[$x];
			my $i = $textkeypos[$x];
			$pd->[$i]->[1] = $data{$id};
		}
	}
	foreach my $r (@$pd)
	{
		my $k = $r->[1];
		my $vt = $r->[2];
		my $val = $r->[3];
		if ($vt eq 'value')
		{
			$hash{$k} = $val;
		}
		elsif ($vt eq 'text')
		{
			push @textpos, $k;
			push @text, $val;
		}
		elsif ($vt eq 'value')
		{
			push @datapos, $k;
			push @data, $val;
		}
		elsif ($vt eq 'array')
		{
			my $rec = $obj->_tiearray($val);
			if ($obj->{'prefetch'})
			{
				(tied(@$rec))->_prefetch();
			}
			$hash{$k} = $rec;
		}
		elsif ($vt eq 'hash')
		{
			my $rec = $obj->_tiehash($val);
			if ($obj->{'prefetch'})
			{
				(tied(@$rec))->_prefetch();
			}
			$hash{$k} = $rec;
		}
	}
	if (scalar @text)
	{
		my $ids = join(',', @text);
		my $tq = $obj->_select(
			'table' => 'rec_value_text',
			'fields' => ['id', 'data'],
			'where' => "id in ($ids)",
		);
		my %data = map {$_->[0] => $_->[1]} @$tq;
		foreach my $x (0..$#text)
		{
			my $id = $text[$x];
			my $k = $textpos[$x];
			$hash{$k} = $data{$id};
		}
	}
	if (scalar @data)
	{
		my $ids = join(',', @data);
		my $tq = $obj->_select(
			'table' => 'rec_value_data',
			'fields' => ['id', 'data'],
			'where' => "id in ($ids)",
		);
		my %d = map {$_->[0] => $_->[1]} @$tq;
		foreach my $x (0..$#data)
		{
			my $id = $data[$x];
			my $k = $datapos[$x];
			if (defined $d{$id})
			{
				$hash{$k} = thaw($d{$id});
			}
		}
	}
	return $obj->{'cache'} = \%hash;
}

sub TIEHASH
{
	my $class = shift;
	my %prm = @_;
	my $obj = \%prm;
	$obj->{'sort'} = 1;
	$obj->{'cache'} = {};
	bless $obj, $class;
	return $obj;
}

sub FETCH
{
	my ($tobj, $k) = @_;
	my $obj = $tobj->_get_self();
	my $val = undef;
	if ($obj->_get_cache($k, \$val))
	{
		return $val;
	}
	$val = $obj->_data($k);
	if (defined $val)
	{
		$obj->_set_cache($k, $val);
	}
	return $val;
}

sub STORE
{
	my ($tobj, $k, $val) = @_;
	my $dval = $val;
	my $obj = $tobj->_get_self();
	my $vt;
	$val = '' unless (defined $val);
	if (ref $val) {
		my $done = 0;
		unless ($obj->{'serialize'}) {
			if ($val =~ /HASH/) {
				my $id = $obj->_create('hash');
				my $ta = $obj->_tiehash($id);
				$dval = $ta;
				foreach my $k (keys %$val) {
					$ta->{$k} = $val->{$k};
				}
 				$vt = 'hash';
				$val = $id;
				$done = 1;
			}
			elsif ($val =~ /ARRAY/) {
				my $id = $obj->_create('array');
				my $ta = $obj->_tiearray($id);
				$dval = $ta;
				foreach my $i (0..$#{$val}) {
					$ta->[$i] = $val->[$i];
				}
 				$vt = 'array';
				$val = $id;
				$done = 1;
			}
		}
		unless ($done) {
			my $data = nfreeze($val);
			$val = $obj->_create('value_data', {
				'data' => $data,
			});
 			$vt = 'data';
		}
	}
	elsif (length($val) > 255) {
		$val = $obj->_create('value_data', {
			'data' => $val,
		});
 		$vt = 'text';
	}
	else {
 		$vt = 'value';
	}
	my $hcode = md5_base64($k);
	my $c = $obj->_select(
		'table' => 'rec_hash_item',
		'fields' => ['value_type', 'id'],
		'where' => {
			'hash' => $obj->{'id'},
			'key_hash' => $hcode,
		},
	);
	my $create = 1;
	if (scalar @$c) {
		if ($c->[0]->[0] eq 'value') {
			$create = 0;
			$obj->_update(
				'table' => 'rec_hash_item',
				'fields' => {
					'value_type' => $vt,
					'value_data' => $val,
				},
				'where' => {
					'id' => $c->[0]->[1],
				},
			);
		}
		else {
			$obj->_delete($k);
		}
	}
	if ($create) {
		my $kt;
		if (length($k) > 255) {
			$k = $obj->_create('value_text', {
				'data' => $k,
			});
			$kt = 'text';
		}
		else {
			$kt = 'value';
		}
		$obj->_create('hash_item', {
			'hash' => $obj->{'id'},
			'key_hash' => $hcode,
			'key_data' => $k,
			'key_type' => $kt,
			'value_data' => $val,
			'value_type' => $vt,
		});
	}
	$obj->_set_cache($k, $dval);
	return $dval;
}

sub EXISTS
{
	my ($tobj, $k) = @_;
	my $obj = $tobj->_get_self();
	$k = '' unless defined ($k);
	return $obj->_exists($k);
}

sub DELETE
{
	my ($tobj, $i) = @_;
	my $obj = $tobj->_get_self();
	$obj->_delete($i);
}

sub CLEAR
{
	my ($tobj) = @_;
	my $obj = $tobj->_get_self();
	$obj->_clear();
}

sub FIRSTKEY
{
	my ($tobj) = @_;
	my $obj = $tobj->_get_self();
	if ($obj->{'sort'})
	{
		$obj->{'keys_sorted'} = [sort $obj->_get_keys()];
		return shift @{$obj->{'keys_sorted'}};
	}
	else
	{
		$obj->_get_keys();
		return each %{$obj->{'keys'}};
	}
}

sub NEXTKEY
{
	my ($tobj) = @_;
	my $obj = $tobj->_get_self();
	if ($obj->{'sort'} && exists $obj->{'keys_sorted'})
	{
		return shift @{$obj->{'keys_sorted'}};
	}
	else
	{
		return each %{$obj->{'keys'}};
	}
}

sub SCALAR
{
	# TODO
}

sub id
{
	my ($tobj) = @_;
	my $obj = $tobj->_get_self();
	return $obj->{'id'};
}

1;
Commit	Line	Data
4f0f6fff	1	package DBM::Deep::SQL::Hash;
	2
	3	use strict;
	4	use warnings FATAL => 'all';
	5
	6	BEGIN {
	7	use base 'DBM::Deep::SQL::Util';
	8
	9	use Digest::MD5 'md5_base64';
	10	use Storable 'nfreeze', 'thaw';
	11	}
	12
	13	sub _get_self
	14	{
	15	eval { local $SIG{'__DIE__'}; tied( %{$_[0]} ) } \|\| $_[0];
	16	}
	17
	18	sub _clear
	19	{
	20	my ($obj) = @_;
	21	my $ks = $obj->_get_keys();
	22	foreach my $k (@$ks)
	23	{
	24	$obj->_delete($k);
	25	}
	26	$obj->{'cache'} = {};
	27	}
	28
	29	sub _get_keys
	30	{
	31	my ($obj) = @_;
	32	if (exists $obj->{'keys'})
	33	{
	34	my @ks = keys %{$obj->{'keys'}};
	35	return (wantarray()) ? @ks : \@ks;
	36	}
	37	my $q = $obj->_select(
	38	'table' => 'rec_hash_item',
	39	'fields' => ['key_type', 'key_data'],
	40	'where' => {
	41	'hash' => $obj->{'id'},
	42	},
	43	);
	44	my @textkey = ();
	45	my @textkeypos = ();
	46	my $kcache = $obj->{'keys'} = {};
	47	my @ks = ();
	48	foreach my $i (0..$#{$q})
	49	{
	50	my $row = $q->[$i];
	51	my $kt = $row->[0];
	52	my $k = $row->[1];
	53	if ($kt eq 'text')
	54	{
	55	push @ks, undef;
	56	push @textkey, $k;
	57	push @textkeypos, $i;
	58	}
	59	else
	60	{
	61	push @ks, $k;
	62	$kcache->{$k} = undef;
	63	}
	64	}
65	if (scalar @textkey)
66	{
67	my $ids = join(',', @textkey);
68	my $tq = $obj->_select(
69	'table' => 'rec_value_text',
70	'fields' => ['id', 'data'],
71	'where' => "id in ($ids)",
72	);
73	my %data = map {$_->[0] => $_->[1]} @$tq;
74	foreach my $x (0..$#textkey)
75	{
76	my $id = $textkey[$x];
77	my $i = $textkeypos[$x];
78	my $nk = $data{$id};
79	$ks[$i] = $nk;
80	$kcache->{$nk} = undef;
81	}
82	}
83	return (wantarray()) ? @ks : \@ks;
84	}
85
86	sub _delete
87	{
88	my ($obj, $k) = @_;
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'],
93	'where' => {
94	'hash' => $obj->{'id'},
95	'key_hash' => $hcode,
96	},
97	);
98	if (scalar @$q)
99	{
100	my $kt = $q->[0]->[3];
101	if ($kt eq 'text')
102	{
103	$obj->_delete_sql('rec_value_text', {'id' => $q->[0]->[4]});
104	}
105	my $dt = $q->[0]->[0];
106	if ($dt eq 'text' \|\| $dt eq 'data')
107	{
108	$obj->_delete_sql('rec_value_'. $dt, {'id' => $q->[0]->[1]});
109	}
110	elsif ($dt eq 'hash')
111	{
112	my $rec = $obj->_tiehash($q->[0]->[1]);
113	%$rec = ();
114	$obj->_delete_sql('rec_hash', {'id' => $q->[0]->[1]});
115	$obj->_delete_sql('rec_item', {'id' => $q->[0]->[1]});
116	}
117	elsif ($dt eq 'array')
118	{
119	my $rec = $obj->_tiearray($q->[0]->[1]);
120	@$rec = ();
121	$obj->_delete_sql('rec_array', {'id' => $q->[0]->[1]});
122	$obj->_delete_sql('rec_item', {'id' => $q->[0]->[1]});
123	}
124	$obj->_delete_sql('rec_hash_item', {'id' => $q->[0]->[2]});
125	}
126	delete $obj->{'cache'}->{$k};
127	if (exists $obj->{'keys'})
128	{
129	delete $obj->{'keys'}->{$k};
130	}
131	}
132
133	sub _set_cache
134	{
135	my ($obj, $k, $val) = @_;
136	$obj->{'cache'}->{$k} = $val;
137	if (exists $obj->{'keys'})
138	{
139	$obj->{'keys'}->{$k} = undef;
140	}
141	}
142
143	sub _get_cache
144	{
145	my ($obj, $k, $vref) = @_;
146	if (exists $obj->{'cache'}->{$k})
147	{
148	$$vref = $obj->{'cache'}->{$k};
149	return 1;
150	}
151	return undef;
152	}
153
154	sub _exists
155	{
156	my ($obj, $k) = @_;
157	if (exists $obj->{'cache'}->{$k})
158	{
159	return 1;
160	}
161	my $hcode = md5_base64($k);
162	my $c = $obj->_select(
163	'table' => 'rec_hash_item',
164	'fields' => 'count(id)',
165	'where' => {
166	'hash' => $obj->{'id'},
167	'key_hash' => $hcode,
168	},
169	)->[0]->[0];
170	return $c;
171	}
172
173	sub _data
174	{
175	my ($obj, $k) = @_;
176	my $hcode = md5_base64($k);
177	my $q = $obj->_select(
178	'table' => 'rec_hash_item',
179	'fields' => ['value_type', 'value_data'],
180	'where' => {
181	'hash' => $obj->{'id'},
182	'key_hash' => $hcode,
183	},
184	);
185	if (scalar @$q)
186	{
187	my $dt = $q->[0]->[0];
188	my $val = $q->[0]->[1];
189	if ($dt eq 'value')
190	{
191	return $val;
192	}
193	elsif ($dt eq 'text')
194	{
195	my $dq = $obj->_select(
196	'table' => 'rec_value_text',
197	'fields' => 'data',
198	'where' => {
199	'id' => $val,
200	},
201	);
202	return $dq->[0]->[0];
203	}
204	elsif ($dt eq 'data')
205	{
206	my $dq = $obj->_select(
207	'table' => 'rec_value_data',
208	'fields' => 'data',
209	'where' => {
210	'id' => $val,
211	},
212	);
213	if (scalar @$dq)
214	{
215	my $rec = thaw($dq->[0]->[0]);
216	return $rec;
217	}
218	return undef;
219	}
220	elsif ($dt eq 'array')
221	{
222	my $rec = $obj->_tiearray($val);
223	if ($obj->{'prefetch'})
224	{
225	(tied(@$rec))->_prefetch();
226	}
227	return $rec;
228	}
229	elsif ($dt eq 'hash')
230	{
231	my $rec = $obj->_tiehash($val);
232	if ($obj->{'prefetch'})
233	{
234	(tied(%$rec))->_prefetch();
235	}
236	return $rec;
237	}
238	}
239	return undef;
240	}
241
242	sub _prefetch
243	{
244	my ($obj) = @_;
245	my $pd = $obj->_select(
246	'table' => 'rec_hash_item',
247	'fields' => ['key_type', 'key_data', 'value_type', 'value_data'],
248	'where' => {
249	'hash' => $obj->{'id'},
250	},
251	);
252	my @data = ();
253	my @datapos = ();
254	my @text = ();
255	my @textpos = ();
256	my %hash = ();
257	my @textkey = ();
258	my @textkeypos = ();
259	foreach my $i (0..$#{$pd})
260	{
261	my $row = $pd->[$i];
262	my $kt = $row->[0];
263	my $k = $row->[1];
264	if ($kt eq 'text')
265	{
266	push @textkey, $k;
267	push @textkeypos, $i;
268	}
269	}
270	if (scalar @textkey)
271	{
272	my $ids = join(',', @textkey);
273	my $tq = $obj->_select(
274	'table' => 'rec_value_text',
275	'fields' => ['id', 'data'],
276	'where' => "id in ($ids)",
277	);
278	my %data = map {$_->[0] => $_->[1]} @$tq;
279	foreach my $x (0..$#textkey)
280	{
281	my $id = $textkey[$x];
282	my $i = $textkeypos[$x];
283	$pd->[$i]->[1] = $data{$id};
284	}
285	}
286	foreach my $r (@$pd)
287	{
288	my $k = $r->[1];
289	my $vt = $r->[2];
290	my $val = $r->[3];
291	if ($vt eq 'value')
292	{
293	$hash{$k} = $val;
294	}
295	elsif ($vt eq 'text')
296	{
297	push @textpos, $k;
298	push @text, $val;
299	}
300	elsif ($vt eq 'value')
301	{
302	push @datapos, $k;
303	push @data, $val;
304	}
305	elsif ($vt eq 'array')
306	{
307	my $rec = $obj->_tiearray($val);
308	if ($obj->{'prefetch'})
309	{
310	(tied(@$rec))->_prefetch();
311	}
312	$hash{$k} = $rec;
313	}
314	elsif ($vt eq 'hash')
315	{
316	my $rec = $obj->_tiehash($val);
317	if ($obj->{'prefetch'})
318	{
319	(tied(@$rec))->_prefetch();
320	}
321	$hash{$k} = $rec;
322	}
323	}
324	if (scalar @text)
325	{
326	my $ids = join(',', @text);
327	my $tq = $obj->_select(
328	'table' => 'rec_value_text',
329	'fields' => ['id', 'data'],
330	'where' => "id in ($ids)",
331	);
332	my %data = map {$_->[0] => $_->[1]} @$tq;
333	foreach my $x (0..$#text)
334	{
335	my $id = $text[$x];
336	my $k = $textpos[$x];
337	$hash{$k} = $data{$id};
338	}
339	}
340	if (scalar @data)
341	{
342	my $ids = join(',', @data);
343	my $tq = $obj->_select(
344	'table' => 'rec_value_data',
345	'fields' => ['id', 'data'],
346	'where' => "id in ($ids)",
347	);
348	my %d = map {$_->[0] => $_->[1]} @$tq;
349	foreach my $x (0..$#data)
350	{
351	my $id = $data[$x];
352	my $k = $datapos[$x];
353	if (defined $d{$id})
354	{
355	$hash{$k} = thaw($d{$id});
356	}
357	}
358	}
359	return $obj->{'cache'} = \%hash;
360	}
361
362	sub TIEHASH
363	{
364	my $class = shift;
365	my %prm = @_;
366	my $obj = \%prm;
367	$obj->{'sort'} = 1;
368	$obj->{'cache'} = {};
369	bless $obj, $class;
370	return $obj;
371	}
372
373	sub FETCH
374	{
375	my ($tobj, $k) = @_;
376	my $obj = $tobj->_get_self();
377	my $val = undef;
378	if ($obj->_get_cache($k, \$val))
379	{
380	return $val;
381	}
382	$val = $obj->_data($k);
383	if (defined $val)
384	{
385	$obj->_set_cache($k, $val);
386	}
387	return $val;
388	}
389
390	sub STORE
391	{
392	my ($tobj, $k, $val) = @_;
393	my $dval = $val;
394	my $obj = $tobj->_get_self();
395	my $vt;
396	$val = '' unless (defined $val);
2c70efe1	397	if (ref $val) {
4f0f6fff	398	my $done = 0;
2c70efe1	399	unless ($obj->{'serialize'}) {
2c70efe1	400	if ($val =~ /HASH/) {
4f0f6fff	401	my $id = $obj->_create('hash');
	402	my $ta = $obj->_tiehash($id);
	403	$dval = $ta;
2c70efe1	404	foreach my $k (keys %$val) {
4f0f6fff	405	$ta->{$k} = $val->{$k};
	406	}
	407	$vt = 'hash';
	408	$val = $id;
	409	$done = 1;
	410	}
2c70efe1	411	elsif ($val =~ /ARRAY/) {
4f0f6fff	412	my $id = $obj->_create('array');
	413	my $ta = $obj->_tiearray($id);
	414	$dval = $ta;
2c70efe1	415	foreach my $i (0..$#{$val}) {
4f0f6fff	416	$ta->[$i] = $val->[$i];
	417	}
	418	$vt = 'array';
	419	$val = $id;
	420	$done = 1;
	421	}
	422	}
2c70efe1	423	unless ($done) {
4f0f6fff	424	my $data = nfreeze($val);
	425	$val = $obj->_create('value_data', {
	426	'data' => $data,
	427	});
	428	$vt = 'data';
	429	}
	430	}
2c70efe1	431	elsif (length($val) > 255) {
4f0f6fff	432	$val = $obj->_create('value_data', {
	433	'data' => $val,
	434	});
	435	$vt = 'text';
	436	}
2c70efe1	437	else {
4f0f6fff	438	$vt = 'value';
	439	}
	440	my $hcode = md5_base64($k);
	441	my $c = $obj->_select(
	442	'table' => 'rec_hash_item',
	443	'fields' => ['value_type', 'id'],
	444	'where' => {
	445	'hash' => $obj->{'id'},
	446	'key_hash' => $hcode,
	447	},
	448	);
	449	my $create = 1;
2c70efe1	450	if (scalar @$c) {
2c70efe1	451	if ($c->[0]->[0] eq 'value') {
4f0f6fff	452	$create = 0;
	453	$obj->_update(
	454	'table' => 'rec_hash_item',
	455	'fields' => {
	456	'value_type' => $vt,
	457	'value_data' => $val,
	458	},
	459	'where' => {
	460	'id' => $c->[0]->[1],
	461	},
	462	);
	463	}
2c70efe1	464	else {
4f0f6fff	465	$obj->_delete($k);
	466	}
	467	}
2c70efe1	468	if ($create) {
4f0f6fff	469	my $kt;
2c70efe1	470	if (length($k) > 255) {
4f0f6fff	471	$k = $obj->_create('value_text', {
	472	'data' => $k,
	473	});
	474	$kt = 'text';
	475	}
2c70efe1	476	else {
4f0f6fff	477	$kt = 'value';
	478	}
	479	$obj->_create('hash_item', {
	480	'hash' => $obj->{'id'},
	481	'key_hash' => $hcode,
	482	'key_data' => $k,
	483	'key_type' => $kt,
	484	'value_data' => $val,
	485	'value_type' => $vt,
	486	});
	487	}
	488	$obj->_set_cache($k, $dval);
	489	return $dval;
	490	}
	491
	492	sub EXISTS
	493	{
	494	my ($tobj, $k) = @_;
	495	my $obj = $tobj->_get_self();
	496	$k = '' unless defined ($k);
	497	return $obj->_exists($k);
	498	}
	499
	500	sub DELETE
	501	{
	502	my ($tobj, $i) = @_;
	503	my $obj = $tobj->_get_self();
	504	$obj->_delete($i);
	505	}
	506
	507	sub CLEAR
	508	{
	509	my ($tobj) = @_;
	510	my $obj = $tobj->_get_self();
	511	$obj->_clear();
	512	}
	513
	514	sub FIRSTKEY
	515	{
	516	my ($tobj) = @_;
	517	my $obj = $tobj->_get_self();
	518	if ($obj->{'sort'})
	519	{
	520	$obj->{'keys_sorted'} = [sort $obj->_get_keys()];
	521	return shift @{$obj->{'keys_sorted'}};
	522	}
	523	else
	524	{
	525	$obj->_get_keys();
	526	return each %{$obj->{'keys'}};
	527	}
	528	}
	529
	530	sub NEXTKEY
	531	{
	532	my ($tobj) = @_;
	533	my $obj = $tobj->_get_self();
	534	if ($obj->{'sort'} && exists $obj->{'keys_sorted'})
	535	{
	536	return shift @{$obj->{'keys_sorted'}};
	537	}
	538	else
	539	{
	540	return each %{$obj->{'keys'}};
541	}
542	}
543
544	sub SCALAR
545	{
546	# TODO
547	}
548
549	sub id
550	{
551	my ($tobj) = @_;
552	my $obj = $tobj->_get_self();
553	return $obj->{'id'};
554	}
555
556	1;
557