perl: Print object property names and values - perl

The following:
for my $z (#$y) {
# prints number of observables for a given activity summary
# print STDERR 'property count'.keys $z
print Dumper($z);
}
Prints:
$VAR1 = {
'activity' => 'walking',
'duration' => '591',
'calories' => 26,
'distance' => '435',
'steps' => 871,
'group' => 'walking'
};
$VAR1 = {
'steps' => 168,
'group' => 'walking',
'distance' => '100',
'activity' => 'walking',
'duration' => '200',
'calories' => 6
};
How can I iterate over each property and print its name and value? Im using perl.

Here's one way:
for my $z (#$y) {
for my $k (keys %$z) {
print "$k: $z->{$k}\n";
}
}
See perldoc -f keys for more information about keys; perldoc perldata for general information about hashes (because your $z values are hash references, not objects); perldoc perlreftut for references and nested data structures.

you can try this:
my $z = {
'activity' => 'walking',
'duration' => '591',
'calories' => 26,
'distance' => '435',
'steps' => 871,
'group' => 'walking'
};
while((my $key, my $value) = each (%{$z})){
print "key : $key -> value : $value\n";
}

Related

How can I find which keys in a Perl multi-level hash correspond to a given value?

I have a data structure which looks like this:
my %hoh = (
'T431567' => {
machin => '01',
bidule => '02',
truc => '03',
},
'T123456' => {
machin => '97',
bidule => '99',
truc => '69',
},
'T444444' => {
machin => '12',
bidule => '64',
truc => '78',
},
);
I want to search the various values of truc for a particular value and find the top-level attribute which corresponds to that entry. For example, looking for a value of 78, I want to find the result 'T444444', because $hoh{T444444}{truc} is 78.
How can I do this, please?
You can do this with grep:
my #keys = grep { $hoh{$_}{truc} == 78 } keys %hoh;
Note that this can return more than one key, if there are duplicate values in the hash. Also note that this is not particularly efficient, since it has to search the entire hash. In most cases it's probably fine, but if the hash can be very large and you may need to run lots of such queries against it, it may be more efficient to build a reverse index as suggested by Sobrique:
my %trucs;
foreach my $part (keys %hoh) {
my $val = $hoh{$part}{truc};
push #{ $trucs{$val} }, $part;
}
my #keys = #{ $trucs{78} };
or, more generally:
my %index;
foreach my $part (keys %hoh) {
my %data = %{ $hoh{$part} };
foreach my $key (keys %data) {
my $val = $data{$key};
push #{ $index{$key}{$val} }, $part;
}
}
my #keys = #{ $index{truc}{78} };
Can't with that data structure as is - There is no 'backwards' relationship from value to key without you creating it.
You've two options - run a search, or create an 'index'. Practically speaking, these are the same, just one saves the results.
my %index;
foreach my $key ( keys %hoh ) {
my $truc = $hoh{$key}{'truc'};
$index{$truc} = $key;
}
Note - won't do anything clever if the 'truc' numbers are duplicated - it'll overwrite. (Handling this is left as an exercise to the reader).
This solution is similar to those already posted, but it uses the each operator to process the original hash in fewer lines of code, and probably more quickly.
I have added the dump output only so that you can see the form of the structure that is built.
use strict;
use warnings;
my %hoh = (
T123456 => { bidule => '99', machin => '97', truc => '69' },
T431567 => { bidule => '02', machin => '01', truc => '03' },
T444444 => { bidule => '64', machin => '12', truc => '78' },
);
my %trucs;
while ( my ($key, $val) = each %hoh ) {
next unless defined( my $truc = $val->{truc} );
push #{ $trucs{$truc} }, $key ;
}
use Data::Dump;
dd \%trucs;
print "\n";
print "$_\n" for #{ $trucs{78} };
output
{ "03" => ["T431567"], "69" => ["T123456"], "78" => ["T444444"] }
T444444
If you can guarantee that the answer is unique, i.e. that there is never more than one element of the original hash that has a given value for the truc entry, or you are interested only in the last one found, then you can write this still more neatly
my %trucs;
while ( my ($key, $val) = each %hoh ) {
next unless defined( my $truc = $val->{truc} );
$trucs{$truc} = $key ;
}
print $trucs{78}, "\n";
output
T444444
Simplest of all, if there is always a truc entry in each second-level hash, and its values is guaranteed to be unique, then this will do the job
my %trucs = map { $hoh{$_}{truc} => $_ } keys %hoh;
print $trucs{78}, "\n";
with the output as above.

