my @array = qw /a b c/;
my $hash;
my $val = 1;
($hash, $hash -> {pop @array}, $val) = (undef, $val, $hash) while @arr
+ay > 1;
$hash -> {pop @array} = $val;
[download]

Even with jeffa's notes below, it still took me a while to wrap this around my brain but when I had, I came up with this....

my @array = qw /a b c d e f/;
my $hash;
my $val = 1;
($hash->{pop @array}, $val, $hash) = ($val, $hash, undef) while @array
+;
$hash = $val;
[download]

Which is slightly cleaner?, but that final assignment stood out so...

my @array = qw /a b c d e f/;
my $hash = 1;
my $tmp;

($tmp->{pop @array}, $hash, $tmp) = ($hash, $tmp, undef)  while @array
+;
[download]

Slightly non-intuative to assign the value to the hashref at the start but...

my @array = qw /a b c/;
my %hash = map {$_ => 1} @array;
return \%hash;
[download]

can that be done with a map and a hashref rather than having to return a hashref? ripped off from tadman in Re: an easier way with grep, map, and/or sort?.
--au

return {map {$_ => 1} qw /a b c/}
[download]

Or did I understand your questing wrong?

Abigail

use strict;

my @a = ('a'..'f');
my $hash;
my $last = 1;

for (reverse @a) {
   $hash->{$_} = $last;
   $last = {$_ => $hash->{$_}};
}
delete $hash->{$a[$_]} for (1..@a);
[download]

UPDATE: Ok, let's figure Abigail-II's code out ...

• Iteration 1:
• @array = ('a','b','c');
• atomic:
• $hash = undef;
• $hash->{a} = $val; # $val = 1
• $val = $hash;
• # is ('b','c') > 1 ? yes
• Iteration 2:
• @array = ('b','c');
• atomic:
• $hash = undef;
• $hash->{b} = $val; # $val = {a => 1}
• $val = $hash;
• # is ('c') > 1 ? no
• Last line: (note that $hash is currently undef)
• $hash->{c} = $val; # $val = {b => {a => 1}}

UPDATE*2:
I think i like Anony's answer the best ... now that is using Perl to write Perl! /smack forehead

jeffa

L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)

You can break it into 4 separate assignments though....

Abigail

use strict;

my @array =  qw/a b c d e f/;

my $t = my $hashref = {};
while (@array) { $t = $t->{ shift @array } = @array>1 ? {} : 1 };
[download]

Eval man!

my @array = qw/a b c d/;

my $ref = {};

$code = '$ref->{'.join('}->{', @array).'} = 1;';

eval $code;

use Data::Dumper;
print Dumper($ref);

Check it out, and also the thread word association problem

-jackdied

push @arr,1 if @arr % 2;
$h={@arr};
[download]