lib/Tie/ListKeyedHash.pm

package Tie::ListKeyedHash;

use strict;

BEGIN {
	$Tie::ListKeyedHash::VERSION = "1.02";
}

my $func_table = {}; # storage for the anon CODE refs used for hash lookups

####

sub new {
	my $proto   = shift;
	my $package = __PACKAGE__;
	my $class;
	if (ref($proto)) {
		$class = ref($proto);
	} elsif ($proto) {
		$class = $proto;
	} else {
		$class = $package;
	}
    my $self;
    if (1 == @_) {
        $self = shift;

    } else {
        $self = {};
    }
	bless $self,$class;

	if (0 < @_) {
		require Carp;
		Carp::confess($package . '::new() - Unexpected parameters passed');
	}

	return $self;
}

####

sub TIEHASH {
	return new(@_);
}

####

sub STORE {
	my $self = shift;

	my ($key,$value) = @_;
	if (not ref $key) {
		$key = [split(/$;/,$key)];
	}
	return $self->put($key,$value);
}

####

sub FETCH {
	my $self = shift;

	my ($key) = @_;
	if (not ref $key) {
		$key = [split(/$;/,$key)];
	}
	return $self->get($key);
}

####

sub DELETE {
	my $self = shift;
	
	my ($key) = @_;
	if (not ref $key) {
		$key = [split(/$;/,$key)];
	}
	return $self->delete($key);
}

####

sub CLEAR {
	my $self = shift;

	return $self->clear;
}

####

sub EXISTS {
	my $self = shift;

	my ($key) = @_;
	if (not ref $key) {
		$key = [split(/$;/,$key)];
	}

	return $self->exists($key);
}

####

sub FIRSTKEY {
	my $self = shift;
	
	my $a = keys %{$self}; # Resets the 'each' to the start
	my $key = scalar each %{$self};
	return if (not defined $key);
	return [$key];
}

####

sub NEXTKEY {
	my $self = shift;

	my ($last_key) = @_;
	my $key = scalar each %{$self};
	return if (not defined $key);
	return [$key];
}

####

sub clear {
	my ($self) = shift;

	%$self = ();
}

####

sub exists {
	my ($self) = shift;

	my ($data_ref) = @_;

	my @data = eval { @$data_ref; };
    if ($@) {
        require Carp;
        Carp::confess("bad key passed to exists");
    }

	# Its _OK_ if the hash element doesn't exist
	local $^W = undef;

	if ($#data == 0) {
		return CORE::exists $$self{$data[0]};
	} elsif ($#data == 1) {
		return CORE::exists $$self{$data[0]}{$data[1]};
	} elsif ($#data > 12) {
		my $anon_sub = $func_table->{-func_index}->{-exists}->[$#data];
		unless (defined $anon_sub) {
			my $lookup = '$$self';
			my $count;
			for ($count=0;$count<=$#data;$count++) {
				$lookup .= '{$$dataref[' . $count . ']}';
			}
			$lookup =<<"EOF";
sub {
my (\$self,\$dataref) = \@_;
return CORE::exists ($lookup);
};
EOF
			$anon_sub = eval ($lookup);
			$func_table->{-func_index}->{-exists}->[$#data] = $anon_sub;
		}
		return $self->$anon_sub(\@data);
	} elsif ($#data == 2) {
		return CORE::exists $$self{$data[0]}{$data[1]}{$data[2]};
	} elsif ($#data == 3) {
		return CORE::exists $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]};
	} elsif ($#data == 4) {
		return CORE::exists $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]};
	} elsif ($#data == 5) {
		return CORE::exists $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]};
	} elsif ($#data == 6) {
		return CORE::exists $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]};
	} elsif ($#data == 7) {
		return CORE::exists $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]};
	} elsif ($#data == 8) {
		return CORE::exists $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]};
	} elsif ($#data == 9) {
		return CORE::exists $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]};
	} elsif ($#data == 10) {
		return CORE::exists $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]}{$data[10]};
	} elsif ($#data == 11) {
		return CORE::exists $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]}{$data[10]}{$data[11]};
	} else { # if ($#data == 12) {
		return CORE::exists $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]}{$data[10]}{$data[11]}{$data[12]};
	}
}

####

sub get {
	my $self = shift;

	my ($data_ref) = @_;

	my @data = @$data_ref;

	# Its _OK_ if the hash element doesn't exist
	local $^W = undef;

	if ($#data == 0) {
		return $$self{$data[0]};
	} elsif ($#data == 1) {
		return $$self{$data[0]}{$data[1]};
	} elsif ($#data > 12) {
		my $anon_sub = $func_table->{-func_index}->{-get}->[$#data];
		unless (defined $anon_sub) {
			my $lookup = '$$self';
			my $count;
			for ($count=0;$count<=$#data;$count++) {
				$lookup .= '{$$dataref[' . $count . ']}';
			}
			$lookup =<<"EOF";
sub {
my (\$self,\$dataref) = \@_;
return $lookup;
};
EOF
			$anon_sub = eval ($lookup);
			$func_table->{-func_index}->{-get}->[$#data] = $anon_sub;
		}
		return $self->$anon_sub(\@data);
	} elsif ($#data == 2) {
		return $$self{$data[0]}{$data[1]}{$data[2]};
	} elsif ($#data == 3) {
		return $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]};
	} elsif ($#data == 4) {
		return $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]};
	} elsif ($#data == 5) {
		return $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]};
	} elsif ($#data == 6) {
		return $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]};
	} elsif ($#data == 7) {
		return $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]};
	} elsif ($#data == 8) {
		return $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]};
	} elsif ($#data == 9) {
		return $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]};
	} elsif ($#data == 10) {
		return $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]}{$data[10]};
	} elsif ($#data == 11) {
		return $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]}{$data[10]}{$data[11]};
	} elsif ($#data == 12) {
		return $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]}{$data[10]}{$data[11]}{$data[12]};
	} else { # if ($#data == -1) 
		return $self;
	}
}

