File Coverage

blib/lib/MLDBM/TinyDB.pm

Criterion	Covered	Total	%
statement	355	546	65.0
branch	95	300	31.6
condition	11	133	8.2
subroutine	27	39	69.2
pod	17	25	68.0
total	505	1043	48.4

package MLDBM::TinyDB;

use vars qw/$VERSION @ISA @EXPORT_OK/;
$VERSION = '0.20';#

use strict;
use Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(db add_common);
use MLDBM qw/SDBM_File Storable/;## change SDBM_File for any other DBM file if you want
use MLDBM::Serializer::Storable; ## p2x
use Storable qw/dclone/;
use SDBM_File; ## p2x
use Fcntl;
use Carp::Heavy; ## p2x
use Tie::IxHash;
use MLDBM::TinyDB;

our %db;

sub db {
	my $table = shift;
	if (ref($db{$table}) =~ /MLDBM::TinyDB/) {
		return $db{$table};
	} elsif (ref($db{$table}) =~ /ARRAY/) {
		return init(__PACKAGE__,$table, @{ $db{$table} });
	} else {
		return undef;#
	}
}

##	UNDOCUMENTED
sub free_dbh {
	my $self = shift;
	return (%db = ());
}

sub init {
	my $this = shift;
	my $class = ref($this)||$this;
	my ($table, $tree, $branch, $mode, $perms) = @_;
	my $self = {};
	$self->{TABLE} = $table;

	$mode ||= (O_CREAT|O_RDWR);
	$perms  ||= 0666;
	tie %{$self->{TIEHASH}}, 'MLDBM', $table, $mode, $perms or die $!;

	my $proc;## to be processed unless $branch
	unless ($proc = ${$self->{TIEHASH}}{tree}) {
	##	save
		${$self->{TIEHASH}}{tree} = $tree;
		$proc = $tree;
	}

	return $proc if !defined($proc);

	my %tables;

	unless ($branch) {
		my $clone = dclone($proc);
		set_tables_data(\%tables, $proc);
		my @extfiles = grep !/^$table$/, keys %tables;
		if ( @extfiles>0 ) {
		##	so there is at least one table related
			foreach (@extfiles) {
				$db{$_} = [$clone, $tables{$_} ];
			}
		}
		@{$self->{FLDS}} = @{ $tables{$table}{FLDS} };
		@{$self->{DOWN}} = @{ $tables{$table}{DOWN} };
		$self->{UP} = $tables{$table}{UP};
	} else {
		@{$self->{FLDS}} = @{ $branch->{FLDS} };
		@{$self->{DOWN}} = @{ $branch->{DOWN} };
		$self->{UP} = $branch->{UP};
	}
##	IMPLICITLY ADD FIELD IF EXISTS SUPERIOR TABLE - FIELD IS NOT CONTAINED IN $tree!!!
##	IT'S FOR delete
	unshift(@{$self->{FLDS}}, "nodes")
		if defined $self->{UP};

	my @numkeys = map {$_, undef}  sort {$a<=>$b} grep /^\d+$/ && $_, keys %{$self->{TIEHASH}};
	$self->{NUMKEYS} = Tie::IxHash->new( @numkeys );

	bless $self, $class;
	$db{$table} = $self;
	return $self;
}

sub set_tables_data {
	my ($tables, $reft, $up) = @_;
	my $first = shift @$reft;
	$tables->{$first}{UP} = $up;
	@{$tables->{$first}{DOWN}} = ();
	foreach (@$reft) {
		if (ref($_) =~ /ARRAY/) {
			push(@{$tables->{$first}{FLDS}}, $_->[0]);
		##	array of ref
			push(@{$tables->{$first}{DOWN}}, $tables->{$first}{FLDS}[-1]);
			set_tables_data($tables, $_, $first);
		} else {
			push(@{$tables->{$first}{FLDS}}, $_);
		}
	}
}

## ultility
sub add_common {
	my ($reft, $common) = @_;
	my $first = shift @$reft;
	unshift(@$reft, $first, @$common);
	foreach (@$reft) {
		if (ref($_) =~ /ARRAY/) {
			add_common($_, $common);
		}
	}
}

