Perl: How to turn array into nested hash keys - perl

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'
}
}
};

Related

Extract data hash reference from perl array

I am new to perl. I am returning an array of references from a function. However I am lost as how I loop over the data.
sub whatever{
my %product;
my %resolution;
my #data = ();
push #data, \%product;
push #data, \%resolution;
return #data;
}
In the control sub module.
my #results = $whatever($dt_id);
$c->app->log->debug(Dumper(#results));
results
$VAR1 = {'IOP' => 'IOP'};
$VAR2 = {'4km' => '4km','9km' => '9km'};
I get the two hashes but how do I loop over them.
To return the two hashes seperately:
return (\%product, \%resolution);
To map over them:
my ($product, $resolution) = whatever(...);
for my $key (%$product) {
# do something with $product->{$key};
}
try this:
for my $hash_ref (#results) {
for my $key (keys %$hash_ref) {
say "key '$key' has value '$hash_ref->{$key}'";
}
}

Split string into a hash of hashes (perl)

at the moment im a little confused..
I am looking for a way to write a string with an indefinite number of words (separated by a slash) in a recursive hash.
These "strings" are output from a text database.
Given is for example
"office/1/hardware/mouse/count/200"
the next one can be longer or shorter..
This must be created from it:
{
office {
1{
hardware {
mouse {
count => 200
}
}
}
}
}
Any idea ?
Work backwards. Split the string. Use the last two elements to make the inner-most hash. While more words exist, make each one the key of a new hash, with the inner hash as its value.
my $s = "office/1/hardware/mouse/count/200";
my #word = split(/\//, $s);
# Bottom level taken explicitly
my $val = pop #word;
my $key = pop #word;
my $h = { $key => $val };
while ( my $key = pop #word )
{
$h = { $key => $h };
}
Simple recursive function should do
use strict;
use warnings;
use Data::Dumper;
sub foo {
my $str = shift;
my ($key, $rest) = split m|/|, $str, 2;
if (defined $rest) {
return { $key => foo($rest) };
} else {
return $key;
}
}
my $hash = foo("foo/bar/baz/2");
print Dumper $hash;
Gives output
$VAR1 = {
'foo' => {
'bar' => {
'baz' => '2'
}
}
};
But like I said in the comment: What do you intend to use this for? It is not a terribly useful structure.
If there are many lines to be read into a single hash and the lines have a variable number of fields, you have big problems and the other two answers will clobber data by either smashing sibling keys or overwriting final values. I'm supposing this because there is no rational reason to convert a single line into a hash.
You will have to walk down the hash with each field. This will also give you the most control over the process.
our $hash = {};
our $eolmark = "\000";
while (my $line = <...>) {
chomp $line;
my #fields = split /\//, $line;
my $count = #fields;
my $h = $hash;
my $i = 0;
map { (++$i == $count) ?
($h->{$_}{$eolmark} = 1) :
($h = $h->{$_} ||= {});
} #fields;
}
$h->{$_}{$eolmark} = 1 You need the special "end of line" key so that you can recognize the end of a record and still permit longer records to coexist. If you had two records
foo/bar/baz foo/bar/baz/quux, the second would overwrite the final value of the first.
$h = $h->{$_} ||= {} This statement is a very handy idiom to both create and populate a cache in one step and then take a shortcut reference to it. Never do a hash lookup more than once.
HTH

Reference found where even-sized list expected in Perl - Possible pass-by-reference error?

I have a Perl class/module that I created to display Bible verses. In it there is a hash that stores several verses, with the key being the book/chapter/verse and the value being the text. This hash is returned from the module.
I'm including the Bible class in a controller class, and that connection seems to work. The problem is I keep getting errors on executing. My IDE because I'm following a Lynda tutorial, is Eclipse with the EPIC plugin.
The error is:
Reference found where even-sized list expected at C:/Documents and Settings/nunya/eric.hepperle_codebase/lynda/lamp/perl5/Exercise Files/14 Modules/eh_bibleInspiration_controller.pl line 42.
Use of uninitialized value $value in concatenation (.) or string at C:/Documents and Settings/nunya/eric.hepperle_codebase/lynda/lamp/perl5/Exercise Files/14 Modules/eh_bibleInspiration_controller.pl line 45.
HASH(0x19ad454) =>
Here is the CONTROLLER class:
#!/usr/bin/perl
# eh_bibleInspiration_controller.pl by Eric Hepperle - 06/23/13
#
use strict;
use warnings;
use Data::Dumper;
use EHW_BibleInspiration;
main(#ARGV);
sub main
{
my $o = EHW_BibleInspiration->new; # instantiate new object.
my %bo_ref = $o->getBibleObj();
print "\$o is type: " . ref($o) . ".\n";
print "\%bo_ref is type: " . ref(\%bo_ref) . ".\n";
# exit;
$o->getVerseObj();
listHash(\%bo_ref);
message("Done.");
}
sub message
{
my $m = shift or return;
print("$m\n");
}
sub error
{
my $e = shift || 'unkown error';
print("$0: $e\n");
exit 0;
}
sub listHash
{
my %hash = #_;
foreach my $key (sort keys %hash) {
my $value = $hash{$key};
message("$key => $value\n");
}
}
Here is the class that returns the verses and has the method to pick a random verse:
# EHW_BibleInspiration.pm
# EHW_BibleInspiration.
#
package EHW_BibleInspiration;
use strict;
use warnings;
use IO::File;
use Data::Dumper;
our $VERSION = "0.1";
sub new
{
my $class = shift;
my $self = {};
bless($self, $class); # turns hash into object
return $self;
}
sub getVerseObj
{
my ($self) = #_;
print "My Bible Verse:\n";
my $verses = $self->getBibleObj();
# get random verse
#$knockknocks{(keys %knockknocks)[rand keys %knockknocks]};
# sub mysub {
# my $params = shift;
# my %paramhash = %$params;
# }
# my %verses = %{$verses};
# my $random_value = %verses{(keys %verses)[rand keys %verses]};
# print Dumper(%{$random_value});
}
sub getBibleObj
{
my ($self) = #_;
# create bible verse object (ESV)
my $bibleObj_ref = {
'john 3:16' => 'For God so loved the world,that he gave his only Son, that whoever believes in him should not perish but have eternal life.',
'matt 10:8' => 'Heal the sick, raise the dead, cleanse lepers, cast out demons. You received without paying; give without pay.',
'Luke 6:38' => 'Give, and it will be given to you. Good measure, pressed down, shaken together, running over, will be put into your lap. For with the measure you use it will be measured back to you.',
'John 16:24' => 'Until now you have asked nothing in my name. Ask, and you will receive, that your joy may be full.',
'Psalms 32:7' => 'You are a hiding place for me; you preserve me from trouble; you surround me with shouts of deliverance. Selah',
'Proverbs 3:5-6' => 'Trust in the LORD with all your heart, and do not lean on your own understanding. 6 In all your ways acknowledge him, and he will make straight your paths.',
'John 14:1' => 'Let not your hearts be troubled. Believe in God; believe also in me.'
};
my $out = "The BIBLE is awesome!\n";
return $bibleObj_ref;
}
1;
What am I doing wrong? I suspect it has something to do with hash vs hash reference, but I don't know how to fix it. My dereferencing attempts had failed miserably because I don't really know what I'm doing. I modeled my random getter off of something I saw on perlmonks. #$knockknocks{(keys %knockknocks)[rand keys %knockknocks]};
In the main, you have:
my %bo_ref = $o->getBibleObj();
but, in package EHW_BibleInspiration;, the method getBibleObj returns : return $bibleObj_ref;
You'd do, in the main : my $bo_ref = $o->getBibleObj();
and then call listHash($bo_ref);
Finaly, don't forget to change sub listHash to:
sub listHash
{
my ($hash) = #_;
foreach my $key (sort keys %{$hash}) {
my $value = $hash->{$key};
message("$key => $value\n");
}
}
In your main, you do
listHash(\%bo_ref);
This passes a hash reference to the sub. However, it tries to unpack its arguments like
my %hash = #_;
Oops, it wants a hash.
Either, we pass it a hash: listHash(%bo_ref). This saves us much typing.
Or, we handle the reference inside the sub, like
sub listHash {
my ($hashref) = #_;
foreach my $key (sort keys %$hashref) {
my $value = $hashref->{$key};
print "$key => $value\n";
}
}
Notice how the reference uses the dereference arrow -> to access hash entries, and how it is dereferenced to a hash for keys.
I suspect that your suspicion is correct. In your method sub listHash you're correctly passing in the hash but you're trying to use a hash instead of a hash reference for the internal variable. Try using my ($hash) = #_; instead of my %hash = #_;.
When using references you can use the -> operator to de-reference it to get to the underlying values. The rest of your method should look like this:
sub listHash
{
my ($hash) = #_;
foreach my $key (sort keys %{$hash}) {
my $value = $hash->{$key};
message("$key => $value\n");
}
}
On line 43 of your program I had to tell Perl that the reference should be a hash reference by calling keys %{$hash}. Then on line 44 I de-referenced the hash to get the correct value by calling $hash->{$key}. For more information on Perl and references you can read the through the tutorial.
listHash is expecting a hash and you're passing it a hash reference. Change:
listHash(\%bo_ref);
to:
listHash(%bo_ref);

How to call a subroutine with a variable pre-assigned to some value?

In Perl, when one uses the sort function with a custom comparison, the variables $a and $b are already assigned to the current pair of elements to compare, e.g. in:
#decreasing = sort { $b <=> $a } #list;
How can I write other subroutines with a similar functionality? For example, imagine that I want to write sort of process_and_store function that does something special with each item of a list and then stores it in a database; and where the variable $item is already assigned to the current item being processed. I would like to write for example something like:
process_and_store { do_something_with($item); } #list;
Rather than
process_and_store { my $item = shift; do_something_with($item); } #list;
How should I go about doing this?
UPDATE: For completeness, although flesk's answer works without problems, in order to “properly” localize the changes I make to the $item variable I had to follow the advice from Axeman. In SomePackage.pm I placed something like:
package SomePackage;
use strict;
require Exporter;
our #ISA = qw/Exporter/;
our #EXPORT = qw(process_and_store);
our $item;
sub import {
my $import_caller = caller();
{ no strict 'refs';
*{ $import_caller . '::item' } = \*item;
}
# Now, cue Exporter!
goto &{ Exporter->can( 'import' ) };
}
sub process_and_store (&#) {
my $code = shift;
for my $x (#_) {
local *item = \$x;
$code->();
print "stored: $item\n"
}
}
1;
Then I call this from main.pl with something like:
#!/usr/bin/perl -w
use strict;
use SomePackage;
process_and_store { print "seen: $item\n"; } (1, 2, 3);
And get the expected result:
seen: 1
stored: 1
seen: 2
stored: 2
seen: 3
stored: 3
In my "associative array" processing library, I do something similar. The user can export the variables $k and $v (key-value) so that they can do things like this:
each_pair { "$k => $v" } some_source_list()
Here's how I do it:
I declare our ( $k, $v ) in the implementing package.
In import I allow packages to export those symbols and alias them in the
receiving package: *{$import_caller.'::'.$name} = \*{ $name };
In the pair processors, I do the following:
local *::_ = \$_[0];
local *k = \$_[0];
local *v = \$_[1];
#res = $block->( $_[0], $_[1] );
Thus $k and $v are aliases of what's in the queue. If this doesn't have to be the case, then you might be happy enough with something like the following:
local ( $k, $v ) = splice( #_, 0, 2 );
local $_ = $k;
But modifiable copies also allow me to do things like:
each_pair { substr( $k, 0, 1 ) eq '-' and $v++ } %some_hash;
UPDATE:
It seems that you're neglecting step #2. You have to make sure that the symbol in the client package maps to your symbol. It can be as simple as:
our $item;
sub import {
my $import_caller = caller();
{ no strict 'refs';
*{ $import_caller . '::item' } = \*item;
}
# Now, cue Exporter!
goto &{ Exporter->can( 'import' ) };
}
Then when you localize your own symbol, the aliased symbol in the client package is localized as well.
The main way that I can see that it would work without the local, is if you were calling it from the same package. Otherwise, $SomePackage::item and $ClientPackage::item are two distinct things.
I think it's a bit of a hack, but you could do something like this:
#!/usr/bin/perl
use strict;
use warnings;
my $item;
sub process_and_store(&#) {
my $code = shift;
for (#_) {
$item = $_;
&$code();
}
undef $item;
}
The thing is, $item has to be a global scalar for this to work, so process_and_store has to update that scalar while looping over the list. You should also undef $item at the end of the sub routine to limit any potential side-effects. If I were to write something like this, I'd tuck it away in a module and make it possible to define the iterator variable, so as to limit name conflicts.
Test:
my #list = qw(apples pears bananas);
process_and_store { do_something_with($item) } #list;
sub do_something_with {
my $fruit = shift;
print "$fruit\n";
}
Output:
apples
pears
bananas
The $a and $b variables are special in Perl; they're real global variables and hence exempt from use strict, and also used specifically by the sort() function.
Most other similar uses in Perl would use the $_ global for this sort of thing:
process_and_store { do_something_with( $_ ) } #list;
Which is already handled by the normal $_ rules. Don't forget to localise $_:
sub process_and_store(&#)
{
my $code = shift;
foreach my $item (#_) {
local $_ = $item;
$code->();
}
}

How to construct a hash of hashes

I need to compare two hashes, but I can't get the inner set of keys...
my %HASH = ('first'=>{'A'=>50, 'B'=>40, 'C'=>30},
'second'=>{'A'=>-30, 'B'=>-15, 'C'=>9});
foreach my $key (keys(%HASH))
{
my %innerhash = $options{$key};
foreach my $inner (keys(%innerhash))
{
print "Match: ".$otherhash{$key}->{$inner}." ".$HASH{$key}->{$inner};
}
}
$options{$key} is a scalar (you can tell be the leading $ sigil). You want to "dereference" it to use it as a hash:
my %HASH = ('first'=>{'A'=>50, 'B'=>40, 'C'=>30},
'second'=>{'A'=>-30, 'B'=>-15, 'C'=>9});
foreach my $key (keys(%HASH))
{
my %innerhash = %{ $options{$key} }; # <---- note %{} cast
foreach my $inner (keys(%innerhash))
{
print "Match: ".$otherhash{$key}->{$inner}." ".$HASH{$key}->{$inner};
}
}
When you're ready to really dive into these things, see perllol, perldsc and perlref.
I'm guessing you say "options" there where you mean "HASH"?
Hashes only store scalars, not other hashes; each value of %HASH is a hash reference that needs to be dereferenced, so your inner loop should be:
foreach my $inner (keys(%{ $HASH{$key} })
Or:
my %HASH = ('first'=>{'A'=>50, 'B'=>40, 'C'=>30},
'second'=>{'A'=>-30, 'B'=>-15, 'C'=>9});
foreach my $key (keys(%HASH))
{
my $innerhash = $HASH{$key};
foreach my $inner (keys(%$innerhash))
{
print "Match: ".$otherhash{$key}->{$inner}." ".$innerhash->{$inner};
}
}