What is the idiomatic way in Perl to determine whether a string variable matches a string in a list? - perl

Part of the specification says "Some names are special, e.g. Hughie, Dewey, Louis, and Donald. Other names may be added over the lifetime of the project at arbitrary times. Whenever you input one of those names, play quack.wav."
I could write ...
while (<>) {
if ($_ =~ /Hughie|Dewey|Louis/) {
quack() ;
}
elsif ($_ =~ /Donald/ {
quack() ;
you_re_fired_apprentice() ; # Easter egg don't tell QA
}
}
... but though untaxing to implement, it looks WTF-y: Where's the binary search? What if there were a sudden stupendous increase in the number of duck names? It would not scale at all!
I could create empty files using those names in a temporary directory, and then use the "file exists" API, but that seems roundabout, and I would have to be sure they were deleted at the end.
Surely there is a better way?

You could write that, but you should write this:
my %ducks = map {$_ => 1} qw(Hughie Dewey Louis);
while (<>) {
if ($ducks{$_}) {
quack() ;
}
elsif ($_ eq 'Donald') {
quack() ;
you_re_fired_apprentice() ; # Easter egg don't tell QA
}
}
Creating the hash takes a little bit of time, but not more than O(n). Lookup with a hash is O(1) though, so it is much more efficient than sequential search (via grep or a regex with alternation) assuming you will be checking for more than one or two items.
By the way, the regex that you have will match the words anywhere in the search string. You need to add start and end anchors if you want an exact match.

Alternatively, you could use smart matching
my #ducks = qw(Hughie Dewey Louis);
my $name = 'Dewey';
say 'smart match' if $name ~~ #ducks;
This is what is used by switch statements, so you could write
given ($name) {
when (#ducks) {
quack();
}
when ('Donald') {
quack();
you_re_fired_apprentice(); # Easter egg don't tell QA
}
}

As mentioned, hashes are the way to go for this. This is sort of what OOP looked like before OOP.
use strict;
use warnings;
my %duck_action = (
Donald => sub {quack(); you_re_fired_apprentice()},
Hughie => sub {quack()},
Dewie => sub {quack()},
Louis => sub {quack()},
);
for my $duck (qw( Hughie Dewie Donald Louis Porkie )) {
print "$duck: ";
my $action = $duck_action{$duck} || &no_such_duck;
$action->();
}
sub quack {
print "Quack!\n";
}
sub you_re_fired_apprentice {
print "You're fired!\n";
}
sub no_such_duck {
print "No such duck!\n";
}

You can use a Perl Hash. See also How can I represent sets in Perl? and Representing Sets in Perl.
Using hashes to implement a set is not exactly pretty, but it should be fast.

To find a string in a list, you could also use any in List::MoreUtils
use List::MoreUtils qw(any);
my #ducks = qw(Hughie Dewey Louis);
my $name = 'Dewey';
say 'any' if any {$name eq $_} #ducks;

If you're tied to using an array rather than a hash, you can use perl's grep function to search the array for a string.
#specialnames = qw(Hughie Dewey Louis);
while (my $value = <>) {
if (grep {$value eq $_}, #specialnames) {
quack() ;
}
elsif ($_ =~ /Donald/ {
quack() ;
you_re_fired_apprentice() ; # Easter egg don't tell QA
}
}
This does scale a lot worse than a hash, and might even scale worse than copying the array into a hash and then doing hash lookups.

Related

Perl Creating hash reference and looping through one element from each branch at a time

As a beginner I have what I think is a rather complicated problem I am hoping someone could help with.
I have the following text file (tab delminated)...
FILE1.txt
Dog Big
Dog Medium
Dog Small
Rabbit Huge
Rabbit Tiny
Rabbit Middle
Donkey Massive
Donkey Little
Donkey Gigantic
I need to read FILE1.txt into a hash reference to get something like the following... (using Data::Dumper)
$VAR1 = {
'Dog' => {
'Big',
'Medium',
'Small'
},
'Rabbit => {
'Huge',
'Tiny',
'Middle'
},
'Donkey => {
'Massive',
'Little',
'Gigantic'
},
};
The problem I am having:
I then need to loop through each branch of the hash reference one at a time, I will use the value from the hash reference to check if this matches my keyword, if so it will then return it's corresponding key.... for example...
What I need it to do:
my $keyword == "Little";
Dog->Big
if 'Big' matches my keyword then return $found = Dog
else go to the next branch
Rabbit->Huge
if 'Huge' matches my keyword then return $found = Rabbit
else go to the next branch
Donkey->Massive
if 'Massive' matches my keyword then return $found = Donkey
else go to the next branch (which is Dog again, but the second element this time)
Dog->Medium
if 'Medium' matches my keyword then return $found = Dog
else go to the next branch
Rabbit->Tiny
if 'Tiny' matches my keyword then return $found = Rabbit
else go the the next branch
Donkey->Little
if 'Little' matches my keyword then return $found = Donkey
..... and so on until the keyword is found or we reach the end of the hash reference
This is the kind of thing I am trying to achieve but don't know how to go about doing this, or whether a hash reference is the best way to do this, or if it can even be done with a hash/hash reference?
your help with this is much appreciated, thanks
Choosing proper data structure is often key step to the solution, but first of all you should define what you are trying achieve. What is overall goal? For example I have this data file and in mine application/program I need frequently ask for this information. It is crucial to ask proper question because for example if you don't need ask frequently for keyword it doesn't make sense creating hash at all.
perl -anE'say $F[0] if $F[1] eq "Little"' FILE1.txt
Yes it is that simple. Look in perlrun manpage for switches and what they mean and how to do same thing in bigger application.
If you need frequently ask for this question you should arrange your data in way which helps you and not in way you have to battle with.
use strict;
use warnings;
use feature qw(say);
use autodie;
open my $f, '<', 'FILE1.txt';
my %h;
while(<$f>) {
chomp;
my ($animal, $keyword) = split' ';
$h{$keyword} = $animal unless exists $h{$keyword};
}
close $f;
for my $keyword (qw(Little Awkward Small Tiny)) {
say $h{$keyword} ? "$keyword $h{$keyword}" : "keyword $keyword not found";
}
But if you still insist you want to traverse hash you can do it but you has been warned.
open my $f, '<', 'FILE1.txt';
my %h;
while (<$f>) {
chomp;
my ( $animal, $keyword ) = split ' ';
push #{ $h{$animal} }, $keyword;
}
close $f;
KEYWORD:
for my $keyword (qw(Little Awkward Small Tiny)) {
for my $animal (keys %h) {
for my $k (#{$h{$animal}}) {
if($k eq $keyword) {
say "$keyword $animal";
next KEYWORD;
}
}
}
say "keyword $keyword not found";
}
To critique my own answer: the structuring of the part that does the search could be better. And maybe it is pointless even using an ordered hash as the search is through a linear list. Maybe it should be an array of arrays
use strict;
use warnings;
use Tie::IxHash;
#open file
open(my $fh,"ani.txt") ||die $!;
#make an ordered hash
tie my %sizes, 'Tie::IxHash';
#read file into hash of arrays
while(<$fh>) {
(my $animal,my $size)=split(/\s+/);
if (!exists($sizes{$animal})) {
$sizes{$animal} = [$size];
} else {
push #{$sizes{$animal}},$size;
}
}
my $keyword="Little";
my $running=1;
my $depth=0;
while( $running ) {
$running = 0;
for my $search (keys %sizes) {
next if ($depth > #{$sizes{$search}});
$running = 1;
if ($keyword eq $sizes{$search}[$depth]) {
print "FOUND!!!!!! $search $depth";
exit(0);
}
}
$depth++;
}
Here is another version of a solution to the stated problem. To solve the actual problem given there is no need to store anything except the first "size" key for each animal in a hash
This hash can then be trivally used to look up the animal
use strict;
use warnings;
open(my $fh,"ani.txt") ||die $!;
my %animals;
#read file into hash
while(<$fh>) {
(my $animal,my $size)=split(/\s+/);
#only add the animal the first time the size is found
if (!exists($animals{$size})) {
$animals{$size} = $animal;
}
}
my $keyword="Little";
print "animal is ", $animals{$keyword};

In Perl, how can I call a method whose name I have in a string?

I'm trying to write some abstract code for searching through a list of similar objects for the first one whose attributes match specific values. In order to do this, I need to call a bunch of accessor methods and check all their values one by one. I'd like to use an abstraction like this:
sub verify_attribute {
my ($object, $attribute_method, $wanted_value) = #_;
if ( call_method($object, $attribute_method) ~~ $wanted_value ) {
return 1;
}
else {
return;
}
}
Then I can loop through a hash whose keys are accessor method names and whose values are the values I'm looking for for those attributes. For example, if that hash is called %wanted, I might use code like this to find the object I want:
my $found_object;
FINDOBJ: foreach my $obj (#list_of_objects) {
foreach my $accessor (keys %wanted) {
next FINDOBJ unless verify_attribute($obj, $accessor, $wanted{$accessor});
}
# All attrs verified
$found_object = $obj;
last FINDOBJ;
}
Of course, the only problem is that call_method does not exsit. Or does it? How can I call a method if I have a string containing its name? Or is there a better solution to this whole problem?
my $found_object;
FINDOBJ: foreach my $obj (#list_of_objects) {
foreach my $accessor (keys %wanted) {
next FINDOBJ unless $obj->$accessor() == $wanted{$accessor};
}
# All attrs verified
$found_object = $obj;
last;
}
Yes, you can call methods this way. No string (or any other) eval involved.
Also, substitute == with eq or =~ depending on the type of the data...
Or, for some extra credits, do it the functional way: (all() should really be part of List::Util!)
use List::Util 'first';
sub all (&#) {
my $code = shift;
$code->($_) || return 0 for #_;
return 1;
}
my $match = first {
my $obj = $_;
all { $obj->$_ == $attrs{$_} }
keys %wanted
} #list_of_objects;
Update: Admittedly, the first solution is the less obfuscated one, so it's preferable. But as somebody answering questions, you have add a little sugar to make it interesting for yourself, too! ;-)
Functional way is cool, but for dummies like me eval rules:
test.pl
#!/usr/bin/perl -l
use F;
my $f = F->new();
my $fun = 'lol'; # method of F
eval '$f->'.$fun.'() '; # call method of F, which name is in $fun var
F.pm
package F;
sub new
{
bless {};
}
sub lol
{
print "LoL";
}
1;
[root#ALT-24 root]# perl test.pl
LoL

Perl: if ( element in list )

I'm looking for presence of an element in a list.
In Python there is an in keyword and I would do something like:
if element in list:
doTask
Is there something equivalent in Perl without having to manually iterate through the entire list?
UPDATE:
The smartmatch family of features are now experimental
Smart match, added in v5.10.0 and significantly revised in v5.10.1, has been a regular point of complaint. Although there are a number of ways in which it is useful, it has also proven problematic and confusing for both users and implementors of Perl. There have been a number of proposals on how to best address the problem. It is clear that smartmatch is almost certainly either going to change or go away in the future. Relying on its current behavior is not recommended.
Warnings will now be issued when the parser sees ~~, given, or when.
If you can get away with requiring Perl v5.10, then you can use any of the following examples.
The smart match ~~ operator.
if( $element ~~ #list ){ ... }
if( $element ~~ [ 1, 2, 3 ] ){ ... }
You could also use the given/when construct. Which uses the smart match functionality internally.
given( $element ){
when( #list ){ ... }
}
You can also use a for loop as a "topicalizer" ( meaning it sets $_ ).
for( #elements ){
when( #list ){ ... }
}
One thing that will come out in Perl 5.12 is the ability to use the post-fix version of when. Which makes it even more like if and unless.
given( $element ){
... when #list;
}
If you have to be able to run on older versions of Perl, there still are several options.
You might think you can get away with using List::Util::first, but there are some edge conditions that make it problematic.
In this example it is fairly obvious that we want to successfully match against 0. Unfortunately this code will print failure every time.
use List::Util qw'first';
my $element = 0;
if( first { $element eq $_ } 0..9 ){
print "success\n";
} else {
print "failure\n";
}
You could check the return value of first for defined-ness, but that will fail if we actually want a match against undef to succeed.
You can safely use grep however.
if( grep { $element eq $_ } 0..9 ){ ... }
This is safe because grep gets called in a scalar context. Arrays return the number of elements when called in scalar context. So this will continue to work even if we try to match against undef.
You could use an enclosing for loop. Just make sure you call last, to exit out of the loop on a successful match. Otherwise you might end up running your code more than once.
for( #array ){
if( $element eq $_ ){
...
last;
}
}
You could put the for loop inside the condition of the if statement ...
if(
do{
my $match = 0;
for( #list ){
if( $element eq $_ ){
$match = 1;
last;
}
}
$match; # the return value of the do block
}
){
...
}
... but it might be more clear to put the for loop before the if statement.
my $match = 0;
for( #list ){
if( $_ eq $element ){
$match = 1;
last;
}
}
if( $match ){ ... }
If you're only matching against strings, you could also use a hash. This can speed up your program if #list is large and, you are going to match against %hash several times. Especially if #array doesn't change, because then you only have to load up %hash once.
my %hash = map { $_, 1 } #array;
if( $hash{ $element } ){ ... }
You could also make your own subroutine. This is one of the cases where it is useful to use prototypes.
sub in(&#){
local $_;
my $code = shift;
for( #_ ){ # sets $_
if( $code->() ){
return 1;
}
}
return 0;
}
if( in { $element eq $_ } #list ){ ... }
if( $element ~~ #list ){
do_task
}
~~ is the "smart match operator", and does more than just list membership detection.
grep is helpful here
if (grep { $_ eq $element } #list) {
....
}
If you plan to do this many times, you can trade-off space for lookup time:
#!/usr/bin/perl
use strict; use warnings;
my #array = qw( one ten twenty one );
my %lookup = map { $_ => undef } #array;
for my $element ( qw( one two three ) ) {
if ( exists $lookup{ $element }) {
print "$element\n";
}
}
assuming that the number of times the element appears in #array is not important and the contents of #array are simple scalars.
List::Util::first
$foo = first { ($_ && $_ eq "value" } #list; # first defined value in #list
Or for hand-rolling types:
my $is_in_list = 0;
foreach my $elem (#list) {
if ($elem && $elem eq $value_to_find) {
$is_in_list = 1;
last;
}
}
if ($is_in_list) {
...
A slightly different version MIGHT be somewhat faster on very long lists:
my $is_in_list = 0;
for (my $i = 0; i < scalar(#list); ++$i) {
if ($list[i] && $list[i] eq $value_to_find) {
$is_in_list = 1;
last;
}
}
if ($is_in_list) {
...
TIMTOWTDI
sub is (&#) {
my $test = shift;
$test->() and return 1 for #_;
0
}
sub in (#) {#_}
if( is {$_ eq "a"} in qw(d c b a) ) {
print "Welcome in perl!\n";
}
List::MoreUtils
On perl >= 5.10 the smart match operator is surely the easiest way, as many others have already said.
On older versions of perl, I would instead suggest List::MoreUtils::any.
List::MoreUtils is not a core module (some say it should be) but it's very popular and it's included in major perl distributions.
It has the following advantages:
it returns true/false (as Python's in does) and not the value of the element, as List::Util::first does (which makes it hard to test, as noted above);
unlike grep, it stops at the first element which passes the test (perl's smart match operator short circuits as well);
it works with any perl version (well, >= 5.00503 at least).
Here is an example which works with any searched (scalar) value, including undef:
use List::MoreUtils qw(any);
my $value = 'test'; # or any other scalar
my #array = (1, 2, undef, 'test', 5, 6);
no warnings 'uninitialized';
if ( any { $_ eq $value } #array ) {
print "$value present\n"
}
P.S.
(In production code it's better to narrow the scope of no warnings 'uninitialized').
Probably Perl6::Junction is the clearest way to do. No XS dependencies, no mess and no new perl version required.
use Perl6::Junction qw/ any /;
if (any(#grant) eq 'su') {
...
}
This blog post discusses the best answers to this question.
As a short summary, if you can install CPAN modules then the best solutions are:
if any(#ingredients) eq 'flour';
or
if #ingredients->contains('flour');
However, a more usual idiom is:
if #any { $_ eq 'flour' } #ingredients
which i find less clear.
But please don't use the first() function! It doesn't express the intent of your code at all. Don't use the "Smart match" operator: it is broken. And don't use grep() nor the solution with a hash: they iterate through the whole list. While any() will stop as soon as it finds your value.
Check out the blog post for more details.
PS: i'm answering for people who will have the same question in the future.
You can accomplish a similar enough syntax in Perl if you do some Autoload hacking.
Create a small package to handle the autoload:
package Autoloader;
use strict;
use warnings;
our $AUTOLOAD;
sub AUTOLOAD {
my $self = shift;
my ($method) = (split(/::/, $AUTOLOAD))[-1];
die "Object does not contain method '$method'" if not ref $self->{$method} eq 'CODE';
goto &{$self->{$method}};
}
1;
Then your other package or main script will contain a subroutine that returns the blessed object which gets handled by Autoload when its method attempts to be called.
sub element {
my $elem = shift;
my $sub = {
in => sub {
return if not $_[0];
# you could also implement this as any of the other suggested grep/first/any solutions already posted.
my %hash; #hash{#_} = ();
return (exists $hash{$elem}) ? 1 : ();
}
};
bless($sub, 'Autoloader');
}
This leaves you with usage looking like:
doTask if element('something')->in(#array);
If you reorganize the closure and its arguments, you can switch the syntax around the other way to make it look like this, which is a bit closer to the autobox style:
doTask if search(#array)->contains('something');
function to do that:
sub search {
my #arr = #_;
my $sub = {
contains => sub {
my $elem = shift or return;
my %hash; #hash{#arr} = ();
return (exists $hash{$elem}) ? 1 : ();
}
};
bless($sub, 'Autoloader');
}

How can I cleanly turn a nested Perl hash into a non-nested one?

Assume a nested hash structure %old_hash ..
my %old_hash;
$old_hash{"foo"}{"bar"}{"zonk"} = "hello";
.. which we want to "flatten" (sorry if that's the wrong terminology!) to a non-nested hash using the sub &flatten(...) so that ..
my %h = &flatten(\%old_hash);
die unless($h{"zonk"} eq "hello");
The following definition of &flatten(...) does the trick:
sub flatten {
my $hashref = shift;
my %hash;
my %i = %{$hashref};
foreach my $ii (keys(%i)) {
my %j = %{$i{$ii}};
foreach my $jj (keys(%j)) {
my %k = %{$j{$jj}};
foreach my $kk (keys(%k)) {
my $value = $k{$kk};
$hash{$kk} = $value;
}
}
}
return %hash;
}
While the code given works it is not very readable or clean.
My question is two-fold:
In what ways does the given code not correspond to modern Perl best practices? Be harsh! :-)
How would you clean it up?
Your method is not best practices because it doesn't scale. What if the nested hash is six, ten levels deep? The repetition should tell you that a recursive routine is probably what you need.
sub flatten {
my ($in, $out) = #_;
for my $key (keys %$in) {
my $value = $in->{$key};
if ( defined $value && ref $value eq 'HASH' ) {
flatten($value, $out);
}
else {
$out->{$key} = $value;
}
}
}
Alternatively, good modern Perl style is to use CPAN wherever possible. Data::Traverse would do what you need:
use Data::Traverse;
sub flatten {
my %hash = #_;
my %flattened;
traverse { $flattened{$a} = $b } \%hash;
return %flattened;
}
As a final note, it is usually more efficient to pass hashes by reference to avoid them being expanded out into lists and then turned into hashes again.
First, I would use perl -c to make sure it compiles cleanly, which it does not. So, I'd add a trailing } to make it compile.
Then, I'd run it through perltidy to improve the code layout (indentation, etc.).
Then, I'd run perlcritic (in "harsh" mode) to automatically tell me what it thinks are bad practices. It complains that:
Subroutine does not end with "return"
Update: the OP essentially changed every line of code after I posted my Answer above, but I believe it still applies. It's not easy shooting at a moving target :)
There are a few problems with your approach that you need to figure out. First off, what happens in the event that there are two leaf nodes with the same key? Does the second clobber the first, is the second ignored, should the output contain a list of them? Here is one approach. First we construct a flat list of key value pairs using a recursive function to deal with other hash depths:
my %data = (
foo => {bar => {baz => 'hello'}},
fizz => {buzz => {bing => 'world'}},
fad => {bad => {baz => 'clobber'}},
);
sub flatten {
my $hash = shift;
map {
my $value = $$hash{$_};
ref $value eq 'HASH'
? flatten($value)
: ($_ => $value)
} keys %$hash
}
print join( ", " => flatten \%data), "\n";
# baz, clobber, bing, world, baz, hello
my %flat = flatten \%data;
print join( ", " => %flat ), "\n";
# baz, hello, bing, world # lost (baz => clobber)
A fix could be something like this, which will create a hash of array refs containing all the values:
sub merge {
my %out;
while (#_) {
my ($key, $value) = splice #_, 0, 2;
push #{ $out{$key} }, $value
}
%out
}
my %better_flat = merge flatten \%data;
In production code, it would be faster to pass references between the functions, but I have omitted that here for clarity.
Is it your intent to end up with a copy of the original hash or just a reordered result?
Your code starts with one hash (the original hash that is used by reference) and makes two copies %i and %hash.
The statement my %i=%{hashref} is not necessary. You are copying the entire hash to a new hash. In either case (whether you want a copy of not) you can use references to the original hash.
You are also losing data if your hash in the hash has the same value as the parent hash. Is this intended?

Traversing a multi-dimensional hash in Perl

If you have a hash (or reference to a hash) in perl with many dimensions and you want to iterate across all values, what's the best way to do it. In other words, if we have
$f->{$x}{$y}, I want something like
foreach ($x, $y) (deep_keys %{$f})
{
}
instead of
foreach $x (keys %f)
{
foreach $y (keys %{$f->{$x})
{
}
}
Stage one: don't reinvent the wheel :)
A quick search on CPAN throws up the incredibly useful Data::Walk. Define a subroutine to process each node, and you're sorted
use Data::Walk;
my $data = { # some complex hash/array mess };
sub process {
print "current node $_\n";
}
walk \&process, $data;
And Bob's your uncle. Note that if you want to pass it a hash to walk, you'll need to pass a reference to it (see perldoc perlref), as follows (otherwise it'll try and process your hash keys as well!):
walk \&process, \%hash;
For a more comprehensive solution (but harder to find at first glance in CPAN), use Data::Visitor::Callback or its parent module - this has the advantage of giving you finer control of what you do, and (just for extra street cred) is written using Moose.
Here's an option. This works for arbitrarily deep hashes:
sub deep_keys_foreach
{
my ($hashref, $code, $args) = #_;
while (my ($k, $v) = each(%$hashref)) {
my #newargs = defined($args) ? #$args : ();
push(#newargs, $k);
if (ref($v) eq 'HASH') {
deep_keys_foreach($v, $code, \#newargs);
}
else {
$code->(#newargs);
}
}
}
deep_keys_foreach($f, sub {
my ($k1, $k2) = #_;
print "inside deep_keys, k1=$k1, k2=$k2\n";
});
This sounds to me as if Data::Diver or Data::Visitor are good approaches for you.
Keep in mind that Perl lists and hashes do not have dimensions and so cannot be multidimensional. What you can have is a hash item that is set to reference another hash or list. This can be used to create fake multidimensional structures.
Once you realize this, things become easy. For example:
sub f($) {
my $x = shift;
if( ref $x eq 'HASH' ) {
foreach( values %$x ) {
f($_);
}
} elsif( ref $x eq 'ARRAY' ) {
foreach( #$x ) {
f($_);
}
}
}
Add whatever else needs to be done besides traversing the structure, of course.
One nifty way to do what you need is to pass a code reference to be called from inside f. By using sub prototyping you could even make the calls look like Perl's grep and map functions.
You can also fudge multi-dimensional arrays if you always have all of the key values, or you just don't need to access the individual levels as separate arrays:
$arr{"foo",1} = "one";
$arr{"bar",2} = "two";
while(($key, $value) = each(%arr))
{
#keyValues = split($;, $key);
print "key = [", join(",", #keyValues), "] : value = [", $value, "]\n";
}
This uses the subscript separator "$;" as the separator for multiple values in the key.
There's no way to get the semantics you describe because foreach iterates over a list one element at a time. You'd have to have deep_keys return a LoL (list of lists) instead. Even that doesn't work in the general case of an arbitrary data structure. There could be varying levels of sub-hashes, some of the levels could be ARRAY refs, etc.
The Perlish way of doing this would be to write a function that can walk an arbitrary data structure and apply a callback at each "leaf" (that is, non-reference value). bmdhacks' answer is a starting point. The exact function would vary depending one what you wanted to do at each level. It's pretty straightforward if all you care about is the leaf values. Things get more complicated if you care about the keys, indices, etc. that got you to the leaf.
It's easy enough if all you want to do is operate on values, but if you want to operate on keys, you need specifications of how levels will be recoverable.
a. For instance, you could specify keys as "$level1_key.$level2_key.$level3_key"--or any separator, representing the levels.
b. Or you could have a list of keys.
I recommend the latter.
Level can be understood by #$key_stack
and the most local key is $key_stack->[-1].
The path can be reconstructed by: join( '.', #$key\_stack )
Code:
use constant EMPTY_ARRAY => [];
use strict;
use Scalar::Util qw<reftype>;
sub deep_keys (\%) {
sub deeper_keys {
my ( $key_ref, $hash_ref ) = #_;
return [ $key_ref, $hash_ref ] if reftype( $hash_ref ) ne 'HASH';
my #results;
while ( my ( $key, $value ) = each %$hash_ref ) {
my $k = [ #{ $key_ref || EMPTY_ARRAY }, $key ];
push #results, deeper_keys( $k, $value );
}
return #results;
}
return deeper_keys( undef, shift );
}
foreach my $kv_pair ( deep_keys %$f ) {
my ( $key_stack, $value ) = #_;
...
}
This has been tested in Perl 5.10.
If you are working with tree data going more than two levels deep, and you find yourself wanting to walk that tree, you should first consider that you are going to make a lot of extra work for yourself if you plan on reimplementing everything you need to do manually on hashes of hashes of hashes when there are a lot of good alternatives available (search CPAN for "Tree").
Not knowing what your data requirements actually are, I'm going to blindly point you at a tutorial for Tree::DAG_Node to get you started.
That said, Axeman is correct, a hashwalk is most easily done with recursion. Here's an example to get you started if you feel you absolutely must solve your problem with hashes of hashes of hashes:
#!/usr/bin/perl
use strict;
use warnings;
my %hash = (
"toplevel-1" =>
{
"sublevel1a" => "value-1a",
"sublevel1b" => "value-1b"
},
"toplevel-2" =>
{
"sublevel1c" =>
{
"value-1c.1" => "replacement-1c.1",
"value-1c.2" => "replacement-1c.2"
},
"sublevel1d" => "value-1d"
}
);
hashwalk( \%hash );
sub hashwalk
{
my ($element) = #_;
if( ref($element) =~ /HASH/ )
{
foreach my $key (keys %$element)
{
print $key," => \n";
hashwalk($$element{$key});
}
}
else
{
print $element,"\n";
}
}
It will output:
toplevel-2 =>
sublevel1d =>
value-1d
sublevel1c =>
value-1c.2 =>
replacement-1c.2
value-1c.1 =>
replacement-1c.1
toplevel-1 =>
sublevel1a =>
value-1a
sublevel1b =>
value-1b
Note that you CAN NOT predict in what order the hash elements will be traversed unless you tie the hash via Tie::IxHash or similar — again, if you're going to go through that much work, I recommend a tree module.