sub lsearch {
	my ($self, $criteria, $limit) = @_;
	use locale;## just that line added to sort method
	my @found = ();
	my @spec = $self->{NUMKEYS}->Keys;
	my $str = join "|", @{$self->{FLDS}};
	$str = '$criteria =~ s/(' .  $str . ')/\'$hash{\' . $1 . \'}\'/ge';
	unless (eval $str) {
		warn "eval failed: $@" if $@;
	}
	my %hash = (); ##-
	for(my $i=0; $i<=$#spec; $i++) {
		@hash{ @{$self->{FLDS}} } = @{ ${$self->{TIEHASH}}{$spec[$i]} };
		if (eval $criteria) {
			push(@found, $i);
			last if $limit && ($limit == @found);
		} elsif ($@) {
			warn "eval failed:$@";
		}
	}
	return @found;
}

sub search {
	my ($self, $criteria, $limit) = @_;
	my @found = ();
	my @spec = $self->{NUMKEYS}->Keys;
	my $str = join "|", @{$self->{FLDS}};
	$str = '$criteria =~ s/(' .  $str . ')/\'$hash{\' . $1 . \'}\'/ge';
	unless (eval $str) {
		warn "eval failed: $@" if $@;
	}
	my %hash = (); ##-
	for(my $i=0; $i<=$#spec; $i++) {
		@hash{ @{$self->{FLDS}} } = @{ ${$self->{TIEHASH}}{$spec[$i]} };
		if (eval $criteria) {
			push(@found, $i);
			last if $limit && ($limit == @found);
		} elsif ($@) {
			warn "eval failed:$@";
		}
	}
	return @found;
}

