I am vaguely confused a bit on different methods of passing certain arguments to the constructor type. I want to only pass a hash reference \%hash, or a list foo => 1, bar => 1 but not both and croak if anything else is passed i.e ( single elements, array reference ).
For example, I pass my reference or list.. (This works for the way I do this)
my $obj = foo->new;
my $data = $obj->dump( \%hash );
my $data = $obj->dump( foo => 1, bar => 1 );
or
my $obj = foo->dump( \%hash );
my $obj = foo->dump( foo => 1, bar => 1 );
Package module:
package foo;
use strict;
use Carp;
use Scalar::Util qw/reftype/;
sub new { return bless {}, shift }
sub dump {
my $class = shift;
my $self = shift;
unless ( reftype( $self ) eq reftype {} ) {
croak("Constructor method not a hash type!");
}
}
1;
I've also thought about using the conditional operator ? : here, but I can't get it to error properly.
my $self = reftype($_[0]) eq reftype {} ? shift : {#_};
Is there a better preferred way to do this?
We can look at the various ways your dump method can be called.
If we pass a "hash list", the number of elements is even (#_ % 2 == 0). Also, if at least one key-value pair is present, the first argument (a key) is a string, so not defined reftype $_[0] holds.
If we pass a hash reference, then the argument list should only hold this reference, and no other values: #_ == 1. The first argument will be a hash: reftype($_[0]) eq 'HASH'.
So to put the arguments in a hash reference, one could do something like:
sub dump {
my $invocant = shift;
my $hashref;
if (#_ == 1 and reftype $_[0] eq 'HASH') {
$hashref = $_[0];
} elsif (#_ % 2 == 0 and (#_ == 0 or not defined reftype $_[0])) {
$hashref = +{ #_ };
} else {
croak "Unknown argument format: either pass a hashref, or an even-valued list";
}
...; # do something with $hashref
}
To find out if the $invocant is the class name or an object, just ask it if it is blessed:
if (defined Scalar::Util::blessed $invocant) {
say "Yep, it is an object";
} else {
say "Nope, it is a package name";
}
There's no such thing as a "hash list". foo => 1, bar => 1, is just a four element list. Sounds like you want to accept hash refs and even numbers of args.
sub dump {
my $self = shift;
my %args;
if (#_ == 1) {
croak("...") if (ref($_[0]) // '') ne 'HASH';
%args = %{ $_[0] };
} else {
croak("...") if #_ % 2 != 0;
%args = #_;
}
...
}
Related
i am very new to perl. i am trying to use the below code from CPAN.
my $C;
# Recursive version of C<each>;
sub reach {
my $ref = shift;
if (ref $ref eq 'HASH') {
if (defined $C->{$ref}{v}) {
if (ref $C->{$ref}{v} eq 'HASH') {
if (my #rec = reach($C->{$ref}{v})) {
return ($C->{$ref}{k},#rec);
}
} elsif (ref $C->{$ref}{v} eq 'ARRAY') {
if (my #rec = reach($C->{$ref}{v})) {
if (defined $C->{$ref}{k}) {
return $C->{$ref}{k},#rec;
}
return #rec;
}
}
undef $C->{$ref};
}
if (my ($k,$v) = each %$ref) {
$C->{$ref}{v} = $v;
$C->{$ref}{k} = $k;
return ($k,reach($v));
}
return ();
} elsif (ref $ref eq 'ARRAY') {
if (defined $C->{$ref}{v}) {
if (ref $C->{$ref}{v} eq 'HASH' ||
ref $C->{$ref}{v} eq 'ARRAY') {
if (my #rec = reach($C->{$ref}{v})) {
if (defined $C->{$ref}{k}) {
return $C->{$ref}{k},#rec;
}
return #rec;
}
}
}
if (my $v = $ref->[$C->{$ref}{i}++ || 0]) {
$C->{$ref}{v} = $v;
return (reach($v));
}
return ();
}
return $ref;
}
input:
bar => {cmd_opts => { gld_upf => ['abc' , 'def']} }
current output:
[bar, cmd_opts, gld_upf, abc]
[bar, cmd_opts, gld_upf, def]
desired output:
[bar, cmd_opts, gld_upf, ['abc', 'def']]
also, what are the concepts that are being used in this code?
are there any books/courses i can take for this?
also, what are the concepts that are being used in this code? are there any books/courses i can take for this?
The code mentioned by you from the Deep::Hash::Utils CPAN module is mainly handling nested data structures.
A couple of places to read about these:
the official docs: perldsc ; perlreftut ; perlref ;
Modern Perl by chromatic has a section on Nested Data Structures around page 60
Intermediate Perl: Beyond The Basics of Learning Perl 2nd edition has a section about Nested Data Structures around page 44.
In the most basic case, in these nested data structures, every node has one of the following types:
scalar
hashref
arrayref
In turn, the values in the array pointed to by an arrayref can be of type scalar/hashref/arrayref.
The same goes for the values of the hash pointed to by an arrayref, it can be of type scalar/hashref/arrayref.
This induces a tree-like structure. The algorithm for traversing such a tree is depth-first search
where some additional logic is required to check the type of the node and depending on the type decide how to proceed further down the tree.
To make a parallel, all of this is not that much different from traversing a filesystem hierarchy (see link1, link2).
A bigger list called perlres on Perl resources is available.
In this specific case, the function reach from Deep::Hash::Utils acts as an iterator, and it returns all paths descending from the root down to each leaf.
Whenever a #path to a leaf is found, its elements are compared side-by-side with another list called #output, and there are three cases:
there's no element on that position, so we store it
the elements are equal, so we skip them
the elements are different, so we merge them together in a list
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use Deep::Hash::Utils qw/reach/;
my $input = { bar => {cmd_opts => { gld_upf => ['abc' , 'def']} } };
my #output = ();
while (my #path = reach($input)) {
for(my $i=0;$i<=$#path;$i++){
if(defined $output[$i]) {
if(ref($output[$i]) eq "") {
if($output[$i] eq $path[$i]) {
next;
};
my $e1 = $output[$i];
my $e2 = $path[$i];
$output[$i] = [$e1,$e2];
}elsif(ref($output[$i]) eq "ARRAY"){
push #{$output[$i]}, $path[$i];
};
} else {
$output[$i] = $path[$i];
};
};
}
print Dumper \#output;
OUTPUT:
$VAR1 = [
'bar',
'cmd_opts',
'gld_upf',
[
'abc',
'def'
]
];
I have a hash with a few values that are not scalar data but rather anonymous subroutines that return scalar data. I want to make this completely transparent to the part of the code that looks up values in the hash, so that it doesn't have to be aware that some of the hash values may be anonymous subroutines that return scalar data rather than just plain old scalar data.
To that effect, is there any way to have the anonymous subroutines executed when their keys are accessed, without using any special syntax? Here's a simplified example that illustrates the goal and the problem:
#!/usr/bin/perl
my %hash = (
key1 => "value1",
key2 => sub {
return "value2"; # In the real code, this value can differ
},
);
foreach my $key (sort keys %hash) {
print $hash{$key} . "\n";
}
The output I would like is:
perl ./test.pl
value1
value2
Instead, this is what I get:
perl ./test.pl
value1
CODE(0x7fb30282cfe0)
As noted by Oleg, it's possible to do this using various more or less arcane tricks like tie, overloading or magic variables. However, this would be both needlessly complicated and pointlessly obfuscated. As cool as such tricks are, using them in real code would be a mistake at least 99% of the time.
In practice, the simplest and cleanest solution is probably to write a helper subroutine that takes a scalar and, if it's a code reference, executes it and returns the result:
sub evaluate {
my $val = shift;
return $val->() if ref($val) eq 'CODE';
return $val; # otherwise
}
and use it like this:
foreach my $key (sort keys %hash) {
print evaluate($hash{$key}) . "\n";
}
I don't believe that the words that others have written in disapproval of the tie mechanism are warranted. None of the authors seem to properly understand how it works and what core library backup is available
Here's a tie example based on Tie::StdHash
If you tie a hash to the Tie::StdHash class then it works exactly as a normal hash. That means there's nothing left to write except for methods that you may want to override
In this case I've overridden TIEHASH so that I could specify the initialisation list in the same statement as the tie command, and FETCH, which calls the superclass's FETCH and then makes a call to it if it happens to be a subroutine reference
Your tied hash will work as normal except for the change that you have asked for. I hope it is obvious that there is no longer a direct way to retrieve a subroutine reference if you have stored it as a hash value. Such a value will always be replaced by the result of calling it without any parameters
SpecialHash.pm
package SpecialHash;
use Tie::Hash;
use base 'Tie::StdHash';
sub TIEHASH {
my $class = shift;
bless { #_ }, $class;
}
sub FETCH {
my $self = shift;
my $val = $self->SUPER::FETCH(#_);
ref $val eq 'CODE' ? $val->() : $val;
}
1;
main.pl
use strict;
use warnings 'all';
use SpecialHash;
tie my %hash, SpecialHash => (
key1 => "value1",
key2 => sub {
return "value2"; # In the real code, this value can differ
},
);
print "$hash{$_}\n" for sort keys %hash;
output
value1
value2
Update
It sounds like your real situation is with an existing hash that looks something like this
my %hash = (
a => {
key_a1 => 'value_a1',
key_a2 => sub { 'value_a2' },
},
b => {
key_b1 => sub { 'value_b1' },
key_b2 => 'value_b2',
},
);
Using tie on already-populated variables isn't so neat as tying then at the point of declaration and then inserting the values as the data must be copied to the tied object. However the way I have written the TIEHASH method in the SpecialHash class makes this simple to do in the tie statement
If possible, it would be much better to tie each hash before you put data into it and add it to the primary hash
This program ties every value of %hash that happens to be a hash reference. The core of this is the statement
tie %$val, SpecialHash => ( %$val )
which functions identically to
tie my %hash, SpecialHash => ( ... )
in the previous code but dereferences $val to make the syntax valid, and also uses the current contents of the hash as the initialisation data for the tied hash. That is how the data gets copied
After that there is just a couple of nested loops that dump the whole of %hash to verify that the ties are working
use strict;
use warnings 'all';
use SpecialHash;
my %hash = (
a => {
key_a1 => 'value_a1',
key_a2 => sub { 'value_a2' },
},
b => {
key_b1 => sub { 'value_b1' },
key_b2 => 'value_b2',
},
);
# Tie all the secondary hashes that are hash references
#
for my $val ( values %hash ) {
tie %$val, SpecialHash => ( %$val ) if ref $val eq 'HASH';
}
# Dump all the elements of the second-level hashes
#
for my $k ( sort keys %hash ) {
my $v = $hash{$k};
next unless ref $v eq 'HASH';
print "$k =>\n";
for my $kk ( sort keys %$v ) {
my $vv = $v->{$kk};
print " $kk => $v->{$kk}\n"
}
}
output
a =>
key_a1 => value_a1
key_a2 => value_a2
b =>
key_b1 => value_b1
key_b2 => value_b2
There's a feature called "magic" that allows code to be called when variables are accessed.
Adding magic to a variable greatly slows down access to that variable, but some are more expensive than others.
There's no need to make access to every element of the hash magical, just some values.
tie is an more expensive form of magic, and it's not needed here.
As such, the most efficient solution is the following:
use Time::HiRes qw( time );
use Variable::Magic qw( cast wizard );
{
my $wiz = wizard(
data => sub { my $code = $_[1]; $code },
get => sub { ${ $_[0] } = $_[1]->(); },
);
sub make_evaluator { cast($_[0], $wiz, $_[1]) }
}
my %hash;
$hash{key1} = 'value1';
make_evaluator($hash{key2}, sub { 'value2#'.time });
print("$hash{$_}\n") for qw( key1 key2 key2 );
Output:
value1
value2#1462548850.76715
value2#1462548850.76721
Other examples:
my %hash; make_evaluator($hash{key}, sub { ... });
my $hash; make_evaluator($hash->{$key}, sub { ... });
my $x; make_evaluator($x, sub { ... });
make_evaluator(my $x, sub { ... });
make_evaluator(..., sub { ... });
make_evaluator(..., \&some_sub);
You can also "fix up" an existing hash. In your hash-of-hashes scenario,
my $hoh = {
{
key1 => 'value1',
key2 => sub { ... },
...
},
...
);
for my $h (values(%$hoh)) {
for my $v (values(%$h)) {
if (ref($v) eq 'CODE') {
make_evaluator($v, $v);
}
}
}
Yes you can. You can either tie hash to implementation that will resolve coderefs to their return values or you can use blessed scalars as values with overloaded mehods for stringification, numification and whatever else context you want to resolve automatically.
One of perl's special features for just such a use case is tie. This allows you to attach object oriented style methods, to a scalar or hash.
It should be used with caution, because it can mean that your code is doing really strange things, in unexpected ways.
But as an example:
#!/usr/bin/env perl
package RandomScalar;
my $random_range = 10;
sub TIESCALAR {
my ( $class, $range ) = #_;
my $value = 0;
bless \$value, $class;
}
sub FETCH {
my ($self) = #_;
return rand($random_range);
}
sub STORE {
my ( $self, $range ) = #_;
$random_range = $range;
}
package main;
use strict;
use warnings;
tie my $random_var, 'RandomScalar', 5;
for ( 1 .. 10 ) {
print $random_var, "\n";
}
$random_var = 100;
for ( 1 .. 10 ) {
print $random_var, "\n";
}
As you can see - this lets you take an 'ordinary' scalar, and do fruity things with it. You can use a very similar mechanism with a hash - an example might be to do database lookups.
However, you also need to be quite cautious - because you're creating action at a distance by doing so. Future maintenance programmers might well not expect your $random_var to actually change each time you run it, and a value assignment to not actually 'set'.
It can be really useful for e.g. testing though, which is why I give an example.
In your example - you could potentially 'tie' the hash:
#!/usr/bin/env perl
package MagicHash;
sub TIEHASH {
my ($class) = #_;
my $self = {};
return bless $self, $class;
}
sub FETCH {
my ( $self, $key ) = #_;
if ( ref( $self->{$key} ) eq 'CODE' ) {
return $self->{$key}->();
}
else {
return $self->{$key};
}
}
sub STORE {
my ( $self, $key, $value ) = #_;
$self->{$key} = $value;
}
sub CLEAR {
my ($self) = #_;
$self = {};
}
sub FIRSTKEY {
my ($self) = #_;
my $null = keys %$self; #reset iterator
return each %$self;
}
sub NEXTKEY {
my ($self) = #_;
return each %$self;
}
package main;
use strict;
use warnings;
use Data::Dumper;
tie my %magic_hash, 'MagicHash';
%magic_hash = (
key1 => 2,
key2 => sub { return "beefcake" },
);
$magic_hash{random} = sub { return rand 10 };
foreach my $key ( keys %magic_hash ) {
print "$key => $magic_hash{$key}\n";
}
foreach my $key ( keys %magic_hash ) {
print "$key => $magic_hash{$key}\n";
}
foreach my $key ( keys %magic_hash ) {
print "$key => $magic_hash{$key}\n";
}
This is slightly less evil, because future maintenance programmers can use your 'hash' normally. But dynamic eval can shoot the unwary in the foot, so still - caution is advised.
And alternative is to do it 'proper' object oriented - create a 'storage object' that's ... basically like the above - only it creates an object, rather than using tie. This should be much clearer for long term usage, because you won't get unexpected behaviour. (It's an object doing magic, which is normal, not a hash that 'works funny').
You need to identify when a code ref is present, then execute it as an actual call:
foreach my $key (sort keys %hash) {
if (ref $hash{$key} eq 'CODE'){
print $hash{$key}->() . "\n";
}
else {
print "$hash{$key}\n";
}
}
Note that you may consider making all of the hash values subs (a true dispatch table) instead of having some that return non-coderefs and some that return refs.
However, if you define the hash as such, you don't have to do any special trickery when it comes time to use the hash. It calls the sub and returns the value directly when the key is looked up.
key2 => sub {
return "value2";
}->(),
No, not without some ancillary code. You are asking for a simple scalar value and a code reference to behave in the same way. The code that would do that is far from simple and also injects complexity between your hash and its use. You might find the following approach simpler and cleaner.
You can make all values code references, making the hash a dispatch table, for uniform invocation
my %hash = (
key1 => sub { return "value1" },
key2 => sub {
# carry on some processing ...
return "value2"; # In the real code, this value can differ
},
);
print $hash{$_}->() . "\n" for sort keys %hash;
But of course there is a minimal overhead to this approach.
So I have a class AClass with variables (x, y), and a function which should take two objects as arguments of the same class, compute their x and y, and return a new instance of the class with computed values.
package AClass;
sub new {
my $class = shift;
my $x = shift;
my $y = shift;
my $self = {
x => $x,
y => $y
};
return bless($self, $class);
}
sub getX {
my $self = shift;
return $self->{'x'};
}
sub getY {
my $self = shift;
return $self->{'y'};
}
sub addition {
my ($c1, $c2) = #_;
return new AClass(
$c1->getX() + $c1->getX(),
$c1->getY() + $c2->getY()
);
}
my $a1 = AClass->new(6, 4);
my $a2 = AClass->new(4, 3);
my $val = AClass::addition(\$v1, \$v2);
say $val.getX();
I'm getting error "Can't call method "getX" on unblessed reference". I think the problem is in addition function, when I'm trying to access the values of the objects which are not the real numbers or ?
There is a number of problems here.
You are using $v1 and $v2 when presumably you mean $a1 and $a2
You are passing references to those objects, instead of the objects themselves
Your addition method adds the X value of $c1 to itself instead of to the X value of $c2
You are using the string concatenation operator . instead of the indirection operator ->
It is best to use lower-case letters for lexical identifiers. Capitals are generally reserved for globals like package names
You must always use strict and use warnings at the top of your program. In this case you would have been alerted to the fact that $v1 and $v2 hadn't been declared.
This version of your code works fine
use strict;
use warnings;
package AClass;
sub new {
my $class = shift;
my ($x, $y) = #_;
bless { x => $x, y => $y }, $class;
}
sub get_x {
my $self = shift;
$self->{x};
}
sub get_y {
my $self = shift;
$self->{y};
}
sub addition {
my ($c1, $c2) = #_;
AClass->new(
$c1->get_x + $c2->get_x,
$c1->get_y + $c2->get_y
);
}
package main;
use feature 'say';
my $a1 = AClass->new(6, 4);
my $a2 = AClass->new(4, 3);
my $val = AClass::addition($a1, $a2);
say $val->get_x;
output
10
You use $v1 instead $a1. Always use use strict; use warnings;.
Also, you're taking a reference for no reason.
my $val = AClass::addition($a1, $a2);
The following would also work (though add) would be a better word:
my $val = $a1->addition($a2);
Hello I'm trying to write a simple subroutine that will compare two numbers to see if one is greater than the other, less than or equal.
So far I have the following code:
sub Value
{ my $num = $_[0];
my ($last) = shift;
my $compare = sub {
if ($last < $last) {print "Less than \n"; } else {print "Greater than \n";};};
my $hashtable;
$hashtable->{"compare"} = $compare;
$hashtable; }
#Execute Statement
my $num1 = Value(57.8);
my $num2 = Value(129.6);
print "Check: ", $num1->{"compare"}->($num2);
Does anyone have suggestion how I can get this to work correctly? Thanks!
You messed up your argument unpacking in Values. You assign the first argument to $num, and then shift the first argument into $last, so $num and $last will always have the same value.
You compare $last with $last, which isn't useful.
You put your closure into $hashtable->{compare}, but execute the contents of the check field, which is undef.
Your closure prints data to the currently selected filehandle, but doesn't return any useful information. Printing the return value doesn't seem sensible.
$num1 and $num2 are closures, and not numbers. Passing an argument to the closure doesn't do anything, as your closure doesn't unpack any arguments.
Here is a implementation that should address your issues:
use strict; use warnings;
use Test::More;
sub create_closure {
my ($x) = #_;
my $operations = {
compare => sub { my ($y) = #_; return $x <=> $y },
add => sub { my ($y) = #_; return $x + $y },
value => $x,
};
return $operations;
}
# some tests
my $ops = create_closure(15);
ok( $ops->{compare}->(15) == 0, "compare to self" );
ok( $ops->{compare}->(20) < 0, "compare to larger");
ok( $ops->{add}->(5) == 20, "add");
ok( $ops->{value} == 15, "value");
my $ops1 = create_closure(150);
ok( $ops1->{compare}->($ops->{value}) > 0, "compare to smaller value");
done_testing;
Edit
You cannot directly compare two $ops, but we can create a field that returns the original value.
However, you might want to use objects and operator overloading if you intend to do such things more often:
use strict; use warnings; use Test::More;
{
package Ops;
sub new {
my ($class, $val) = #_;
if (ref $val eq __PACKAGE__) {
($val, $class) = ($$val, __PACKAGE__);
}
bless \$val => $class;
}
use overload
# overload numeric coercion
'0+' => sub { ${ $_[0] } },
# overload addition. Take care to dereference to avoid infinite loops.
'+' => sub {
my ($self, $other) = #_;
Ops->new($$self + $other);
},
# overload numeric comparision. Take care to swap the args if neccessary.
'<=>' => sub {
my ($self, $other, $swapped) = #_;
(my $val, $other) = $swapped ? ($other, $$self) : ($$self, $other);
Ops->new($val <=> $other);
}
}
my $ops1 = Ops->new( 15);
my $ops2 = Ops->new(150);
# some tests
ok( ($ops1 <=> 15) == 0, "compare to self" );
ok( ($ops1 <=> 20) < 0, "compare to larger");
ok( ($ops1 + (5)) == 20, "add");
ok( $ops1 == 15, "value");
ok( ($ops2 <=> $ops1) > 0, "compare to smaller value");
done_testing;
do it like this:
our $last;
sub compare
{
my ($x, $y) = #_;
if( $x > $y )
{
print("$x is greater than $y\n");
}
elsif( $x == $y )
{
print("$x is equal to $y\n");
}
else
{
print("$x is less than $y\n");
}
$last = ($x, $y);
};
my $lastValues = compare(3, 4); # pass numbers which you want to compare instead of 3 and 4
print("last compared value = $lastValues");
I need to convert a flat list of keys into a nested hash, as follow:
my $hash = {};
my #array = qw(key1 key2 lastKey Value);
ToNestedHash($hash, #array);
Would do this:
$hash{'key1'}{'key2'}{'lastKey'} = "Value";
sub to_nested_hash {
my $ref = \shift;
my $h = $$ref;
my $value = pop;
$ref = \$$ref->{ $_ } foreach #_;
$$ref = $value;
return $h;
}
Explanation:
Take the first value as a hashref
Take the last value as the value to be assigned
The rest are keys.
Then create a SCALAR reference to the base hash.
Repeatedly:
Dereference the pointer to get the hash (first time) or autovivify the pointer as a hash
Get the hash slot for the key
And assign the scalar reference to the hash slot.
( Next time around this will autovivify to the indicated hash ).
Finally, with the reference to the innermost slot, assign the value.
We know:
That the occupants of a hash or array can only be a scalar or reference.
That a reference is a scalar of sorts. (my $h = {}; my $a = [];).
So, \$h->{ $key } is a reference to a scalar slot on the heap, perhaps autovivified.
That a "level" of a nested hash can be autovivified to a hash reference if we address it as so.
It might be more explicit to do this:
foreach my $key ( #_ ) {
my $lvl = $$ref = {};
$ref = \$lvl->{ $key };
}
But owing to repeated use of these reference idioms, I wrote that line totally as it was and tested it before posting, without error.
As for alternatives, the following version is "easier" (to think up)
sub to_nested_hash {
$_[0] //= {};
my $h = shift;
my $value = pop;
eval '$h'.(join '', map "->{\$_[$i]}", 0..$#_).' = $value';
return $h;
}
But about 6-7 times slower.
I reckon this code is better - more amenable to moving into a class method, and optionally setting a value, depending on the supplied parameters. Otherwise the selected answer is neat.
#!/usr/bin/env perl
use strict;
use warnings;
use YAML;
my $hash = {};
my #array = qw(key1 key2 lastKey);
my $val = [qw/some arbitrary data/];
print Dump to_nested_hash($hash, \#array, $val);
print Dump to_nested_hash($hash, \#array);
sub to_nested_hash {
my ($hash, $array, $val) = #_;
my $ref = \$hash;
my #path = #$array;
print "ref: $ref\n";
my $h = $$ref;
$ref = \$$ref->{ $_ } foreach #path;
$$ref = $val if $val;
return $h;
}
Thxs for the good stuff!!!
I did it the recursive way:
sub Hash2Array
{
my $this = shift;
my $hash = shift;
my #array;
foreach my $k(sort keys %$hash)
{
my $v = $hash->{$k};
push #array,
ref $v eq "HASH" ? $this->Hash2Array($v, #_, $k) : [ #_, $k, $v ];
}
return #array;
}
It would be interesting to have a performance comparison between all of these solutions...
Made a better version of axeman's i think. Easier to understand without the -> and the \shift to me at least. 3 lines without a subroutine.
With subroutine
sub to_nested_hash {
my $h=shift;
my($ref,$value)=(\$h,pop);
$ref=\%{$$ref}{$_} foreach(#_);
$$ref=$value;
return $h;
}
my $z={};
to_nested_hash($z,1,2,3,'testing123');
Without subroutine
my $z={};
my $ref=\$z; #scalar reference of a variable which contains a hash reference
$ref=\%{$$ref}{$_} foreach(1,2,3); #keys
$$ref='testing123'; #value
#with %z hash variable just do double backslash to get the scalar reference
#my $ref=\\%z;
Result:
$VAR1 = {
'1' => {
'2' => {
'3' => 'testing123'
}
}
};