I am new to Perl, and I am trying something with a hash. I have a hash of hashes like below:
%HoH =
(
"Test1" => { checked => 1, mycmd => run1 },
"Test2" => { checked => 1, mycmd => run2 },
)
Using the below code I will get the output given below:
for $family ( keys %HoH )
{
print "$family: ";
for $role ( keys %{ $HoH{$family} } )
{
print "$role=$HoH{$family}{$role} ";
}
print "\n";
}
Output:
Test1: checked=1 mycmd=run1
Test2: checked=1 mycmd=run2
My question is, how can I access individual checked & cmd separately? By accessing separately, I can compare what is checked and do my task.
It's pretty straight-forward to just use the keyword(s) literally:
%HoH =
(
"Test1" => { checked => 1, cmd => run1 },
"Test2" => { checked => 1, cmd => run2 },
);
if ($HoH{"Test1"}{checked}) {
print "Test1 is Checked with cmd: " . $HoH{"Test1"}{cmd} . "\n";
}
Test1 is Checked with cmd: run1
Did I understand your question correctly?
for my $family ( keys %HoH )
{
if ($HoH{$family}->{checked}) {
# Do what you want...
}
}
Related
I've parsed JSON into the following data structure:
$VAR1 = {
'041012020' => {
'item_number' => 'P2345'
},
'041012021' => {
'item_number' => 'I0965'
},
'041012022' => {
'item_number' => 'R2204'
}
};
I'm trying to get the values of item_numbers using the following code, and it's giving me the HASH Values as output rather than the actual item_number values. Please guide me to get the expected values.
foreach my $value (values %{$json_obj}) {
say "Value is: $value,";
}
Output:
Value is: HASH(0x557ce4e2f3c0),
Value is: HASH(0x557ce4e4de18),
Value is: HASH(0x557ce4e4dcf8),
If I use the same code to get the keys it's working perfectly fine
foreach my $key (keys %{$json_obj}) {
say "Key is: $key,";
}
Output:
Key is: 041012020,
Key is: 041012020,
Key is: 041012022,
The values of the hash elements are references to hashes ({ item_number => 'P2345' }). That's what you get when you stringify a reference. If you want the item number, you'll need to tell Perl that.
for my $value (values %$data) {
say $value->{item_number};
}
or
for my $item_number ( map { $_->{item_number} } values %$data ) {
say $item_number;
}
Here is the short code for your question.
#!usr/bin/perl
$VAR1 = {
'041012020' => {
'item_number' => 'P2345'
},
'041012021' => {
'item_number' => 'I0965'
},
'041012022' => {
'item_number' => 'R2204'
}
};
print "$VAR1->{$_}->{item_number}\n" for keys %$VAR1;
To use for in a block:
for my $key (keys %$VAR1) {
print "$VAR1->{$key}->{item_number}\n"
}
The Perl code below works, but it doesn't scale well even with considerable computer resources. I hoping that someone can help me find more efficient code such as by replacing recursion with iteration, if that's the problem.
my data structure looks like this:
my %REV_ALIGN;
$REV_ALIGN{$dna}{$rna} = ();
Any dna key may have multiple rna sub keys. The same rna sub key may appear with multiple different dna keys. The purpose is to group rna ( transcripts ) based on shared dna sequence elements. For example, if dnaA has RNA1, RNA8, RNA9, and RNA4, and dnaB has RNA11, RNA4, and RNA99, then we group all these transcripts together ( RNA1, RNA9, RNA4, RNA11, RNA99 ) and continue to proceed to try and add to the group by selecting other dna. My recusive solution to this problem works but doesn't scale so well when using data from whole genome to transcriptome alignment.
SO MY QUESTION IS: WHAT IS A MORE EFFICIENT SOLUTION TO THIS PROBLEM? THANK YOU VERY MUCH
my #groups;
while ( my $x =()= keys %REV_ALIGN )
{
my #DNA = keys %REV_ALIGN;
my $dna = shift #DNA;
# the corresponding list of rna
my #RNA = keys %{$REV_ALIGN{$dna}};
delete $REV_ALIGN{$dna};
if ( $x == 1 )
{
push #groups, \#RNA;
last;
}
my $ref = group_transcripts ( \#RNA, \%REV_ALIGN );
push #groups, $ref;
}
sub group_transcripts
{
my $tran_ref = shift;
my $align_ref = shift;
my #RNA_A = #$tran_ref;
my %RNA;
# create a null hash with seed list of transcripts
#RNA{#RNA_A} = ();
# get a list of all remaining dna sequences in the alignment
my #DNA = keys %{$align_ref};
my %count;
# select a different list of transcripts
for my $dna ( #DNA )
{
next unless exists $align_ref->{$dna};
my #RNA_B = keys %{$align_ref->{$dna}};
# check to see two list share and transcripts
for my $element ( #RNA_A, #RNA_B )
{
$count{$element}++;
}
for my $rna_a ( keys %count )
{
# if they do, add any new transcripts to the current group
if ( $count{$rna_a} == 2 )
{
for my $rna_b ( #RNA_B )
{
push #RNA_A, $rna_b if $count{$rna_b} == 1;
}
delete $align_ref->{$dna};
delete $count{$_} foreach keys %count;
# recurse to try and continue adding to list
#_ = ( \#RNA_A, $align_ref );
goto &group_transcripts;
}
}
delete $count{$_} foreach keys %count;
}
# if no more transcripts can be added, return a reference to the group
return \#RNA_A;
}
You have a loops nested four deep. It's an pretty safe bet that's why your code scales poorly.
If I understand correctly what you are trying to accomplish, the input
my %REV_ALIGN = (
"DNA1" => { map { $_ => undef } "RNA1", "RNA2" }, # \ Linked by RNA1 \
"DNA2" => { map { $_ => undef } "RNA1", "RNA3" }, # / \ Linked by RNA3 > Group
"DNA3" => { map { $_ => undef } "RNA3", "RNA4" }, # / /
"DNA4" => { map { $_ => undef } "RNA5", "RNA6" }, # \ Linked by RNA5 \ Group
"DNA5" => { map { $_ => undef } "RNA5", "RNA7" }, # / /
"DNA6" => { map { $_ => undef } "RNA8" }, # > Group
);
should result in
my #groups = (
[
dna => [ "DNA1", "DNA2", "DNA3" ],
rna => [ "RNA1", "RNA2", "RNA3", "RNA4" ],
],
[
dna => [ "DNA4", "DNA5" ],
rna => [ "RNA5", "RNA6", "RNA7" ],
],
[
dna => [ "DNA6" ],
rna => [ "RNA8" ],
],
);
If so, you can use the following:
use strict;
use warnings;
use Graph::Undirected qw( );
my %REV_ALIGN = (
"DNA1" => { map { $_ => undef } "RNA1", "RNA2" },
"DNA2" => { map { $_ => undef } "RNA1", "RNA3" },
"DNA3" => { map { $_ => undef } "RNA3", "RNA4" },
"DNA4" => { map { $_ => undef } "RNA5", "RNA6" },
"DNA5" => { map { $_ => undef } "RNA5", "RNA7" },
"DNA6" => { map { $_ => undef } "RNA8" },
);
my $g = Graph::Undirected->new();
for my $dna (keys(%REV_ALIGN)) {
for my $rna (keys(%{ $REV_ALIGN{$dna} })) {
$g->add_edge("dna:$dna", "rna:$rna");
}
}
my #groups;
for my $raw_group ($g->connected_components()) {
my %group = ( dna => [], rna => [] );
for (#$raw_group) {
my ($type, $val) = split(/:/, $_, 2);
push #{ $group{$type} }, $val;
}
push #groups, \%group;
}
use Data::Dumper qw( Dumper );
print(Dumper(\#groups));
If you just want the RNA, the final section simplifies to the following:
my #groups;
for my $raw_group ($g->connected_components()) {
my #group;
for (#$raw_group) {
my ($type, $val) = split(/:/, $_, 2);
push #group, $val if $type eq 'rna';
}
push #groups, \#group;
}
I have a Perl data structurte like so
%myhash = (
k1 => v1,
kArray => [
{
name => "anonymous hash",
...
},
\&funcThatReturnsHash,
{
name => "another anonymous hash",
...
}
]
);
Elsewhere I iterate through the list in kArray which contains a bunch of hashes. I would like to either process the actual hash OR the hash returned by the function.
foreach my $elem( #{myhash{kArray}} ) {
if (ref($elem) == "CODE") {
%thisHash = &$elem;
}
else {
%thisHash = %$elem;
}
...
}
However ref ($elem) is always scalar or undefined. I tried func, &func, \&func, \%{&func}, in %myhash to no effect.
how do I extract the hash within the function in the main body?
Apart from the code sample you give being invalid Perl, the main problems seem to be that you are using == to compare strings instead of eq, and you are assigning a hash reference to a hash variable %thishash. I assure you that ref $elem never returns SCALAR with the data you show
It would help you enormously if you followed the common advice to use strict and use warnings at the top of your code
This will work for you
for my $elem ( #{ $myhash{kArray} } ) {
my $this_hash;
if ( ref $elem eq 'CODE' ) {
$this_hash = $elem->();
}
else {
$this_hash = $elem;
}
# Do stuff with $this_hash
}
or you could just use a map like this
use strict;
use warnings;
use 5.010;
use Data::Dump;
my %myhash = (
k1 => v1,
kArray => [
{
name => "anonymous hash",
},
\&funcThatReturnsHash,
{
name => "another anonymous hash",
}
]
);
for my $hash ( map { ref eq 'CODE' ? $_->() : $_ } #{ $myhash{kArray} } ) {
say $hash->{name};
}
sub funcThatReturnsHash {
{ name => 'a third anonymous hash' };
}
output
anonymous hash
a third anonymous hash
another anonymous hash
If you turn on strict and warnings, you'll see that:
foreach my $elem(#{mynahs{kArray}}) {
Isn't valid. You need at the very least a $ before mynahs.
But given something like this - your approach works - here's an example using map to 'run' the code references:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
sub gimme_hash {
return { 'fish' => 'paste' };
}
my $stuff =
[ { 'anon1' => 'value' },
\&gimme_hash,
{ 'anon2' => 'anothervalue' }, ];
my $newstuff = [ map { ref $_ eq "CODE" ? $_->() : $_ } #$stuff ];
print Dumper $newstuff;
Turns that hash into:
$VAR1 = [
{
'anon1' => 'value'
},
{
'fish' => 'paste'
},
{
'anon2' => 'anothervalue'
}
];
But your approach does work:
foreach my $element ( #$stuff ) {
my %myhash;
if ( ref $element eq "CODE" ) {
%myhash = %{$element -> ()};
}
else {
%myhash = %$element;
}
print Dumper \%myhash;
}
Gives:
$VAR1 = {
'anon1' => 'value'
};
$VAR1 = {
'fish' => 'paste'
};
$VAR1 = {
'anon2' => 'anothervalue'
};
I have a question I'm hoping you could help with?
This is the last part I need help with in understanding hash references
Code:
my $content_lengths; # this is at the top
foreach my $url ( # ... more stuff
# compare
if ( $mech->response->header('Content-Length') != $content_length ) {
print "$child_url: different content length: $content_length vs "
. $mech->response->header('Content-Length') . "!\n";
# store the urls that are found to have different content
# lengths to the base url only if the same url has not already been stored
$content_lengths->{$url}->{'different'}->{$child_url} = $mech->response->header('Content-Length');
} elsif ( $mech->response->header('Content-Length') == $content_length ) {
print "Content lengths are the same\n";
# store the urls that are found to have the same content length as the base
# url only if the same url has not already been stored
$content_lengths->{$url}->{'equal'}->{$child_url} = $mech->response->header('Content-Length');
}
What it looked like using Data::Dumper
$VAR1 = {
'http://www.superuser.com/' => {
'difference' => {
'http://www.superuser.com/questions' => '10735',
'http://www.superuser.com/faq' => '13095'
},
'equal' => {
'http://www.superuser.com/ ' => '20892'
}
},
'http://www.stackoverflow.com/' => {
'difference' => {
'http://www.stackoverflow.com/faq' => '13015',
'http://www.stackoverflow.com/questions' => '10506'
},
'equal' => {
'http://www.stackoverflow.com/ ' => '33362'
}
}
};
What I need help with:
I need help understanding the various ways of accessing the different parts in the hash reference and using them to do things, such as print them.
So for example how do I print all the $url from the hash reference (i.e from Data::Dumper that will be http://www.superuser.com/ and http://www.stackoverflow.com/)
and how do I print all the $child_url or a particular one/subset from $child_url and so on?
Your help with this is much appreciated,
thanks a lot
You can navigate your hashref thusly:
$hashref->{key1}{key2}{keyN};
For example, if you want the superuser equal branch:
my $urlArrayref = $hashref->{'http://www.superuser.com/'}{'equal'};
More to the point, to print the urls (first level key) of the hashref, you would do:
foreach my $key ( keys( %{$hashref} ) ) {
print( "key is '$key'\n" );
}
Then if you wanted the second level keys:
foreach my $firstLevelKey ( keys( %{$hashref} ) ) {
print( "first level key is '$firstLevelKey'\n" );
foreach my $secondLevelKey ( keys( %{$hashref->{$firstLevelKey}} ) ) {
print( "\tfirst level key is '$secondLevelKey'\n" );
}
}
And so forth...
----- EDIT -----
This is working sample code from your example above:
#!/usr/bin/perl
use strict;
use warnings;
my $content_lengths = {
'http://www.superuser.com/' => {
'difference' => {
'http://www.superuser.com/questions' => '10735',
'http://www.superuser.com/faq' => '13095'
},
'equal' => {
'http://www.superuser.com/ ' => '20892'
}
},
'http://www.stackoverflow.com/' => {
'difference' => {
'http://www.stackoverflow.com/faq' => '13015',
'http://www.stackoverflow.com/questions' => '10506'
},
'equal' => {
'http://www.stackoverflow.com/ ' => '33362'
}
}
};
foreach my $key1 ( keys( %{$content_lengths} ) ) {
print( "$key1\n" );
foreach my $key2 ( keys( %{$content_lengths->{$key1}} ) ) {
print( "\t$key2\n" );
foreach my $key3 ( keys( %{$content_lengths->{$key1}{$key2}} ) ) {
print( "\t\t$key3\n" );
}
}
}
Which results in this output:
http://www.superuser.com/
difference
http://www.superuser.com/questions
http://www.superuser.com/faq
equal
http://www.superuser.com/
http://www.stackoverflow.com/
difference
http://www.stackoverflow.com/faq
http://www.stackoverflow.com/questions
equal
http://www.stackoverflow.com/
This is my problem, I'm not very knowledgeable in Perl, and I have this function that needs to be fixed.
When this function deviceModelMenu() is called, the CLI displays the following text:
The following models are available
==================================================
1.
2. Cisco1240
3. Catalyst3750
4. Catalyst3650
5. HP2524
The first item is empty, which is wrong, and I need to fix that, the piece of code that displays this menu is:
my $features = shift;
print "=" x 50, "\n";
print "The following models are available\n";
print "=" x 50, "\n";
my $i=1;
foreach (keys %{$features->{features}[0]->{deviceModel}})
{
print "$i. $_ \n";
$i++;
}
If I add the following line:
warn Dumper($features->{features}[0]->{deviceModel});
It dumps this:
$VAR1 = {
'deviceModel' => {
'' => {
'cfg' => []
},
'Cisco1240' => {
'cfg' => [
'cisco1240feature.cfg'
]
},
'Catalyst3750' => {
'cfg' => [
'catalyst3750feature.cfg'
]
},
'Catalyst3650' => {
'cfg' => [
'catalyst3650feature.cfg'
]
},
'HP2524' => {
'cfg' => [
'hp2524feature.cfg'
]
}
}
};
As you may notice, the first item is indeed empty. I added the following line to skip it, and just print the rest of the info:
if ($_ eq '') {
shift;
}
But it doesn't seem to work do what I want. I want to skip the item if it's empty.
Well, shifting #ARGV (implicit argument to shift in main program) nor shifting #_ (implicit argument of shift in a function) are not going to help you, because you are not printing either of them.
You can either:
Not add the '' entry in the first place (depends on how it's generated)
Remove the '' entry before printing:
delete $features->{features}[0]->{deviceModel}->{''};
Don't print the entry:
if($_ eq '') {
next;
}
or
if($_ ne '') {
print "$i. $_ \n";
$i++;
}
foreach (keys %{$features->{features}[0]->{deviceModel}})
{
next unless length($_);
print "$i. $_ \n";
$i++;
}
#!/usr/bin/env perl
use strict; use warnings;
my $devices = {
'deviceModel' => {
'' => { 'cfg' => [] },
'Cisco1240' => { 'cfg' => ['cisco1240feature.cfg' ] },
'Catalyst3750' => { 'cfg' => [ 'catalyst3750feature.cfg' ]},
'Catalyst3650' => { 'cfg' => [ 'catalyst3650feature.cfg' ]},
'HP2524' => { 'cfg' => [ 'hp2524feature.cfg' ]},
}
};
{
my $item = 1;
for my $d (grep length, keys %{ $devices->{deviceModel} }) {
printf "%2d. %s\n", $item++, $d;
}
}
Output:
1. Catalyst3750
2. Cisco1240
3. Catalyst3650
4. HP2524