sub lsort {
	my ($self, $sform) = @_;
	use locale;## just that line added to sort method
	my $str;
	my @spec = $self->{NUMKEYS}->Keys;
	my $not = join "|", @{$self->{DOWN}}, 'nodes';
	my @allowed = grep !/^$not$/, @{$self->{FLDS}};
	my $allowed = join "|", @allowed;
	my @reg = ();
	my @sorted = ();
	my %conv = ('ab'=>0, 'ba'=>1, 'cmp'=>0, '<=>'=>1);
	$str = 'while ($sform =~ s/^(\w*)\s*(\(?)\s*([ab])\s*\(\s*('.$allowed.')\s*\)\s*(\)?)\s*(cmp|\<\=\>)\s*(\1)\s*(\2)\s*([ab])\s*\(\s*(\4)\s*\)\s*(\5)\s*(?:\|\|)?//){ push(@reg,[$1, $3, $4, $6, $9, ($conv{qq/$3$9/}<<1)|$conv{$6}]) if ($3 ne $9) && !$conv{$4}++; }';
	eval $str;
	die "eval failed: $@" if $@;
	if (@reg == 0) {
		return @sorted;
	}
	my @keys = map { $_->[2] } @reg;
	my @indices = k2i($self->{FLDS},[@keys]);
	my @ex = grep $_->[0], @reg;
	for(my $i=0; $i<=$#spec; $i++) {
		 push(@sorted, [$i, @{ ${$self->{TIEHASH}}{$spec[$i]} }[@indices]]);
	}
	if (@ex == 0 && @keys == 1) {
		@sorted = sort {$a->[1] cmp $b->[1]} @sorted if $reg[0]->[5] == 0;
		@sorted = sort {$b->[1] cmp $a->[1]} @sorted if $reg[0]->[5] == 2;
		@sorted = sort {$a->[1] <=> $b->[1]} @sorted if $reg[0]->[5] == 1;
		@sorted = sort {$b->[1] <=> $a->[1]} @sorted if $reg[0]->[5] == 3;
	} elsif (@ex == 0 && @keys == 2) {
		@sorted = sort {$a->[1] cmp $b->[1]||
				$a->[2] cmp $b->[2]} @sorted
			if $reg[0]->[5] == 0 && $reg[1]->[5] == 0;
		@sorted = sort {$a->[1] cmp $b->[1]||
				$b->[2] cmp $a->[2]} @sorted
			if $reg[0]->[5] == 0 && $reg[1]->[5] == 2;
		@sorted = sort {$a->[1] cmp $b->[1]||
				$a->[2] <=> $b->[2]} @sorted
			if $reg[0]->[5] == 0 && $reg[1]->[5] == 1;
		@sorted = sort {$a->[1] cmp $b->[1]||
				$b->[2] <=> $a->[2]} @sorted
			if $reg[0]->[5] == 0 && $reg[1]->[5] == 3;

		@sorted = sort {$b->[1] cmp $a->[1]||
				$a->[2] cmp $b->[2]} @sorted
			if $reg[0]->[5] == 2 && $reg[1]->[5] == 0;
		@sorted = sort {$b->[1] cmp $a->[1]||
				$b->[2] cmp $a->[2]} @sorted
			if $reg[0]->[5] == 2 && $reg[1]->[5] == 2;
		@sorted = sort {$b->[1] cmp $a->[1]||
				$a->[2] <=> $b->[2]} @sorted
			if $reg[0]->[5] == 2 && $reg[1]->[5] == 1;
		@sorted = sort {$b->[1] cmp $a->[1]||
				$b->[2] <=> $a->[2]} @sorted
			if $reg[0]->[5] == 2 && $reg[1]->[5] == 3;

		@sorted = sort {$a->[1] <=> $b->[1]||
				$a->[2] cmp $b->[2]} @sorted
			if $reg[0]->[5] == 1 && $reg[1]->[5] == 0;
		@sorted = sort {$a->[1] <=> $b->[1]||
				$b->[2] cmp $a->[2]} @sorted
			if $reg[0]->[5] == 1 && $reg[1]->[5] == 2;
		@sorted = sort {$a->[1] <=> $b->[1]||
				$a->[2] <=> $b->[2]} @sorted
			if $reg[0]->[5] == 1 && $reg[1]->[5] == 1;
		@sorted = sort {$a->[1] <=> $b->[1]||
				$b->[2] <=> $a->[2]} @sorted
			if $reg[0]->[5] == 1 && $reg[1]->[5] == 3;

		@sorted = sort {$b->[1] <=> $a->[1]||
				$a->[2] cmp $b->[2]} @sorted
			if $reg[0]->[5] == 3 && $reg[1]->[5] == 0;
		@sorted = sort {$b->[1] <=> $a->[1]||
				$b->[2] cmp $a->[2]} @sorted
			if $reg[0]->[5] == 3 && $reg[1]->[5] == 2;
		@sorted = sort {$b->[1] <=> $a->[1]||
				$a->[2] <=> $b->[2]} @sorted
			if $reg[0]->[5] == 3 && $reg[1]->[5] == 1;
		@sorted = sort {$b->[1] <=> $a->[1]||
				$b->[2] <=> $a->[2]} @sorted
			if $reg[0]->[5] == 3 && $reg[1]->[5] == 3;
	} else {
		undef $sform;
		my $i = 1;
		foreach my $e (@reg) {
			$sform .= $e->[0] if $e->[0];
			$sform .= '$'.$e->[1].'->['.$i.']'.$e->[3];
			$sform .= " $e->[0] " if $e->[0];
			$sform .= '$'.$e->[4].'->['.$i.']';
			$sform .= '||';
			$i++;
		}
		chop $sform;
		chop $sform;
		#print "\$sform:$sform";
		@sorted = sort { eval $sform }  @sorted;
	}
	return @sorted;
}