How do I get all values of a key in a perl data structure?

I want to write a function that will return a list of all “id” values in the data structure below at any level, sorted numerically. Also if the same value is found in multiple locations in the data structure it should only be included in the returned list once.
sub ids {
my ($data) = #_;
 
# Define this function

 }

 
 my $data = {
'top' => {
'window' => {
'elements' => {
{ id => 44, name => 'link', value => 'www.cnn.com' },

 { id => 48, name => 'title', value => 'CNN Home Page' },
{ id => 100, name => 'author', value => 'Admin' }
},

 id => 19

 },

 'cache' => {

 { id => 199, data => '5' },

 { id => 40, data => '9' },
{ id => 100, data => { name => 'author', value => 'Admin' }
}
 },
id => 55
 },

 id => 1

 };

 
 # should print “1, 19, 40, 44, 49, 55, 100, 199”
print join(', ', ids($data)) . “\n”;
Some of data structure should be arrays, not hashes as in OP,
use strict;
use warnings;
sub ids_r {
my ($data) = #_;
return map {
my $r = ref($data->{$_});
$r eq "HASH" ? ids_r($data->{$_}) :
$r ? map ids_r($_), #{$data->{$_}} :
$_ eq "id" ? $data->{$_} :
();
} keys %$data;
}
sub ids {
my ($data) = #_;
my %seen;
return
sort { $a <=> $b }
grep !$seen{$_}++, ids_r($data);
}
my $data = {
'top' => {
'window' => {
'elements' => [
{ id => 44, name => 'link', value => 'www.cnn.com' },
{ id => 48, name => 'title', value => 'CNN Home Page' },
{ id => 100, name => 'author', value => 'Admin' }
],
id => 19
},
'cache' => [
{ id => 199, data => '5' },
{ id => 40, data => '9' },
{ id => 100, data => { name => 'author', value => 'Admin' } }
],
id => 55
},
id => 1
};
print join(', ', ids($data));
output
1, 19, 40, 44, 48, 55, 100, 199
Here's a simple recursive solution. It's pretty easy to see what's going on here.
# There is a faster version of `uniq` provided by List::MoreUtils on CPAN.
sub uniq {
my %seen;
grep !$seen{$_}++, #_;
}
sub ids {
my $val = shift;
my $ref = ref $val;
my #r;
if ($ref eq 'HASH')
{
#r = map ids($_), grep ref, values(%$val);
push #r, $val->{id} if exists $val->{id};
}
elsif ($ref eq 'ARRAY')
{
#r = map ids($_), grep ref, #$val;
}
sort { $a <=> $b } uniq(#r);
}
#mpapec provides a similar solution which uses recursion without doing the sorting (the sub called ids_r in his answer), and then calls that from a separate wrapper function (the sub called ids in his answer) which provides the sorting all at the end. This is more efficient, but arguably more complex. (Indeed, because he had two similarly named functions, the first version of the answer included a mistake which negated the benefit of splitting the sorting out.)
Here's yet another technique, using a queue-based approach instead of recursion. If your data structure is very large, you may find that this works significantly faster.
# There is a faster version of `uniq` provided by List::MoreUtils on CPAN.
sub uniq {
my %seen;
grep !$seen{$_}++, #_;
}
sub ids {
my #r;
while (#_) {
my $val = shift;
my $ref = ref($val);
if ($ref eq 'HASH')
{
push #r, $val->{id} if exists $val->{id};
push #_, grep ref, values %$val;
}
elsif ($ref eq 'ARRAY')
{
push #_, grep ref, #$val;
}
}
sort { $a <=> $b } uniq(#r);
}

Sorting by value Hash of Hashes Perl

Let's say I have a hash of hashes data structure constructed as followed:
%HoH => (
flintstones => {
family_members => "fred;wilma;pebbles;dino",
number_of_members => 4,
},
jetsons => {
family_members => "george;jane;elroy",
number_of_members => 3,
},
simpsons => {
family_members => "homer;marge;bart;lisa;maggie",
number_of_members => 5,
},
)
How do I sort the keys, the families in this case, by the value number_of_members from greatest to least? Then I would like to print out the highest two. Here's a general idea but I know it's wrong:
foreach $value (
sort {
$HoH{$a}{$number_of_members} cmp $HoH{$b}{$number_of_members}
} keys %HoH)
my $count = 0;
while ($key, $value) = each %HoH) {
if (count <= 2){
print "${HoH}{$key}\t$key{$value}";
}
}
continue {
$count++;
};
I want the code to print (the spaces are tab delimited):
simpsons homer;marge;bart;lisa;maggie
flintstones fred;wilma;pebbles;dino
You're on the right track. You use the $a and $b internal variables in the hash and compare the values numerically (<=> not cmp).
When printing, I find it easiest to store the keys in an array and use an array slice to access them.
use strict;
use warnings;
my %HoH = (
flintstones => {
family_members => "fred;wilma;pebbles;dino",
number_of_members => 4,
},
jetsons => {
family_members => "george;jane;elroy",
number_of_members => 3,
},
simpsons => {
family_members => "homer;marge;bart;lisa;maggie",
number_of_members => 5,
},
);
my #sorted = sort { $HoH{$b}{'number_of_members'} <=>
$HoH{$a}{'number_of_members'} } keys %HoH;
for (#sorted[0,1]) { # print only first two
print join("\t", $_, $HoH{$_}{'family_members'}), "\n";
}
Output:
simpsons homer;marge;bart;lisa;maggie
flintstones fred;wilma;pebbles;dino

