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};
}
}
Related
my $memType = [];
my $portOp = [];
my $fo = "aster.out.DRAMA.READ.gz";
if($fo =~/aster.out\.(.*)\.(.*)\.gz/){
push (#{$memType},$1);
push (#{$portOp},$2);
}
print Dumper #{$memType};
foreach my $mem (keys %{$portCapability->{#{$memType}}}){
//How to use the array ref memType inside a hash//
print "entered here\n";
//cannot post the rest of the code for obvious reasons//
}
I am not able to enter the foreach loop . Can anyone help me fix it?
Sorry this is not the complete code . Please help me.
%{$portCapability->{#{$memType}}}
This doesn't do what you may think it means.
You treat $portCapability->{#{$memType}} as a hash reference.
The #{$memType} is evaluated in scalar context, thus giving the size of the array.
I aren't quite sure what you want, but would
%{ $portCapability->{ $memType->[0] } }
work?
If, however, you want to slice the elements in $portCapability, you would need somethink like
#{ $portCapability }{ #$memType }
This evaluates to a list of hashrefs. You can then loop over the hashrefs, and loop over the keys in an inner loop:
for my $hash (#{ $portCapability }{ #$memType }) {
for my $key (keys %$hash) {
...;
}
}
If you want a flat list of all keys of the inner hashes, but don't need the hashes themselves, you could shorten above code to
for my $key (map {keys %$_} #{ $portCapability }{ #$memType }) {
...;
}
I think what you want is this:
my $foo = {
asdf => {
a => 1, b => 2,
},
foo => {
c => 3, d => 4
},
bar => {
e => 5, f => 6
}
};
my #keys = qw( asdf foo );
foreach my $k ( map { keys %{ $foo->{$_} } } #keys ) {
say $k;
}
But you do not know which of these $k belongs to which key of $foo now.
There's no direct way to get the keys of multiple things at the same time. It doesn't matter if these things are hashrefs that are stored within the same hashref under different keys, or if they are seperate variables. What you have to do is build that list yourself, by looking at each of the things in turn. That's simply done with above map statement.
First, look at all the keys in $foo. Then for each of these, return the keys inside that element.
my $memType = [];
my $portOp = [];
my $fo = “aster.out.DRAMA.READ.gz”;
if ($fo =~ /aster.out\.(\w+)\.(\w+)\.gz/ ) { #This regular expression is safer
push (#$memType, $1);
push (#$portOp, $2);
}
print Dumper “#$memType”; #should print “DRAMA”
#Now if you have earlier in your program the hash %portCapability, your code can be:
foreach $mem (#$memType) {
print $portCapability{$mem};
}
#or if you have the hash $portCapability = {…}, your code can be:
foreach $mem (#$memType) {
print $portCapability->{$mem};
}
#Hope it helps
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'
}
}
};
I have a working bit of code here where I am comparing the keys of six hashes together to find the ones that are common amongst all of them. I then combine the values from each hash into one value in a new hash. What I would like to do is make this scaleable. I would like to be able to easily go from comparing 3 hashes to 100 without having to go back into my code and altering it. Any thoughts on how I would achieve this? The rest of the code already works well for different input amounts, but this is the one part that has me stuck.
my $comparison = List::Compare->new([keys %{$posHashes[0]}], [keys %{$posHashes[1]}], [keys %{$posHashes[2]}], [keys %{$posHashes[3]}], [keys %{$posHashes[4]}], [keys %{$posHashes[5]}]);
my %comboHash;
for ($comparison->get_intersection) {
$comboHash{$_} = ($posHashes[0]{$_} . $posHashes[1]{$_} . $posHashes[2]{$_} . $posHashes[3]{$_} . $posHashes[4]{$_} . $posHashes[5]{$_});
}
my %all;
for my $posHash (#posHashes) {
for my $key (keys(%$posHash)) {
push #{ $all{$key} }, $posHash->{$key};
}
}
my %comboHash;
for my $key (keys(%all)) {
next if #{ $all{$key} } != #posHashes;
$comboHash{$key} = join('', #{ $all{$key} });
}
Just make a subroutine and pass it hash references
my $combination = combine(#posHashes);
sub combine {
my #hashes = #_;
my #keys;
for my $href (#hashes) {
push #keys, keys %$href;
}
# Insert intersection code here..
# .....
my %combo;
for my $href (#hashes) {
for my $key (#intersection) {
$combo{$key} .= $href->{$key};
}
}
return \%combo;
}
Create a subroutine:
sub combine_hashes {
my %result = ();
my #hashes = #_;
my $first = shift #hashes;
for my $element (keys %$first) {
my $count = 0;
for my $href (#hashes) {
$count += (grep {$_ eq $element} (keys %$href));
}
if ($count > $#hashes) {
$result{$element} = $first->{$element};
$result{$element} .= $_->{$element} for #hashes;
}
}
\%result;
}
and call it by:
my %h = %{combine_hashes(\%h1, \%h2, \%h3)};
...or as:
my %h = %{combine_hashes(#posHashes)};
There is pretty straightforward solution:
sub merge {
my $first = shift;
my #hashes = #_;
my %result;
KEY:
for my $key (keys %$first) {
my $accu = $first->{$key};
for my $hash (#hashes) {
next KEY unless exists $hash->{$key};
$accu .= $hash->{$key};
}
$result{$key} = $accu;
}
return \%result;
}
You have to call it with references to hashes and it will return also hash reference e.g.:
my $comboHashRef = merge(#posHashes);
I have Perl code, which looks messy:
my $x = $h->[1];
foreach my $y (keys %$x) {
my $ax = $x->{$y};
foreach my $ay (keys %$ax) {
if (ref($ax->{$ay}) eq 'JE::Object::Proxy') {
my $bx = $ax->{$ay};
if ($$bx->{class_info}->{name} eq 'HTMLImageElement') {
print $$bx->{value}->{src}, "\n";
}
}
}
}
Is it possible to optimize the code above to not use any variables, just $h, as that one is an input?
Here's my crack at it:
print $$_->{value}{src}, "\n" for grep {
ref $_ eq 'JE::Object::Proxy' &&
$$_->{class_info}{name} eq 'HTMLImageElement'
} map {
values %$_
} values %{ $h->[1] };
You're using keys, when you really just want values.
foreach my $h ( grep { ref() eq 'HASH' } values %$x ) {
foreach my $obj (
grep { ref() eq 'JE::Object::Proxy'
and $_->{class_info}{name} eq 'HTMLImageElement'
} values %$h
) {
say $obj->{value}{src};
}
}
A lot of the "messiness" can be cleaned up by reducing your line count and minimizing how much nested code you have. Use the each command to get the next key and its associated value from the hash in one line. [EDIT: as Axeman pointed out, you really only need the values, so I'm replacing my use of each with values]. Also, use a pair of next statement to skip the print statement.
for my $ax (values %{$h->[1]} ) {
for my $bx (values %$ax ) {
next unless ref($bx) eq 'JE::Object::Proxy';
next unless $$bx->{class_info}->{name} eq 'HTMLImageElement';
print "$$bx->{value}->{src}\n";
}
}
Just removing the helper variables is easy, something like this should do it:
foreach my $y (keys %{$h->[1]}) {
foreach my $ax (%{$h->[1]->{$y}) {
foreach my $ay (keys %$ax) {
if(ref($h->[1]->{$y}->{$ay}) eq 'JE::Object::Proxy') {
if($h->[1]->{$y}->{$ay}->{class_info}->{name} eq 'HTMLImageElement') {
print $h->[1]->{$y}->{$ay}->{value}->{src}, "\n";
}
}
}
}
}
You could also remove the duplicated if:
foreach my $y (keys %{$h->[1]}) {
foreach my $ax (%{$h->[1]->{$y}) {
foreach my $ay (keys %$ax) {
if(ref($h->[1]->{$y}->{$ay}) eq 'JE::Object::Proxy' && $h->[1]->{$y}->{$ay}->{class_info}->{name} eq 'HTMLImageElement') {
print $h->[1]->{$y}->{$ay}->{value}->{src}, "\n";
}
}
}
}
But I don't really see how to make it more readable: it is a iteration over a three dimensional structure.
I'm using DBI to connect to Sybase to grab records in a hash_ref element. The DBI::Sybase driver has a nasty habit of returning records with trailing characters, specifically \x00 in my case. I'm trying to write a function to clean this up for all elements in the hashref, the code I have below does the trick, but I can't find a way to make it leaner, and I know there is away to do this better:
#!/usr/bin/perl
my $dbh = DBI->connect('dbi:Sybase:...');
my $sql = qq {SELECT * FROM table WHERE age > 18;};
my $qry = $dbh->selectall_hashref($sql, 'Name');
foreach my $val(values %$qry) {
$qry->{$val} =~ s/\x00//g;
}
foreach my $key(keys %$qry) {
$qry->{$key} =~ s/\x00//g;
foreach my $val1(keys %{$qry->{$key}}) {
$qry->{$key}->{$val1} =~ s/\x00//g;
}
foreach my $key1(keys %{$qry->{$key}}) {
$qry->{$key}->{$key1} =~ s/\x00//g;
}
While I think that a regex substitution is not exactly an ideal solution (seems like it should be fixed properly instead), here's a handy way to solve it with chomp.
use Data::Dumper;
my %a = (
foo => {
a => "foo\x00",
b => "foo\x00"
},
bar => {
c => "foo\x00",
d => "foo\x00"
},
baz => {
a => "foo\x00",
a => "foo\x00"
}
);
$Data::Dumper::Useqq=1;
print Dumper \%a;
{
local $/ = "\x00";
chomp %$_ for values %a;
}
print Dumper \%a;
chomp will remove a single trailing value equal to whatever the input record separator $/ is set to. When used on a hash, it will chomp the values.
As you will note, we do not need to use the values directly, as they are aliased. Note also the use of a block around the local $/ statement to restrict its scope.
For a more manageable solution, it's probably best to make a subroutine, called recursively. I used chomp again here, but you can just as easily skip that and use s/\x00//g. Or tr/\x00//d, which basically does the same thing. chomp is only safer in that it only removes characters from the end of the string, like s/\x00$// would.
strip_null(\%a);
print Dumper \%a;
sub strip_null {
local $/ = "\x00";
my $ref = shift;
for (values %$ref) {
if (ref eq 'HASH') {
strip_null($_); # recursive strip
} else {
chomp;
}
}
}
First your code:
foreach my $val(values %$qry) {
$qry->{$val} =~ s/\x00//g;
# here you are using a value as if it was a key
}
foreach my $key(keys %$qry) {
$qry->{$key} =~ s/\x00//g;
foreach my $val1(keys %{$qry->{$key}}) {
$qry->{$key}->{$val1} =~ s/\x00//g;
}
foreach my $key1(keys %{$qry->{$key}}) {
$qry->{$key}->{$key1} =~ s/\x00//g;
}
# and this does the same thing twice...
what you should do is:
foreach my $x (values %$qry) {
foreach my $y (ref $x eq 'HASH' ? values %$x : $x) {
$y =~ s/(?:\x00)+$//
}
}
which will clean up only ending nulls in the values of two levels of the hash.
the body of the loop could also be written as:
if (ref $x eq 'HASH') {
foreach my $y (values %$x) {
$y =~ s/(?:\x00)+$//
}
}
else {
$x =~ s/(?:\x00)+$//
}
But that forces you to write the substitution twice, and you shouldn't repeat yourself.
Or if you really want to reduce the code, using the implicit $_ variable works well:
for (values %$qry) {
s/(?:\x00)+$// for ref eq 'HASH' ? values %$_ : $_
}