sub sort {
	my ($self, $sform) = @_;
	my $str;
	my @spec = $self->{NUMKEYS}->Keys;
	my $not = join "|", @{$self->{DOWN}}, 'nodes';
	my @allowed = grep !/^$not$/, @{$self->{FLDS}};
	my $allowed = join "|", @allowed;
	my @reg = ();
	my @sorted = ();
	my %conv = ('ab'=>0, 'ba'=>1, 'cmp'=>0, '<=>'=>1);
	$str = 'while ($sform =~ s/^(\w*)\s*(\(?)\s*([ab])\s*\(\s*('.$allowed.')\s*\)\s*(\)?)\s*(cmp|\<\=\>)\s*(\1)\s*(\2)\s*([ab])\s*\(\s*(\4)\s*\)\s*(\5)\s*(?:\|\|)?//){ push(@reg,[$1, $3, $4, $6, $9, ($conv{qq/$3$9/}<<1)|$conv{$6}]) if ($3 ne $9) && !$conv{$4}++; }';
	eval $str;
	die "eval failed: $@" if $@;
	if (@reg == 0) {
		return @sorted;
	}
	my @keys = map { $_->[2] } @reg;
	my @indices = k2i($self->{FLDS},[@keys]);
	my @ex = grep $_->[0], @reg;
	for(my $i=0; $i<=$#spec; $i++) {
		 push(@sorted, [$i, @{ ${$self->{TIEHASH}}{$spec[$i]} }[@indices]]);
	}
	if (@ex == 0 && @keys == 1) {
		@sorted = sort {$a->[1] cmp $b->[1]} @sorted if $reg[0]->[5] == 0;
		@sorted = sort {$b->[1] cmp $a->[1]} @sorted if $reg[0]->[5] == 2;
		@sorted = sort {$a->[1] <=> $b->[1]} @sorted if $reg[0]->[5] == 1;
		@sorted = sort {$b->[1] <=> $a->[1]} @sorted if $reg[0]->[5] == 3;
	} elsif (@ex == 0 && @keys == 2) {
		@sorted = sort {$a->[1] cmp $b->[1]||
				$a->[2] cmp $b->[2]} @sorted
			if $reg[0]->[5] == 0 && $reg[1]->[5] == 0;
		@sorted = sort {$a->[1] cmp $b->[1]||
				$b->[2] cmp $a->[2]} @sorted
			if $reg[0]->[5] == 0 && $reg[1]->[5] == 2;
		@sorted = sort {$a->[1] cmp $b->[1]||
				$a->[2] <=> $b->[2]} @sorted
			if $reg[0]->[5] == 0 && $reg[1]->[5] == 1;
		@sorted = sort {$a->[1] cmp $b->[1]||
				$b->[2] <=> $a->[2]} @sorted
			if $reg[0]->[5] == 0 && $reg[1]->[5] == 3;

		@sorted = sort {$b->[1] cmp $a->[1]||
				$a->[2] cmp $b->[2]} @sorted
			if $reg[0]->[5] == 2 && $reg[1]->[5] == 0;
		@sorted = sort {$b->[1] cmp $a->[1]||
				$b->[2] cmp $a->[2]} @sorted
			if $reg[0]->[5] == 2 && $reg[1]->[5] == 2;
		@sorted = sort {$b->[1] cmp $a->[1]||
				$a->[2] <=> $b->[2]} @sorted
			if $reg[0]->[5] == 2 && $reg[1]->[5] == 1;
		@sorted = sort {$b->[1] cmp $a->[1]||
				$b->[2] <=> $a->[2]} @sorted
			if $reg[0]->[5] == 2 && $reg[1]->[5] == 3;

		@sorted = sort {$a->[1] <=> $b->[1]||
				$a->[2] cmp $b->[2]} @sorted
			if $reg[0]->[5] == 1 && $reg[1]->[5] == 0;
		@sorted = sort {$a->[1] <=> $b->[1]||
				$b->[2] cmp $a->[2]} @sorted
			if $reg[0]->[5] == 1 && $reg[1]->[5] == 2;
		@sorted = sort {$a->[1] <=> $b->[1]||
				$a->[2] <=> $b->[2]} @sorted
			if $reg[0]->[5] == 1 && $reg[1]->[5] == 1;
		@sorted = sort {$a->[1] <=> $b->[1]||
				$b->[2] <=> $a->[2]} @sorted
			if $reg[0]->[5] == 1 && $reg[1]->[5] == 3;

		@sorted = sort {$b->[1] <=> $a->[1]||
				$a->[2] cmp $b->[2]} @sorted
			if $reg[0]->[5] == 3 && $reg[1]->[5] == 0;
		@sorted = sort {$b->[1] <=> $a->[1]||
				$b->[2] cmp $a->[2]} @sorted
			if $reg[0]->[5] == 3 && $reg[1]->[5] == 2;
		@sorted = sort {$b->[1] <=> $a->[1]||
				$a->[2] <=> $b->[2]} @sorted
			if $reg[0]->[5] == 3 && $reg[1]->[5] == 1;
		@sorted = sort {$b->[1] <=> $a->[1]||
				$b->[2] <=> $a->[2]} @sorted
			if $reg[0]->[5] == 3 && $reg[1]->[5] == 3;
	} else {
		undef $sform;
		my $i = 1;
		foreach my $e (@reg) {
			$sform .= $e->[0] if $e->[0];
			$sform .= '$'.$e->[1].'->['.$i.']'.$e->[3];
			$sform .= " $e->[0] " if $e->[0];
			$sform .= '$'.$e->[4].'->['.$i.']';
			$sform .= '||';
			$i++;
		}
		chop $sform;
		chop $sform;
		#print "\$sform:$sform";
		@sorted = sort { eval $sform }  @sorted;
	}
	return @sorted;
}

