not able to loop through a blessed object - perl

I have an array that results in the following variable with blessed objects inside it. How do I iterate through it to get the name of each variable?
$VAR1 = [
bless( {
'name' => 'apple',
'address' => 'kashmir'
}),
bless( {
'name' => 'mango',
'address' => 'chicago'
})
];
$VAR1 = bless( {
'name' => 'grape',
'address' => 'amsterdam'
});

The [...] indicate that $VAR1 is an array reference, which you dereference with #$VAR1. (Replacing VAR1 with the actual name of the variable, of course. Data::Dumper can't see the actual variable names, so it turns them all into VAR1.) Once you've dereferenced, you can treat it like a normal array, looping over it, pushing, shifting, etc.:
#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
my $VAR1 = [
bless( {
'name' => 'apple',
'address' => 'kashmir'
}),
bless( {
'name' => 'mango',
'address' => 'chicago'
})
];
for my $item (#$VAR1) {
say $item->{name};
}
Output:
apple
mango

Related

Iterate an array reference and convert to hash in perl

I have an hash (Printed by Dumper) which is described below
$VAR1 = {
'items' => [
{
'name' => 'test1',
'id' => '1',
'desc' => 'desc1',
},
{
'name' => 'test2',
'id' => '2',
'desc' => 'desc2',
}
],
};
I need to convert "items" which is array reference to a hash like below. ('items' will be a hash of hash with the value of 'id' being the key)
$VAR1 = {
'items' => {
'1' =>{
'name' => 'test1',
'id' => '1',
'desc' => 'desc1',
},
'2' => {
'name' => 'test2',
'id' => '2',
'desc' => 'desc2',
}
}
};
Lets start with the below code. (Assume $data represents the original data and $newitems represents the modified items)
my $data;
my $items = $data->{items};
my %newitems;
foreach my $element (#$items) {
......
}
This looks like an XY problem to me - I'm guessing you're trying to transform some XML, so I'd suggest you want to look upstream to solve this problem.
But on the offchance you're not, then:
$data -> {items} = { map { $_ -> {id} => $_ } #{$data->{items} } };

Perl DBM::Deep - add/delete in an arrayref of hashrefs

I've been working with DBM::Deep and so far, it's been easy to Read and Update the keys in the DB but when it comes to adding or deleting entities it gets a little complicated and I can't see how it could be done.
I've imported an XML file with XML::Hash and then copied on a DBM::Deep object. So the result is somehow complicated ... The objective of course is to be able to recreate the XML file easily.
So this code:
use DBM::Deep;
use List::Util qw(first);
use Data::Dumper;
my $db = DBM::Deep->new('foo.db');
my $devices = $db->{foo}->{devices}->{device};
(my $match) = grep { $_->{hostname} eq 'myfoo' } #$devices;
print Dumper ($match);
print Dumper($devices);
Gives the following output for the first print:
$VAR1 = bless( {
'enable' => '0',
'hostname' => 'myfoo',
'auth' => 'myauth',
'ip' => 'myip',
'protocol' => 'ssh'
}, 'DBM::Deep::Hash' );
The second print shows:
$VAR1 = bless( [
bless( {
'enable' => '0',
'hostname' => 'myfoo',
'auth' => 'myauth',
'ip' => 'myip',
'protocol' => 'ssh'
}, 'DBM::Deep::Hash' ),
bless( {
'ip' => 'myotherip',
'hostname' => 'myotherfoo',
'auth' => 'myauth',
'protocol' => 'telnet'
}, 'DBM::Deep::Hash' ),
and so on.
Can someone please help me to understand how to Create and Delete in this data structure?

Data::Dumper::Freezer proper usage

I'm trying to log data structures in an old and big Perl project. In order to do so, I use Data::Dumper, however, some structures are a bit too large and spam the log. So I'm looking for a way to log them in a less verbose manner.
Now Dumper's doc mentions $Data::Dumper::Freezer = <method_name> variable that can be used to fix that. I've tried using that.
Adding a serializer method that returns "shortened" value results in nothing, though the method gets called. Making the serializer method act on $_[0] causes the needed effect, but spoils the original data structure.
I'm confused. What am I doing wrong? How can I fix it?
Here's a refined sample code:
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
$Data::Dumper::Indent = 0;
$\="\n";
my $x = Foo->new ( answer => 42, use => "force" );
my $y = { foo => $x };
print "initial plain:\n\t", Dumper( $x );
print "initial compound:\n\t", Dumper( $y );
{
local $Data::Dumper::Freezer = 'freeze_pure';
print "still not abbreviated data:\n\t", Dumper( $y );
};
{
local $Data::Dumper::Freezer = 'freeze_replace';
print "abbreviated data:\n\t", Dumper( $y );
};
print "initial data is still intact:\n\t", Dumper( $x );
print "compound data is corrupted:\n\t", Dumper( $y );
package Foo;
sub new {
my $class = shift;
return bless { #_ }, $class;
};
sub freeze_pure {
my $self = $_[0];
warn "# In freeze_pure";
return bless {
values => join ",", values %$self
}, (ref $self) . "::short";
};
sub freeze_replace {
my $self = $_[0];
warn "# In freeze_replace";
$_[0] = bless {
values => join ",", values %$self
}, (ref $self) . "::short";
return;
};
And output:
initial plain:
$VAR1 = bless( {'use' => 'force','answer' => 42}, 'Foo' );
initial compound:
$VAR1 = {'foo' => bless( {'use' => 'force','answer' => 42}, 'Foo' )};
# In freeze_pure at dumper-freezer.pl line 36.
still not abbreviated data:
$VAR1 = {'foo' => bless( {'use' => 'force','answer' => 42}, 'Foo' )};
# In freeze_replace at dumper-freezer.pl line 42.
abbreviated data:
$VAR1 = {'foo' => bless( {'values' => 'force,42'}, 'Foo::short' )};
initial data is still intact:
$VAR1 = bless( {'use' => 'force','answer' => 42}, 'Foo' );
compound data is corrupted:
$VAR1 = {'foo' => bless( {'values' => 'force,42'}, 'Foo::short' )};
Although the documentation is a bit sparse, the intended use of freezer/toaster is data serialization/de-serialization, not prettification of debugging output.
So, Data::Dumper calls the freezer method, but doesn't use the return value. The idea is probably that if you're going to serialize an object, you won't be messing with it again until you de-serialize it, so there's no problem with changing the object itself.
Here's the relevant section of code from the Data::Dumper source:
# Call the freezer method if it's specified and the object has the
# method. Trap errors and warn() instead of die()ing, like the XS
# implementation.
my $freezer = $s->{freezer};
if ($freezer and UNIVERSAL::can($val, $freezer)) {
eval { $val->$freezer() };
warn "WARNING(Freezer method call failed): $#" if $#;
}
If you just want to reduce the size of the output in your logs, you can remove newlines and indentation by setting $Data::Dumper::Indent to zero:
use Data::Dumper;
use WWW::Mechanize;
$Data::Dumper::Indent = 0;
my $mech = WWW::Mechanize->new;
print Dumper $mech;
Output:
$VAR1 = bless( {'headers' => {},'ssl_opts' => {'verify_hostname' => 1},'forms' => undef,'page_stack' => [],'text' => undef,'requests_redirectable' => ['GET','HEAD','POST'],'timeout' => 180,'onerror' => sub { "DUMMY" },'current_form' => undef,'links' => undef,'max_redirect' => 7,'quiet' => 0,'images' => undef,'noproxy' => 0,'stack_depth' => 8675309,'show_progress' => undef,'protocols_forbidden' => undef,'no_proxy' => [],'handlers' => {'request_prepare' => bless( [{'owner' => 'LWP::UserAgent::cookie_jar','callback' => sub { "DUMMY" },'line' => '/home/foo/perl5/perlbrew/perls/perl-5.16.3/lib/site_perl/5.16.3/LWP/UserAgent.pm:705'}], 'HTTP::Config' ),'response_header' => bless( [{'owner' => 'LWP::UserAgent::parse_head','callback' => sub { "DUMMY" },'m_media_type' => 'html','line' => '/home/foo/perl5/perlbrew/perls/perl-5.16.3/lib/site_perl/5.16.3/LWP/UserAgent.pm:684'}], 'HTTP::Config' ),'response_done' => bless( [{'owner' => 'LWP::UserAgent::cookie_jar','callback' => sub { "DUMMY" },'line' => '/home/foo/perl5/perlbrew/perls/perl-5.16.3/lib/site_perl/5.16.3/LWP/UserAgent.pm:708'}], 'HTTP::Config' )},'onwarn' => sub { "DUMMY" },'protocols_allowed' => undef,'use_eval' => 1,'local_address' => undef,'autocheck' => 1,'title' => undef,'def_headers' => bless( {'user-agent' => 'WWW-Mechanize/1.75'}, 'HTTP::Headers' ),'cookie_jar' => bless( {'COOKIES' => {}}, 'HTTP::Cookies' ),'proxy' => {},'max_size' => undef}, 'WWW::Mechanize' );
This is still a lot of output, but it's certainly more compact than:
$VAR1 = bless( {
'headers' => {},
'ssl_opts' => {
'verify_hostname' => 1
},
'forms' => undef,
'page_stack' => [],
'text' => undef,
'requests_redirectable' => [
'GET',
'HEAD',
'POST'
],
'timeout' => 180,
'onerror' => sub { "DUMMY" },
'current_form' => undef,
'links' => undef,
'max_redirect' => 7,
'quiet' => 0,
'images' => undef,
'noproxy' => 0,
'stack_depth' => 8675309,
'show_progress' => undef,
'protocols_forbidden' => undef,
'no_proxy' => [],
'handlers' => {
'request_prepare' => bless( [
{
'owner' => 'LWP::UserAgent::cookie_jar',
'callback' => sub { "DUMMY" },
'line' => '/home/foo/perl5/perlbrew/perls/perl-5.16.3/lib/site_perl/5.16.3/LWP/UserAgent.pm:705'
}
], 'HTTP::Config' ),
'response_header' => bless( [
{
'owner' => 'LWP::UserAgent::parse_head',
'callback' => sub { "DUMMY" },
'm_media_type' => 'html',
'line' => '/home/foo/perl5/perlbrew/perls/perl-5.16.3/lib/site_perl/5.16.3/LWP/UserAgent.pm:684'
}
], 'HTTP::Config' ),
'response_done' => bless( [
{
'owner' => 'LWP::UserAgent::cookie_jar',
'callback' => sub { "DUMMY" },
'line' => '/home/foo/perl5/perlbrew/perls/perl-5.16.3/lib/site_perl/5.16.3/LWP/UserAgent.pm:708'
}
], 'HTTP::Config' )
},
'onwarn' => sub { "DUMMY" },
'protocols_allowed' => undef,
'use_eval' => 1,
'local_address' => undef,
'autocheck' => 1,
'title' => undef,
'def_headers' => bless( {
'user-agent' => 'WWW-Mechanize/1.75'
}, 'HTTP::Headers' ),
'cookie_jar' => bless( {
'COOKIES' => {}
}, 'HTTP::Cookies' ),
'proxy' => {},
'max_size' => undef
}, 'WWW::Mechanize' );
Alternatively, you could try Data::Dump, which allows you to filter the output using Data::Dump::Filtered. I prefer Data::Dump to Data::Dumper anyway because I think it has more sensible defaults (e.g. outputting escape sequences for whitespace other than spaces).
I haven't used the filtering feature yet, but brian d foy wrote a nice article about it with several examples.

accessing Data::Dumper output

I have this Perl subroutine:
sub ask_for_lease {
my $url = '/sp/api/v1/lease';
my $formdata = '{"classname":"lease",}';
my $c = REST::Client->new();
$c->setHost($wizhost);
$c->PUT (
$url
, $formdata
, $headers
);
my $r = from_json($c->responseContent());
#print Dumper($r);
#my #results = $r->{'results'};
my #items = %{#{$r->{'results'}}[0]}->{'items'};
print Dumper(#items);
for my $item (#items) {
print "=============\n";
print Dumper($item);
print "=============\n";
}
}
It produces this output:
$VAR1 = [
{
'owner' => undef,
'notes' => 'Simulation One',
'version' => undef,
'status' => 'Ready',
'name' => 'One',
'lease' => '7070',
'_oid' => '1'
},
{
'owner' => undef,
'notes' => 'Simulation Two',
'version' => undef,
'status' => 'Ready',
'name' => 'Two',
'lease' => '2',
'_oid' => '2'
},
{
'owner' => undef,
'notes' => 'Simulation Three',
'version' => undef,
'status' => 'Ready',
'name' => 'Three 2012',
'lease' => '3',
'_oid' => '3'
},
...
];
=============
$VAR1 = [
{
'owner' => undef,
'notes' => 'Simulation One',
'version' => undef,
'status' => 'Ready',
'name' => 'One',
'lease' => '7070',
'_oid' => '1'
},
{
'owner' => undef,
'notes' => 'Simulation Two',
'version' => undef,
'status' => 'Ready',
'name' => 'Two',
'lease' => '2',
'_oid' => '2'
},
{
'owner' => undef,
'notes' => 'Simulation Three',
'version' => undef,
'status' => 'Ready',
'name' => 'Three 2012',
'lease' => '3',
'_oid' => '3'
},
...
];
=============
What I want to be able to do is iterate over the items array and print out the status and the name, but I am not sure I am dereferencing $r correctly.
The line
my #items = %{#{$r->{'results'}}[0]}->{'items'}
is very suspicious. You are extracting the first element of the array referred to by $r->{results}, dereferencing that as a hash, and using that hash in reference syntax. You should have got
Using a hash as a reference is deprecated
if you have use strict and use warnings in place as you should.
It is best to extract complex nested data in layers. In this case you can get the reference to the items array into a scalar variable and use that.
my $items= $r->{results}[0]{items};
for my $item ( #$items ) {
printf "name: %s, $item->{name};
printf "status: %s, $item->{status};
print "--\n";
}
If you post your JSON data then we will be able to help much better

How can I update a hash value using a hash reference in Perl?

Is there a way to update a value in a hash using a hash reference that points to the hash value?
My hash output looks like this:
'Alternate' => {
'free' => '27.52',
'primary' => 'false',
'used' => '0.01',
'name' => '/mydir/journal2',
'size' => '50.00'
},
'Primary' => {
'free' => '60.57',
'primary' => 'true',
'used' => '0.06',
'name' => '/mydir/journal',
'size' => '64.00'
}
};
I attempted to create a hash reference to the 'used' property in the hash and tried to update the value:
$hash_ref = \%hash->{"Primary"}->{used};
$hash_ref = "99%";
print $$hash_ref, "\n";
This changes the value of the hash, but I get the "Using a hash as a reference is deprecated at line X". I'd like to know if what I'm trying to do is possible and what I'm doing wrong.
...
'Primary' => {
'free' => '60.57',
'primary' => 'true',
'used' => '0.06',
'name' => '/mydir/journal',
'size' => '64.00'
}
...
Try to bypass the deprecation problem doing it like this:
...
my $hash_ref = $hash{'Primary'}; # if you declared `%hash = ( .. );`
# Or my $hash_ref = $hash->{'Primary'}; if you declared `$hash = { .. };`
print $hash_ref->{used}; # Prints 0.06
$hash_ref->{used} = '0.07'; # Update
print $href->{used}; # Prints 0.07
...
See perldsc, if you want to learn more.
Your failure started because you tried to create a hash reference to a scalar. That's kind of a meaningless goal as those are different data types. As Filippo already demonstrated, you already have hash references as values of your greater hash, so you can rely on that.
However, if you really want to create a reference to the scalar, you can just edit that value. This is how you'd do it:
use strict;
use warnings;
my $h = {
'Alternate' => {
'free' => '27.52',
'primary' => 'false',
'used' => '0.01',
'name' => '/mydir/journal2',
'size' => '50.00',
},
'Primary' => {
'free' => '60.57',
'primary' => 'true',
'used' => '0.06',
'name' => '/mydir/journal',
'size' => '64.00',
}
};
my $primary = $h->{Primary};
print $primary->{used}, "\n"; # Outputs 0.06
my $usedref = \$h->{Primary}{used};
$$usedref = '0.07';
print $primary->{used}, "\n"; # Outputs 0.07