[tpm] Populating an unfixed number of hash elements
Shaun Fryer
sfryer at sourcery.ca
Fri May 9 10:46:07 PDT 2008
Nice and small. I like it. Here's the alternate solution I just came up with.
Like yours, uses a recursive helper function, but also works with a global hash.
################################################################################
use strict;
use warnings;
use Data::Dumper;
my $string1="some::string::of::elements";
my $string2="some::string";
my $string3="some::string::of::other::elements";
my $string4="another::set::of::keys";
my %hash = ();
mk_href(\%hash, $string1, "a value");
mk_href(\%hash, $string2, 12);
mk_href(\%hash, $string3, "a really long string that takes up pages");
mk_href(\%hash, $string4, "something else again.");
print Dumper \%hash;
sub mk_href {
my ($href, $keystr, $value) = @_;
my @keys = split /::/, $keystr;
my $last_key = pop @keys;
my $_href = {};
$_href->{$last_key} = { $value => 1 };
while (my $key = pop @keys) {
my $elem = {};
$elem->{$key} = $_href;
$_href = $elem;
}
add_href($href, $_href);
}
sub add_href {
my ($href1, $href2) = @_;
for my $key (keys %$href2) {
if (ref $href1->{$key} eq 'HASH') {
add_href( $href1->{$key}, $href2->{$key} );
} else {
$href1->{$key} = $href2->{$key};
}
}
}
################################################################################
--
Shaun Fryer
cl: 905-920-9209
On Fri, May 09, 2008 at 02:00:39PM -0400, Viktor Pavlenko wrote:
> >>>>> "SF" == Shaun Fryer <sfryer at sourcery.ca> writes:
>
> SF> Actually, this may be more what you intended. However, notice
> SF> that the key/value may get over-ridden in case of
> SF> collisions.
>
> If she avoids global hash, there will be no problem ...
>
> SF> sub mk_href {
> SF> my ($href, $keystr, $value) = @_;
> SF> my @keys = split /::/, $keystr;
> SF> my $last_key = pop @keys;
> SF> my $_href = {};
> SF> $_href->{$last_key} = $value;
> SF> while (my $key = pop @keys) {
> SF> my $elem = {};
> SF> $elem->{$key} = $_href;
> SF> $_href = $elem;
> SF> }
> SF> $href->{$_} = $_href->{$_} for keys %$_href;
> SF> }
>
> ... and then this:
>
> -------------------------------------------------------------------->8
> sub mk_href
> {
> my ($keystr, $value) = @_;
> my @keys = reverse split /::/, $keystr;
> helper($value, @keys);
> }
>
> sub helper
> {
> my ($val, @keys) = @_;
> my $k = pop @keys;
> my $hr = {};
> $hr->{$k} = ($#keys == -1) ? $val : helper($val, @keys);
> return $hr;
> }
> -------------------------------------------------------------------->8
>
> --
> Viktor
>
More information about the toronto-pm
mailing list