odd number of elements in anonymous hash

I'm trying to understand this Perl code...
If there is one stream it works, if there are 2 or more streams it warns with odd number of elements in anonymous hash. It seems to return an array in that case. How do I add the array elements correctly to #streams? It appears to add correctly for the HASH case in the if clause. Is the else clause bunk?
my $x = $viewedProjectDataObj->{streams};
if (ref($x) eq 'HASH') {
push(#streams, $x->{id});
} elsif (ref($x) eq 'ARRAY') {
print "$x\n";
print "#$x\n";
my #array = #$x;
foreach my $obj (#array) {
print "in $obj\n";
print Dumper( $obj);
push(#streams, ($obj->{id}) );
}
}
print "streamcount " . #streams % 2;
print Dumper(#streams);
my $stream_defect_filter_spec = {
'streamIdList' => #streams,
'includeDefectInstances' => 'true',
'includeHistory' => 'true',
};
my #streamDefects = $WS->get_stream_defects($defectProxy, \#cids, $stream_defect_filter_spec);
print Dumper(#streamDefects);
I'm adding the next lines...
if ($defectSummary->{owner} eq "Various") {
foreach (#streamDefects) {
if (exists($_->{owner})) {
$defectSummary->{owner} = $_->{owner};
last;
}
}
}
my $diref = $streamDefects[0]->{defectInstances};
if ($diref) {
my $defectInstance;
if (ref($diref) eq 'HASH') {
$defectInstance = $diref;
} elsif (ref($diref) eq 'ARRAY') {
$defectInstance = #{$diref}[0];
} else {
die "Unable to handle $diref (".ref($diref).")";
}
It now errors with
Web API returned error code S:Server: calling getStreamDefects: No stream found
for name null.
$VAR1 = -1;
me
Can't use string ("-1") as a HASH ref while "strict refs" in use at xyz-handler.pl line 317.
some Dumper output
$VAR1 = {
'streamIdList' => [
{
'name' => 'asdfasdfadsfasdfa'
},
{
'name' => 'cpp-62bad47d63cfb25e76b29a4801c61d8d'
}
],
'includeDefectInstances' => 'true',
'includeHistory' => 'true'
};
The list assigned to a hash is a set of key/value pairs, which is why the number of elements must be even.
Because the => operator is little more than a comma, and the #streams array is flattened in the list, this
my $stream_defect_filter_spec = {
'streamIdList' => #streams,
'includeDefectInstances' => 'true',
'includeHistory' => 'true',
};
is equivalent to this
my $stream_defect_filter_spec = {
'streamIdList' => $streams[0],
$streams[1] => $streams[2],
$streams[3] => $streams[4],
...
'includeDefectInstances' => 'true',
'includeHistory' => 'true',
};
so I hope you can see that you will get the warning if you have an even number of elements in the array.
To fix things you need the value of the hash element to be an array reference, which is a scalar and won't upset the scheme of things
my $stream_defect_filter_spec = {
'streamIdList' => \#streams,
'includeDefectInstances' => 'true',
'includeHistory' => 'true',
};
that way you can access the array elements as
$stream_defect_filter_spec->{streamIdList}[0]
etc.
And by the way you can tidy up your code substantially by letting map do what it's good at:
if (ref $x eq 'HASH') {
push #streams, $x->{id};
}
elsif (ref $x eq 'ARRAY') {
push #streams, map $_->{id}, #$x;
}
The assignment in:
my $stream_defect_filter_spec = {
'streamIdList' => #streams, # <---- THIS ONE
'includeDefectInstances' => 'true',
'includeHistory' => 'true',
};
is not correct, you get hash keys from the 1 3 5th ... array element.
You probably want assign a reference to array, not the array itself:
'streamIdList' => \#streams,
example for the unwanted (as in your code):
use strict;
use warnings;
use Data::Dump;
my #z = qw(a b c x y z);
dd \#z;
my $q = {
'aa' => #z,
};
dd $q;
unwanted result:
["a", "b", "c", "x", "y", "z"]
Odd number of elements in anonymous hash at a line 12.
{ aa => "a", b => "c", x => "y", z => undef }
^-here
Example of assign a reference
use strict;
use warnings;
use Data::Dump;
my #z = qw(a b c x y z);
dd \#z;
my $q = {
'aa' => \#z,
};
dd $q;
produces:
["a", "b", "c", "x", "y", "z"]
{ aa => ["a", "b", "c", "x", "y", "z"] }
The difference is clearly visible.

troubleshooting "pseudo-hashes are deprecated" while using xml module

I am just learning how to use perl hashes and ran into this message in perl. I am using XML::Simple to parse xml output and using exists to check on the hash keys.
Message:
Pseudo-hashes are deprecated at ./h2.pl line 53.
Argument "\x{2f}\x{70}..." isn't numeric in exists at ./h2.pl line 53.
Bad index while coercing array into hash at ./h2.pl line 53.
I had the script working earlier with one test directory and then executed the script on another directory for testing when I got this message. How do I resolve/workaround this?
Code that the error references:
use strict;
use warnings;
use XML::Simple;
use Data::Dumper;
#my $data = XMLin($xml);
my $data = XMLin($xml, ForceArray => [qw (file) ]);
my $size=0;
if (exists $data->{class}
and $data->{class}=~ /FileNotFound/) {
print "The directory: $Path does not exist\n";
exit;
} elsif (exists $data->{file}->{path}
and $data->{file}->{path} =~/test-out-00/) {
$size=$data->{file}->{size};
if ($size < 1024000) {
print "FILE SIZE:$size BYTES\n";
exit;
}
} else {
exit;
}
print Dumper( $data );
Working test case, data structure looks like this:
$VAR1 = {
'recursive' => 'no',
'version' => '0.20.202.1.1101050227',
'time' => '2011-09-30T02:49:39+0000',
'filter' => '.*',
'file' => {
'owner' => 'test_act',
'replication' => '3',
'blocksize' => '134217728',
'permission' => '-rw-------',
'path' => '/source/feeds/customer/test/test-out-00',
'modified' => '2011-09-30T02:48:41+0000',
'size' => '135860644',
'group' => '',
'accesstime' => '2011-09-30T02:48:41+0000'
'modified' => '2011-09-30T02:48:41+0000'
},
'exclude' => ''
};
recursive:no
version:0.20.202.1.1101050227
time:2011-10-01T07:06:16+0000
filter:.*
file:HASH(0x84c83ec)
path:/source/feeds/customer/test
directory:HASH(0x84c75d8)
exclude:
Data structure with seeing error:
$VAR1 = {
'recursive' => 'no',
'version' => '0.20.202.1.1101050227',
'time' => '2011-10-03T04:49:36+0000',
'filter' => '.*',
'file' => [
{
'owner' => 'test_act',
'replication' => '3',
'blocksize' => '134217728',
'permission' => '-rw-------',
'path' => '/source/feeds/customer/test/20110531/test-out-00',
'modified' => '2011-10-03T04:47:46+0000',
'size' => '121406618',
'group' => 'feeds',
'accesstime' => '2011-10-03T04:47:46+0000'
},
Test xml file:
<?xml version="1.0" encoding="UTF-8"?><listing time="2011-10-03T04:49:36+0000" recursive="no" path="/source/feeds/customer/test/20110531" exclude="" filter=".*" version="0.20.202.1.1101050227"><directory path="/source/feeds/customer/test/20110531" modified="2011-10-03T04:48:19+0000" accesstime="1970-01-01T00:00:00+0000" permission="drwx------" owner="test_act" group="feeds"/><file path="/source/feeds/customer/test/20110531/test-out-00" modified="2011-10-03T04:47:46+0000" accesstime="2011-10-03T04:47:46+0000" size="121406618" replication="3" blocksize="134217728" permission="-rw-------" owner="test_act" group="feeds"/><file path="/source/feeds/customer/test/20110531/test-out-01" modified="2011-10-03T04:48:04+0000" accesstime="2011-10-03T04:48:04+0000" size="127528522" replication="3" blocksize="134217728" permission="-rw-------" owner="test_act" group="feeds"/><file path="/source/feeds/customer/test/20110531/test-out-02" modified="2011-10-03T04:48:19+0000" accesstime="2011-10-03T04:48:19+0000" size="125452919" replication="3" blocksize="134217728" permission="-rw-------" owner="test_act" group="feeds"/></listing>
The "Pseudo-hashes are deprecated" error means you're trying to access an array as a hash, which means that either $data->{file} or $data->{file}{path} is an arrayref.
You can check the data type by using print ref $data->{file}. The Data::Dumper module may also help you to see what is in your data structure (perhaps while setting $Data::Dumper::Maxdepth = N to limit the dump to N number of levels if the structure is big).
UPDATE
Now that you are using ForceArray, $data->{file} should always point to an arrayref, which may possibly have multiple references to path. Here is a modified segment of your code to handle that. But note that the logic of the if-then-exit conditions may have to change.
if (defined $data->{class} and $data->{class}=~ /FileNotFound/) {
print "The directory: $Path does not exist\n";
exit;
}
exit if ! defined $data->{file};
# filter the list for the first file entry named test-out-00
my ( $file ) = grep {
defined $_->{path} && $_->{path} =~ /test-out-00/
} #{ $data->{file} };
exit if ! defined $file;
$size = $file->{size};
if ($size < 1024000) {
print "FILE SIZE:$size BYTES\n";
exit;
}
When using XML::Simple, the ForceArray option is one of the most important to understand, especially in cases when your input data has nested elements that can occur 1 or more times. For example:
use XML::Simple;
use Data::Dumper;
my #xml_snippets = (
'<opt> <name x="3" y="4">B</name> <name x="5" y="6">C</name> </opt>',
'<opt> <name x="1" y="2">A</name> </opt>',
);
for my $xs (#xml_snippets){
my $data = XMLin($xs, ForceArray => 0);
print Dumper($data);
}
Output:
$VAR1 = {
'name' => [ # Array ref because there are 2 <name> elements.
{
'y' => '4',
'content' => 'B',
'x' => '3'
},
{
'y' => '6',
'content' => 'C',
'x' => '5'
}
]
};
$VAR1 = {
'name' => { # No intermediate array ref.
'y' => '2',
'content' => 'A',
'x' => '1'
}
};
By activating the ForceArray option, you can direct XML::Simple to produce consistent data structures that always use the intermediate array reference, even when there is only 1 of a particular nested element. You can activate the option globally or for specific tags, as illustrated here:
my $data = XMLin($xs, ForceArray => 1 ); # Globally.
my $data = XMLin($xs, ForceArray => [qw(name foo bar)]);
First, I recommend that you use ForceArray => [qw( file )] as previously discussed. That will cause an array to be returned for file, whether there's one or more file element. This is easier to handle than having two possible formats.
As I previously indicated, the problem is that you made no provision for looping over multiple file elements. You said you wanted to exit if the file doesn't exist, so that means you want
my $found;
for my $file (#{ $data->{file} }) {
if ($file->{path} =~ m{/test-out-00\z}) {
$found = $file;
last;
}
}
die("Test file not found\n") if !$found;
... do something with file data in $found ...