Martin Moss wrote:
> Hi All,
>
> Wondering if anybody has an 'efficient' Hat on today?
>
> I Have a Hash who's Key's are all 'Module Names'.
> e.g.
>
> Foo=>1
> Foo::Bar=>1
> Foo::Bar::Poo=>1
> Foo::Beer=>1
> Foo::Beer::Nuts=>1
> Foo::Beer::Nuts::Hmmm=>1
> Foo::Bar::AgainHmmm=>1
>
> What I want to do is to turn this hash into a Hierarchical Hash based upon
> the Module Name Structure e.g.
>
> {
> 'Foo=>{
> 'Foo::Bar'=> {
> 'Foo::Bar::Poo'=>1,
> 'Foo::Bar::AgainHmmm=>1,
> },
> 'Foo::Beer=>{
> 'Foo::Beer::Nuts=>{
>
> Foo::Beer::Nuts::Hmmm=>1,
> },
> }
> }
> }
>
> The Strucuture can be unlimited in depth.
> Can anybody suggest an efficient Solution?
> Is it possible to use grep on the hash Keys?
>
> My Other question is, If The Original Hash was an @array could the structure
> be built on the fly, or do I need to know all the hash keys in advance?
> (I ask this coz I generate the original hash structure from an array (whilst
> doing other processing) and wondered if I could tie it all in together)
It would be hard to build on the fly since you don't know the depth yet. You
need to either re-structure the final hash or sort when complete.
use strict;
use Data::Dumper; $Data::Dumper::Indent=1;
my %hash = (
Foo => 1,
Foo::Bar => 1,
Foo::Bar::Poo => 1,
Foo::Beer => 1,
Foo::Beer::Nuts => 1,
Foo::Beer::Nuts::Hmmm => 1,
Foo::Bar::AgainHmmm => 1,
);
print Data::Dumper->Dump([\%hash], [qw(%hash)]);
my %newhash;
foreach (reverse sort keys %hash) {
my @l = split /::/, $_;
my $path = '';
for (my $ii = 0; $ii < @l; $ii++) {
$path .= "'}{'" if $path;
$path .= join '::', @l[0..$ii];
my $exists = eval "exists \$newhash{'$path'}" || 0;
if (not $exists) {
if ($ii < scalar @l - 1) {
eval "\$newhash{'$path'} = {}";
} else {
eval "\$newhash{'$path'} = 1";
}
}
}
}
print Data::Dumper->Dump([\%newhash], [qw(%newhash)]);
__END__
--
,-/- __ _ _ $Bill Luebkert Mailto:[EMAIL PROTECTED]
(_/ / ) // // DBE Collectibles Mailto:[EMAIL PROTECTED]
/ ) /--< o // // Castle of Medieval Myth & Magic http://www.todbe.com/
-/-' /___/_<_</_</_ http://dbecoll.tripod.com/ (Free site for Perl/Lakers)
_______________________________________________
Perl-Unix-Users mailing list
[EMAIL PROTECTED]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