sub _get_recs {
## 	ext:true - get external values, false - don't
	my ($self, $ext, @list) = @_;
	my @indices = ();
	my $ret = [];

	@list = grep /^\-?\d+$/, @list;

	@list = $self->{NUMKEYS}->Indices($self->{NUMKEYS}->Keys) if @list == 0;

	my @spec = $self->{NUMKEYS}->Keys( @list );

	if ( defined($self->{UP}) ) {
		if (ref($db{$self->{UP}}) =~ /ARRAY/) {
			init(__PACKAGE__, $self->{UP}, @{ $db{$self->{UP}} });
		}
		die "hash element \"$self->{UP}\" exists while superior table object doesn't"
			unless defined $db{$self->{UP}};
	}

	my @down = @{$self->{DOWN}};#0.17
	for(my $i=0; $i<=$#spec; $i++) {
		if (defined $spec[$i]) {
			my $href = {}; ##-
			@{$href}{ @{$self->{FLDS}} } = @{ ${$self->{TIEHASH}}{$spec[$i]} };
			##+ 0.09
			if ( exists($href->{nodes}) ) {## && defined($href->{nodes})
				if (defined $db{$self->{UP}}) {
					my @temp = unpack "n*", $href->{nodes};
					shift @temp;
					$href->{nodes} = [@temp];
					@{$href->{nodes}} = grep defined($_), $db{$self->{UP}}->{NUMKEYS}->Indices( @{$href->{nodes}} )
						if @temp>0;
				} else {
					die "hash element \"nodes\" exists and isn't empty while superior table object doesn't exist";
				}
			} ##+ 0.09
			foreach my $e (@down) {#0.17
				my @temp = unpack "n*", $href->{$e};
				shift @temp;
				$href->{$e} = [@temp];
				if (@temp) {
					if (ref($db{$e}) =~ /ARRAY/) {
						init(__PACKAGE__, $e, @{ $db{$e} });
					}
					@{$href->{$e}} = grep defined($_), $db{$e}->{NUMKEYS}->Indices( @{$href->{$e}} );
					if ($ext && @{$href->{$e}}>0) {
						 @{$href->{$e}} = _get_recs($db{$e}, $ext, @{$href->{$e}});
					}
				}
			}
			push(@$ret, $href);
			push(@indices, $list[$i]);
		}
	}
	return wantarray?($ret, @indices):$ret;
}

##	obj->get_recs(-1); obj->get_recs; obj->get_recs(0,3,5);
##	get extended records data
sub get_ext_recs {
	my ($self, @list) = @_;
	return _get_recs($self,1,@list);
}

##	obj->get_recs(-1); obj->get_recs; obj->get_recs(0,3,5);
##	get records data
sub get_recs {
	my ($self, @list) = @_;
	return _get_recs($self,0,@list);
}