####

sub put {
	my $self = shift;

	my ($data_ref,$value) = @_;

	my @data = @$data_ref;

	unless (2 == @_) {
		require Carp;
		Carp::confess ("Tie::ListKeyedHash::put called without a value to set.\n");

	} elsif ($#data == 0) {
		$$self{$data[0]} = $value;

	} elsif ($#data == 1) {
		$$self{$data[0]}{$data[1]} = $value;

	} elsif ($#data > 12) {
		my $anon_sub =  $func_table->{-func_index}->{-put}->[$#data];
		unless (defined $anon_sub) {
			my $lookup = '$$self';
			my $count;
			for ($count=0;$count<=$#data;$count++) {
				$lookup .= '{$$dataref[' . $count . ']}';
			}
		$lookup =<<"EOF";
sub {
	my (\$self,\$dataref,\$valueref) = \@_;
	$lookup = \$valueref;
};
EOF
			$anon_sub = eval ($lookup);
			$func_table->{-func_index}->{-put}->[$#data] = $anon_sub;
		}
		$self->$anon_sub(\@data,$value);
	} elsif ($#data == 2) {
		$$self{$data[0]}{$data[1]}{$data[2]} = $value;
	} elsif ($#data == 3) {
		$$self{$data[0]}{$data[1]}{$data[2]}{$data[3]} = $value;
	} elsif ($#data == 4) {
		$$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]} = $value;
	} elsif ($#data == 5) {
		$$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]} = $value;
	} elsif ($#data == 6) {
		$$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]} = $value;
	} elsif ($#data == 7) {
		$$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]} = $value;
	} elsif ($#data == 8) {
		$$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]} = $value;
	} elsif ($#data == 9) {
		$$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]} = $value;
	} elsif ($#data == 10) {
		$$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]}{$data[10]} = $value;
	} elsif ($#data == 11) {
		$$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]}{$data[10]}{$data[11]} = $value;
	} elsif ($#data == 12) {
		$$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]}{$data[10]}{$data[11]}{$data[12]} = $value;
	} else { # if ($#data == -1) 
		require Carp;
		Carp::confess ("Tie::ListKeyedHash::put called without a valid key.\n");
	}
}

####

sub delete {
	my ($self) = shift;

	my ($data_ref) = @_;

	my @data = @$data_ref;

	if ($#data == 0) {
		delete $$self{$data[0]};
	} elsif ($#data == 1) {
		delete $$self{$data[0]}{$data[1]};
	} elsif ($#data > 12) {
		my $anon_sub = $func_table->{-func_index}->{-clear}->[$#data];
		unless (defined $anon_sub) {
			my $lookup = '$$self';
			my $count;
			for ($count=0;$count<=$#data;$count++) {
				$lookup .= '{$$dataref[' . $count . ']}';
			}
			$lookup =<<"EOF";
sub {
	my (\$self,\$dataref) = \@_;
	delete $lookup;
};
EOF
			$anon_sub = eval ($lookup);
			$func_table->{-func_index}->{-clear}->[$#data] = $anon_sub;
		}
		$self->$anon_sub(\@data);
	} elsif ($#data == 2) {
		delete $$self{$data[0]}{$data[1]}{$data[2]};
	} elsif ($#data == 3) {
		delete $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]};
	} elsif ($#data == 4) {
		delete $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]};
	} elsif ($#data == 5) {
		delete $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]};
	} elsif ($#data == 6) {
		delete $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]};
	} elsif ($#data == 7) {
		delete $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]};
	} elsif ($#data == 8) {
		delete $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]};
	} elsif ($#data == 9) {
		delete $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]};
	} elsif ($#data == 10) {
		delete $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]}{$data[10]};
	} elsif ($#data == 11) {
		delete $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]}{$data[10]}{$data[11]};
	} elsif ($#data == 12) {
		delete $$self{$data[0]}{$data[1]}{$data[2]}{$data[3]}{$data[4]}{$data[5]}{$data[6]}{$data[7]}{$data[8]}{$data[9]}{$data[10]}{$data[11]}{$data[12]};
	} else { # if ($#data < 0) That is what 'clear' is for ;)
		require Carp;
		Carp::confess ("Tie::ListKeyedHash::_delete object field called with no fields specified.\n");
	}
}

####

sub DESTROY {}

####

1;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)