package Tie::HashTree;
use Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(hash_to_tree);
require 5.000;
use strict;
use warnings;
=head1 NAME
Tie::Tree - class definition for creating a Tree data type by tieing a
+ hash
=head1 SYNOPSIS
use Tie::Tree;
# create a new tree
my $new_tree = tie my %new_hash, 'Tree';
# turn an existing hash into a tree
my $converted_tree = tie my %tree_with_values, 'Tie::HashTree';
($converted_tree, %tree_with_values) = hash_to_tree(%hash_with_values)
+;
=head1 DESCRIPTION
Tie::HashTree allows you to create a tree data structure by tieing a h
+ash.
You can access (and assign) values to the Tree through the hash. For
instance, to access a node on the branch foo, which branches off of br
+anch
bar, which branches off of branch baz, in the tree quux, you would use
+
$quux{"baz->bar->foo"}. (or, if you need visual stimulation:
quux
\
baz
\
bar
\
foo
). You can move up and down the tree with move_down() and move_up(),
+move to a branch
with move_to, dump the tree in a nice indented format with dump_tree()
+, or even convert
a hash to a tree with hash_to_tree(). Tie::HashTree handles anyonomou
+s arrays and hashes
very nicely, so it would be a handy tool to create linked lists, or st
+ore directory info,
etc.
=over 5
=item move_to path
move down the path starting from the root level to the specified l
+evel.
=item move_up
move up one level in the tree.
=item move_down path
if the path exists in the current path, move down to that level.
=item dump_tree level
dumps the tree in a nice indented format. you may specify a sub-b
+ranch via
the lone argument
=item convert_hash hash
the lone exported function. it takes one argument: a hash. the h
+ash is then
trasformed into a HashTree Object. The funtion returns the object
+.
=back
=head1 EXAMPLES
# Tieing the hash. Don't forget -w and strict; :)
#!/usr/bin/perl -w
use strict;
use Tie::HashTree qw(hash_to_tree);
my $tree = tie my %x, 'Tie::HashTree';
# Creating branches and assigning values.
$x{"item->narf"}="narf1";
$x{"item->meep"}="meep1";
$x{"item->foo"} ="foo1";
$x{"item->bar"} ="bar1";
$x{"item->baz"} ="baz1";
$x{"item->bleh->quux"} = "quux1";
$x{"item->bleh->blah"} = "blah1";
$x{"item1->meep"}="meep2";
$x{"item1->narf"}="narf2";
$x{"item1->arg->foo"}="foo2";
$x{"item1->arg->zoom"}=["zoom1", "zoom2", "zoom3"];
$x{"item1->arg->beep"}={beepk1=>"beekv1", beepk2=>"beekv2", beepk3
+=>"beepv3", beepk4=>{beepk5=>"beepv5", beepk6=>"beepv6"}};
$tree->dump_tree;
# Test for a branch's existance.
print "blah\n" if (exists($x{"item->blah"}));
print "narf\n" if (exists($x{"item->narf"}));
# deleting a branch
delete($x{"item->narf"});
# Looping throuhg a branch.
while (my($key,$value) = each %{$x{"item->bleh"}})
{
print "$key=$value\n";
}
# Using move_down and move_up to move through the tree
print $x{"item1->arg->zoom->[0]"};
$tree->move_down("item1");
print "\n";
print $x{"arg->zoom->[0]"}, "\n";
$tree->move_up;
print $x{"item1->arg->zoom->[0]"};
# Using move_to to move through the tree from the base level
print $x{"item1->arg->zoom->[0]"};
$tree->move_to("item1->arg->zoom");
print "\n";
print $x{"[0]"}, "\n";
$tree->move_to("");
print $x{"item1->arg->zoom->[0]"};
# Creating a HashTree out of an existing hash.
my %temp;
$temp{blah} = "meep1";
$temp{zarg} = "zimzum";
$temp{meep} = {};
$temp{meep}->{narf} = "foo";
$temp{meep}->{broohaha} = "bar";
$temp{baz} = ["baz1", "baz2", "baz3"];
my $tree2 = tie my %new_temp, 'Tie::HashTree';
($tree2, %new_temp) = hash_to_tree(%temp);
$tree2->dump_tree;
=head1 AUTHOR
Joseph F. Ryan, 580ryan@erienet.net (or ryan.306@osu.edu after 9/17/20
+01)
=cut
sub TIEHASH
{
my ($class, $self) = @_;
$self->{level} = "";
$self->{name} = $class;
$self->{top} = {};
bless ($self, $class);
}
sub STORE
{
my($self,$key,$value) = @_;
my @values = ($value) unless (ref($value));
@values = @$value if (ref($value) eq "ARRAY");
my %values = %$value if (ref($value) eq "HASH");
$key =~ tr/ //d;
my @levels = split(/\->/, $key);
$key = build_string($self->{level}, $key);
if (%values){$key.="={\%values}"}
else
{
$key .= "=\"$values[0]\"" unless (scalar(@values) > 1);
$key .= "=\[\@values\]" if (scalar(@values) > 1);
}
eval($key);
}
sub FETCH
{
my($self, $key) = @_;
$key = build_string($self->{level}, $key);
return eval($key);
}
sub EXISTS
{
my($self, $key) = @_;
$key = build_string($self->{level}, $key);
eval($key);
}
sub CLEAR
{
my($self, $key) = @_;
delete ($self->{top});
$self->{top} = {};
}
sub DELETE
{
my($self, $key) = @_;
$key = build_string($self->{level}, $key);
eval("delete($key)");
}
sub FIRSTKEY
{
my $self = shift;
my $key = build_string($self->{level}, $self->{level}, 1);
each %{eval($key)}
}
sub NEXTKEY
{
my($self, $key) = @_;
$key = build_string($self->{level}, $key, 1);
each %{eval($key)};
}
sub build_string
{
my $level = shift;
my $key = shift;
my $offset = shift || 0;
$key = $level.$key;
$key =~ tr/ //d;
my @levels = split(/\->/, $key);
$key = "\$self->{top}";
for (my $i=0; $i<(@levels-$offset); $i++)
{
$key .= "->{$levels[$i]}" unless ($levels[$i] =~ /^\[\d+\]$/);
$key .= "->$levels[$i]" if ($levels[$i] =~ /^\[\d+\]$/);
}
return $key;
}
sub dump_tree
{
my $self = shift;
my $item1 = shift || "";
my $layer = shift || 1;
my $item = build_string($self->{level}, $item1);
my @items = split(/\->/, $item1);
$item = eval($item);
print "$items[$#items]\n" if ($layer==1 && $item1 ne "");
print "$self->{name}\n" if ($item1 eq "" && $self->{level} eq "");
if ($self->{level} ne "")
{
@items = split(/\->/, $self->{level});
print "$items[$#items]\n";
}
while (my($key,$value) = each %{$item})
{
print " " x ($layer*3);
print "$key\n", " " x (($layer+1)*3), "$value\n" unless ref(ev
+al("\$item->{$key}"));
if (ref(eval("\$item->{$key}")) eq "HASH")
{
print "$key\n";
$item1 = "$item1->" unless $item1 eq "";
$item1 = "" if $item1 eq "";
dump_tree($self, "$item1$key", $layer+1);
}
if (ref(eval("\$item->{$key}")) eq "ARRAY")
{
print "$key\n";
my @temp = eval("\@{\$item\->{$key}}");
foreach my $item (@temp)
{
print " " x (($layer+1)*3);
print "$item\n";
}
}
}
}
sub move_to
{
my($self, $level) = @_;
$self->{level} = $level;
$self->{level} .= "->" if $level ne "";
}
sub move_up
{
my $self = shift;
my @levels = split(/\->/, $self->{level});
$self->{level} = "";
for(my $i=0; $i<@levels-2; $i++){$self->{level} .= $levels[$i]."->
+"}
$self->{level} .= $levels[$#levels-1] if (scalar(@levels) > 1);
}
sub move_down
{
my $self = shift;
my $path = shift;
$self->{level} .= "$path\->";
}
sub hash_to_tree
{
my($self, $state, $level, %old, %new);
if (scalar(@_) % 2 == 1)
{
$self = shift;
$state = shift;
$level = shift;
$state .= "->";
}
else
{
$self = tie %new, 'Tie::HashTree';
$state = "";
$level = 0;
}
%old = @_;
while (my($key,$value) = each %old)
{
my $item = build_string($self->{level}, "$state$key");
$new{"$state$key"} = $value unless ref($old{$key});
eval("$item=\"$value\"") unless ref($old{$key});
if (ref($old{$key}) eq "HASH")
{
$state = "$state\->" unless $state eq "";
($self, %new) = hash_to_tree($self, "$state$key", $level+1
+, %{$old{$key}});
}
if (ref($old{$key}) eq "ARRAY")
{
my @values = @{$old{$key}};
$key = "$item";
$key .= "=\[\@values\]";
eval($key);
$new{"$state$key"} = [@values];
}
}
my @return_values = ($self, %new);
return @return_values;
}
"JAPH";
|