##	obj->set_recs(to); append
##	obj->set_recs(to, -1); obj->set_recs(to, 1,3,5); override
##	if LIST supplied it sets every existed element for list
##	if LIST not supplied it sets every element supplied
sub set_recs {
	my ($self, $to, @list) = @_;
##	you should check wheter it is non-duplicate elements list
	my @set = ();

	@list = grep /^\-?\d+$/,@list;#+0.12
	if (@list == 0) {
		my $next = $self->{NUMKEYS}->Length;
		@list = ($next..$next+$#{$to});
	}
	my @spec = $self->{NUMKEYS}->Keys( @list );

	if ( defined($self->{UP}) ) {
		if (ref($db{$self->{UP}}) =~ /ARRAY/) {
			init(__PACKAGE__, $self->{UP}, @{ $db{$self->{UP}} });
		}
		die "hash element \"$self->{UP}\" exists while superior table object doesn't"
			unless defined $db{$self->{UP}};
	}

	my %ext_set;
	my %ext_del;
	my ($created, $updated) = k2i($self->{FLDS},[qw/created updated/]);

	for(my $i=0; $i<@spec; $i++) {
		my $aref = [];
		if (defined $to->[$i]) {
			if (!defined $spec[$i]) {
				my ($last) = $self->{NUMKEYS}->Keys(-1);
				$last = 0 unless defined $last;
				my $last_index = $self->{NUMKEYS}->Length-1;
				$spec[$i] = $last+($list[$i]<1?0:$list[$i])-$last_index;
				##print "\$last+(\$list[\$i]<1?0:\$list[\$i])-\$last_index\n";
				##print $last,"\+",($list[$i]<1?0:$list[$i]),"\-",$last_index,"\n";
				foreach ($last+1..$spec[$i]-1) {
				## AUTOVIVIFICATION IF GAP!!!
					${ $self->{TIEHASH} }{$_} = [];
					$self->{NUMKEYS}->Push($_=>undef);
				}
				$self->{NUMKEYS}->Push($spec[$i]=>undef);
				$to->[$i]->{created} = time if defined $created;
				$to->[$i]->{updated} = undef if defined $updated;#?
				## $to->[$i]->{nodes} = undef if exists $to->[$i]->{nodes};#?
				#print "not defined created:$to->[$i]->{created} updated:$to->[$i]->{updated}\n"
			} else {
				if (@{$self->{DOWN}}) {
				##	CLEAN external "nodes"
					my $href = {};##+
					@{$href}{ @{$self->{FLDS}} } = @{ ${$self->{TIEHASH}}{$spec[$i]} };##+
					foreach my $e (@{$self->{DOWN}}) {
						if ( defined($href->{$e}) ) {
							my @temp = unpack "n*", $href->{$e};
							shift @temp;
							foreach my $el ( @temp ) {
								push(@{ $ext_del{$e} }, [ $el, $spec[$i] ]);
							}
						}
					}
				}
				$to->[$i]->{updated} = time if defined $updated;
				#print "defined created:$to->[$i]->{created} updated:$to->[$i]->{updated}\n"
			}
			if (@{$self->{DOWN}}) {
				foreach my $e (@{$self->{DOWN}}) {
					my @temp;
					if (!defined($to->[$i]->{$e})) {
					##	implictly accept 'undef'

					##	array of indices of external record
					} elsif (ref($to->[$i]->{$e}) =~ /ARRAY/) {
						shift @{ $to->[$i]->{$e} }
							if ref($to->[$i]->{$e}->[0]) =~ /ARRAY/;

						if (ref($db{$e}) =~ /ARRAY/) {
							init(__PACKAGE__, $e, @{ $db{$e} });
						}

						if (defined $db{$e}) {
						##	get numkeys of supplied indices
							@temp = $db{$e}->{NUMKEYS}->Keys( @{$to->[$i]->{$e}} );#0.12
						} else {
							die "hash element \"$e\" exists and isn't empty while superior table object doesn't exist";
						}

						foreach my $el ( @temp ) {
						##	external record numkey, record numkey
							push(@{ $ext_set{$e} }, [ $el, $spec[$i] ]);
						}
					} else {
						die "hash $e element should be array ref!!!";
					}
					#push(@temp, 0) if @temp==0;
					@temp = grep $_, @temp;
					unshift(@temp,0);
					$to->[$i]->{$e} = pack "n*", @temp;
				}
			}
			##+ 0.09
			if (defined $self->{UP}) {
				my @temp;
				if (!defined($to->[$i]->{nodes})) {
				## implicitly accept 'undef'
				} elsif ( ref($to->[$i]->{nodes}) =~ /ARRAY/ ) {
					@temp = $db{$self->{UP}}->{NUMKEYS}->Keys( @{$to->[$i]->{nodes}} );
				} else {
					die "hash \"nodes\" element should be array ref!!!";
				}
				@temp = grep $_, @temp;
				unshift(@temp,0);
				$to->[$i]->{nodes} = pack "n*", @temp;
			} ##+ 0.09
			@$aref = @{$to->[$i]}{ @{$self->{FLDS}} };
		} else {
			last;
		}
		${ $self->{TIEHASH} }{$spec[$i]} = $aref;
		push(@set, $list[$i]);
	}

	ch_nodes(\%ext_del, 1); ## DELETE
	ch_nodes(\%ext_set);    ## SET
##	RETURNS ARRAY OF ROW ELEMENT INDICES
	return @set;
}

##	DELETE OR SET
sub ch_nodes {
	my ($href, $what) = @_;
	ch_field($href, $what, "nodes");
}

##	DELETE OR SET
sub ch_field {
	my $href = shift;
	my $what = shift; ## false - SET, true - DELETE
	my $field = shift;
	my @files = keys %$href;
	if (@files>0) {
		foreach my $f (@files) {
			if (ref($db{$f}) =~ /ARRAY/) {
				init(__PACKAGE__, $f, @{ $db{$f} });
			}
			my $idx = k2i($db{$f}->{FLDS},[$field]);
			foreach my $el ( @{$href->{$f}} ) {
				my $temp = ${ $db{$f}->{TIEHASH} }{$el->[0]};
				my @temp = unpack "n*", $temp->[$idx];
				@temp = grep $_!=$el->[1], @temp
						if $what;	## DELETE
				push(@temp, $el->[1])
						unless $what;	## SET
				@temp = grep /^\d+/ && $_, @temp;##+0.11
				unshift(@temp, 0);
				$temp->[$idx] = pack "n*", @temp;
				${ $db{$f}->{TIEHASH} }{$el->[0]} = $temp;
			}
		}
	}
}

sub delete {
	my ($self, @list) = @_;
	my  @indices; ##+$aref

	@list = grep /^\-?\d+$/, @list;#+0.12

	@list = $self->{NUMKEYS}->Indices($self->{NUMKEYS}->Keys) if @list == 0;

	my @spec = $self->{NUMKEYS}->Keys( @list );

	my %up_del;
	my %down_del;

	for(my $i=0; $i<@spec; $i++) {
		if (defined $spec[$i]) {
			my $href = {}; ##-
			@{$href}{ @{$self->{FLDS}} } = @{ ${$self->{TIEHASH}}{$spec[$i]} };
			if (defined $self->{UP}) {
				if ( exists($href->{nodes}) ) {#&& defined($href->{nodes})
				##	fetch numkeys from pack'ed read structure
					my @temp = unpack "n*", $href->{nodes};
					shift @temp;
					$href->{nodes} = [@temp];
					foreach my $el ( @{$href->{nodes}} ) {
				##	external records indentification keys, key to delete
						push(@{ $up_del{$self->{UP}} }, [ $el, $spec[$i] ]);
					}
				}
			}
			if (@{$self->{DOWN}}) {
			##	CLEAN "nodes"
				foreach my $e (@{$self->{DOWN}}) {
					my @temp = ();
					if (defined $db{$e}) {
						@temp = unpack "n*", $href->{$e};
						shift @temp;
					} else {
						die "hash element \"$e\" exists while superior table object doesn't";
					}
					foreach my $el ( @temp ) {
						push(@{ $down_del{$e} }, [ $el, $spec[$i] ]);
					}
				}
			}
			delete ${$self->{TIEHASH}}{$spec[$i]}; ## DELETE
			$self->{NUMKEYS}->Delete( $spec[$i] ); ## 0.12
			push(@indices, $list[$i]);
		}
	}
	ch_field(\%up_del, 1, $self->{TABLE}); ## DELETE
	ch_nodes(\%down_del, 1); ## DELETE
	return @indices;
}

sub key2idx {
	my ($self, @args) = @_;
	return k2i($self->{NUMKEYS},\@args);
}

sub k2i {
	my ($keys, $args) = @_;
	my %conv = ();
	@conv{ @$keys } = (0..$#{$keys});
	return wantarray ? @conv{@$args} : $conv{$args->[0]};
}

sub idx2key {
	my ($self, @indices) = @_;
	return grep /^\d+/ && $_, @{$self->{NUMKEYS}}[@indices];
}

sub table {
	my $self = shift;
	return $self->{TABLE};
}

sub flds {
	my $self = shift;
	return @{$self->{FLDS}};
}

sub up {
	my $self = shift;
	return $self->{UP};
}

sub down {
	my $self = shift;
	return @{$self->{DOWN}};
}

sub numkeys {
	my $self = shift;
	return $self->{NUMKEYS}->Keys;
}

sub last {
	my $self = shift;
	return $self->{NUMKEYS}->Length-1;
}

sub name {
	my $self = shift;
	if (@_) {
		$self->{NAME} = shift;
	}
	return $self->{NAME};
}

1;
__END__