[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