[tpm] Solved: Re: Populating an unfixed number of hash elements

[Madison Kelly]

I responded to this some time ago, but neglected to include TPM in the 
reply-to. I hope people don't mind me re-sending this after so much 
time, but I wanted to get in into the archives, in case it helps someone 
down the road.

The variation I used is at the end of this message. Thanks again, Shaun 
and Viktor!

Madi

Shaun Fryer wrote:
> 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
>>
> _______________________________________________
> toronto-pm mailing list
> toronto-pm at pm.org
> http://mail.pm.org/mailman/listinfo/toronto-pm
> 

Thank you both very kindly!

I needed to make a slight change, but the final example was close to
perfect. The only real difference was that you're example was using the
$value as a final key in the hash, set to a value of '1'. I needed the
'$value' to be the contents of the hash string.

For reference:

-=-=-=-=-=-
# Contributed by Shaun Fryer and Viktor Pavlenko by way of GTALUG.
sub _mk_href
{
	my $self=shift;
	my $href=shift;
	my $key_string=shift;
	my $value=shift;
	
	if ($self->{CHOMP_ROOT}) { $key_string=~s/\w+:://; }
	
	my @keys = split /::/, $key_string;
	my $last_key = pop @keys;
	my $_href = {};
	$_href->{$last_key}=$value;
	while (my $key = pop @keys)
	{
		my $elem = {};
		$elem->{$key} = $_href;
		$_href = $elem;
	}
	$self->_add_href($href, $_href);
}

sub _add_href
{
	my $self=shift;
	my $href1=shift;
	my $href2=shift;
	
	for my $key (keys %$href2)
	{
		if (ref $href1->{$key} eq 'HASH')
		{
			$self->_add_href( $href1->{$key}, $href2->{$key} );
		}
		else
		{
			$href1->{$key} = $href2->{$key};
		}
	}
}
-=-=-=-=-=-

The '$self=shift;' line is needed as these are methods in a module, so
'$self' is the first value shifted in. The leading '_' is just to
indicate that, in my case, these are internal methods.

The '$_href->{$last_key}=$value;' is what I changed to have the value be
the stored data. Lastly, 'if ($self->{CHOMP_ROOT}) {
$key_string=~s/\w+:://; }' is an internal variable that I use the check
I am to mimic XML::Simple's habit of dropping the initial hash reference
  (no, I have no idea why it does this, but I need my module to be a
drop-in replacement for it, so...).

Thanks again, you guys were a huge help!

Madi