Accessing a nested data structure - perl

I have an array of hashes nested to multiple levels. I need to extract a value from all deeply-nested hashes that have a given value for a different key in the same hash
This is a collection of entities from our database, and the data represents contacts within each entity and all of their contact values.
There is a hash key contact_method_type_id which refers to an integer defining the type of contact method. The contact_method_type_id that I care about is 1, which is email.
The first contact has three different contact_methods. The first is 4 which is an office phone, the second is a 2 which is a home phone, and the third is a 1 which is email.
Within the same hash is there is a 'contact_method_value', which is the string representation of their email address.
I need a way to extract just these values into a new array
Here are the contents of the first element of the array
$VAR1 = [
{ 'total' => '2',
'results' => [
{ 'contact_type_name' => 'Primary Technical Contact',
'street' => undef,
'state_id' => undef,
'state_name' => undef,
'last_name' => 'Barb',
'entities' => [
{ 'entity_name' => 'XXXXX',
'entity_id' => 'XXXXX'
}
],
'state_abbr_name' => undef,
'city' => undef,
'country_id' => undef,
'latitude' => undef,
'contact_id' => 'XXXXXX',
'contact_type_id' => '1',
'roles' => [],
'contact_methods' => [
{ 'entity_name' => undef,
'contact_method_value' => 'XXXXXXX',
'contact_method_type_id' => '4',
'contact_method_id' => '24041',
'entity_id' => undef,
'contact_method_type_name' => 'Cell Phone'
},
{ 'entity_name' => undef,
'contact_method_value' => 'XXXXXX',
'contact_method_type_id' => '2',
'contact_method_id' => '24051',
'entity_id' => undef,
'contact_method_type_name' => 'Office Phone'
},
{ 'entity_name' => undef,
'contact_method_value' => 'example#example.com',
'contact_method_type_id' => '1',
'contact_method_id' => '24061',
'entity_id' => undef,
'contact_method_type_name' => 'Email'
}
],
'country_name' => undef,
'longitude' => undef,
'country_abbr_name' => undef,
'full_name' => 'NAME',
'networks' => [
{ 'network_name' => 'NET',
'network_id' => 'X'
}
],
'timezone_id' => undef,
'zip' => undef,
'timezone_name' => undef,
'title' => 'MAC/Network Specialist',
'first_name' => 'Terri'
},
{ 'contact_type_name' => 'Primary Technical Contact',
'street' => 'STREET',
'state_id' => undef,
'state_name' => undef,
'last_name' => 'NAME',
'entities' => [
{ 'entity_name' => 'NAME',
'entity_id' => '2679'
}
],
'state_abbr_name' => undef,
'city' => 'CITY',
'country_id' => undef,
'latitude' => undef,
'contact_id' => '7896',
'contact_type_id' => '1',
'roles' => [],
'contact_methods' => [
{ 'entity_name' => undef,
'contact_method_value' => 'example#example.com',
'contact_method_type_id' => '1',
'contact_method_id' => '16796',
'entity_id' => undef,
'contact_method_type_name' => 'Email'
},
{ 'entity_name' => undef,
'contact_method_value' => 'number',
'contact_method_type_id' => '2',
'contact_method_id' => '16797',
'entity_id' => undef,
'contact_method_type_name' => 'Office Phone'
}
],
'country_name' => undef,
'longitude' => undef,
'country_abbr_name' => undef,
'full_name' => 'NAME',
'networks' => [
{ 'network_name' => 'net',
'network_id' => '17'
}
],
'timezone_id' => undef,
'zip' => 'zip',
'timezone_name' => undef,
'title' => 'Infrastructure Manager',
'first_name' => 'name'
}
],
'offset' => '0'
},
...

This looks suspiciously like something that XML::Simple would have generated.
Assuming this is the case, then I would suggest that you've fallen for the classic mistake of assuming XML::Simple actually helps.
Under that assumption, if you instead use XML::Twig:
Taking your $VAR1. Although - ideally you'll just parse the original source with parse or parsefile:
use XML::Twig;
use XML::Simple;
my $twig = XML::Twig->parse( XMLout($VAR1) );
print $_->att('contact_method_value'), "\n" for $twig->findnodes('//contact_methods[#contact_method_type_name="Email"]');
Which given your sample (as $VAR1):
example#example.com
example#example.com
Edit: Because you've commented that it's JSON then I wouldn't necessarily do this (Although - it does actually work, despite that).

If the data structures are all of the same kind, this is very trivial. You just need to iterate all the outer hashrefs (I called those resultsets). Inside those, you need to look at all results, and in each result you need to look at all the contact methods. If one of them has a contact_method_type_id of 1, you take the contact_method_value. And that's it.
my #email_addresses;
foreach my $resultset ( #{$data} ) {
foreach my $result ( #{ $resultset->{results} } ) {
foreach my $contact ( #{ $result->{contact_methods} } ) {
push #email_addresses , [ $contact->{contact_method_value} ]
if $contact->{contact_method_type_id} == 1;
}
}
}
This code assumes your structure is called $data. #email_addresses looks like this when output.
[
[ 'EMAIL' ],
[ 'EMAIL' ]
];

If you have this on a database then you should use an SQL query to retrieve it, rather than fetching everything into memory and processing what you have
The output from Data::Dumper shows the contents of your data, but it doesn't explain what you're dealing with in your code. Specifically, you don't have a $VAR1 in your code, but I have no idea what you do have
In the end, I think I wouldn't start from here. But since it's the only starting point I have to work with, it's a simple matter of recursing through the data structure
I've assumed that you want
$VAR1->[*]{results}[*]{contact_methods}[*]{contact_method_value}
where
$VAR1->[*]{results}[*]{contact_methods}[*]{contact_method_type_name} eq 'Email'
Update
Since your comments I've altered my code to select the same values where
$VAR1->[*]{results}[*]{contact_methods}[*]{contact_method_type_id} == 1
Since you said nothing about your code at all, I've had to assume a variable $data which contains a reference to the array that you show in your question
for my $item ( #$data ) {
my $results = $item->{results};
for my $result ( #$results ) {
my $methods = $result->{contact_methods} or die;
for my $method ( #$methods ) {
#my $type_name = $method->{contact_method_type_name};
#next unless $type_name eq 'Email';
my $type_id = $method->{contact_method_type_id};
next unless $type_id == 1; ## Email
my $value = $method->{contact_method_value};
print "$value\n";
}
}
}
output
example#example.com
example#example.com

Related

Perl extracting data from a hash

I am trying to extract data from a hash value.
my $triggers = $zabbix->raw('trigger','get', $options);
print Dumper($triggers);
foreach my $trigger (#{$triggers} )
{
push #triggerid,$trigger->{'triggerid'};
my #t=$trigger->{'hosts'};
my $lt = localtime($trigger->{'lastchange'});
print "$trigger->{'description'} $lt \n";
}
Output of Dumper is
[
{
'hosts' => [
{
'hostid' => '19914',
'host' => 'pc10bcf18.syd.sf.priv'
}
],
'priority' => '2',
'status' => '0',
'templateid' => '10652913',
'comments' => '',
'state' => '0',
'triggerid' => '10653191',
'expression' => '{15070357}#1',
'error' => '',
'url' => '',
'flags' => '0',
'value' => '1',
'name' => 'pc10_BizX_A_CF',
'description' => 'pc10bcf18.syd.sf.priv: Core Path not \'/dumps/java/core\' (Path=/export/home/jboss/j...)',
'value_flags' => '0',
'lastchange' => '1429181103',
'type' => '0'
},
]
From my above code, i was able to print 'description'. How do i access and print the value of 'host' value?
To maintain the for / push pattern that you have already coded, you can write this
my $triggers = $zabbix->raw('trigger', 'get', $options);
my #triggerid;
for my $trigger ( #$triggers ) {
push #triggerid, $trigger->{triggerid};
my #hosts;
my $hosts = $trigger->{hosts};
for my $host ( #$hosts ) {
push #hosts, $host->{host};
}
my $lt = localtime($trigger->{lastchange});
print "$trigger->{description} $lt\n";
}
Looks like there can be more than one host, so
my #hosts =
map { $_->{host} }
#{ $trigger->{hosts} };
To get the first one (assuming there will always be at least one),
my $first_host = $trigger->{hosts}[0]{host};
$triggers->{'hosts'}->[0]->{'host'}

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 to access array of hashes?

Hi i have an array of hashes as below, i want access hash element/elements. Say suppose i want to print doct1's name, i am not getting right result please help me how do i print that?
#doctors = (
'doct1' => {
'name' => 'abcd',
'specialization' => 'xyz',
'city' => 'pqr'
},
'doct2' => {
'name' => 'efgh',
'specialization' => 'mno',
'city' => 'stu'
}
);
print $doctors[0]{'name'};
Arrays don't have keys,
my #doctors = (
{
'name' => 'abcd',
'specialization' => 'xyz',
'city' => 'pqr'
},
{
'name' => 'efgh',
'specialization' => 'mno',
'city' => 'stu'
}
);
print $doctors[0]{'name'};
You don't have an AoH. You have an array containing both strings and references to hashes. This is a very poor data structure. It's messy and inefficient to locate the correct doctor.
my $i = 0;
$i += 2 while $i<#doctors && $doctors[$i] ne 'doct1';
die "Not found" if $i > #doctors;
say $doctors[$i+1]{name};
If you had an AoH as you say, it you look something like this:
my #doctors = (
{
id => 'doct1',
name => 'abcd',
specialization => 'xyz',
city => 'pqr',
},
{
id => 'doct2',
name => 'efgh',
specialization => 'mno',
city => 'stu',
},
);
That would be better.
my ($doctor) = grep { $_->{id} eq 'doct1' } #doctors
or die "Not found";
say $doctor->{name};
It's also possible that doct1 and doct2 are meaningless, and that you'd be happy using 0 and 1 instead. If so,
die "Not found" if #doctors < 0;
say $doctors[0]{name};
If doct1 and doct2 aren't meaningless, then the cleanest and most efficient solution would be to use an HoH.
my %doctors = (
doct1 => {
name => 'abcd',
specialization => 'xyz',
city => 'pqr',
},
doct2 => {
name => 'efgh',
specialization => 'mno',
city => 'stu',
},
);
The code would then be the simple:
my $doctor = $doctors{doct1}
or die "Not found";
say $doctor->{name};
This is a situation where using Data::Dumper is essential, what you actually have is an array of two strings and two hashrefs. If you were to print it out with Data::Dumper you would see this:
use Data::Dumper;
print Dumper \#doctors;
[
'doct1',
{
'city' => 'pqr',
'specialization' => 'xyz',
'name' => 'abcd'
},
'doct2',
{
'city' => 'stu',
'specialization' => 'mno',
'name' => 'efgh'
}
];
Each hashref has all the data that represents a doctor, the additional key at the front doesn't make any sense. Remove those keys and you will have a structure like this:
#doctors = (
{
'name' => 'abcd',
'specialization' => 'xyz',
'city' => 'pqr'
},
{
'name' => 'efgh',
'specialization' => 'mno',
'city' => 'stu'
}
);
and now you can access the hash attributes like you would expect:
print $doctors[0]{name};
The right hand declaration is not very consistent (in intention) with the assignment to an array. You'd probably want to assign it to a hash instead:
%doctors = (
'doct1' => {
'name' => 'abcd',
'specialization' => 'xyz',
'city' => 'pqr'
},
'doct2' => {
'name' => 'efgh',
'specialization' => 'mno',
'city' => 'stu'
}
);
print $doctors{'doct1'}->{'name'};
Either this or, mpapec's answer.

strange bug accessing a variable in template toolkit

I'm struggling with a bug, that I can't nail down.
I have a function that takes a postcode, does a lookup, and returns a latitude, longitude and area name.
for example, pass it AD300 it returns (something like) 42.6, 1.55, ordino - it works very well.
The function is called like this:
my ($lat, $lng, $area) = $object->release();
The return values are fine, and I can print them in perl with a warn
warn "Area $area, $rellat, $rellng";
This works fine. "Area Ordino, 42.6, 1.55"
I then take one of these values, say $area, add it to a hash of data, and pass it to a web page where it is preprocessed via TT (as I do successfully with a load of other variables).
I'm assigning the value to the hash in the normal way. e.g.
$hash->{'area'} = $area;
Here is where the fun begins. When I try to reference the value in TT e.g. [% hash.area %]
I don't get "Ordino" printed on the web page, I'm told I've passed an Array reference to TT.
After a little debugging, I've found that my hash variable hash.area, is somehow referencing an array (according to TT) holding the three values that I've returned from the subroutine "release". I.e.
hash.area = [42.6, 1.55, ordino] according to TT.
That is, to get the value "Ordino" within the web page, I have to access [% hash.area.2 %].
Further, I can set $hash->{'area'} to equal any of the variables, $lat, $lng, or $area and get the same behavior. TT believes all three variables reference the same array. that is
$lat = $lng = $area = [42.6, 1.55, ordino] according to TT
This is bizare, I can happily print the variables in perl and they appears as normal - not an array. I've tried dumping the hash with dumper, no array, everything is fine. Yet somehow, TT is finding an array. It's doing my head in.
The site is quite large, with a lot of pages and I happily pass variables and hashes via TT to web pages all the time, and have been for 4 years now. I've never seen this. On other pages, I even pass exactly the same output from the "release" method and it is processed correctly.
I don't think my TT processing code is the problem, however the following is relevant.
my $tt = Template->new({
INCLUDE_PATH => [ #$template_directories ],
COMPILE_EXT => '.ttc',
COMPILE_DIR => '/tmp/ttc',
FILTERS => YMGN::View->filters,
PLUGIN_BASE => [ 'YMGN::V::TT::Plugins' ],
EVAL_PERL => 1
});
$self->{tt} = $tt;
$self->{template_directories} = $template_directories;
$self->{output} = $params->{output} || undef;
$self->{data} = $params->{data} || [];
The above creates a new tt object and is part of the "new" function (refed below).
"data" contains the hash. "output" holds the processed template ready to send to users browser. We call new (above), process the data and create the output with the code below.
sub process {
my $self = shift;
my $params = shift;
if (!ref $self || !exists $self->{tt}) {
my $class = $self;
$self = $class->new($params);
}
if (!$self->{output}) {
die "You need to specify output";
}
delete $self->{error};
$self->y->utils->untaint(\$self->{template});
my $rv = $self->{tt}->process(
$self->{template},
$self->{data},
$self->{output},
binmode => ':utf8',
);
if (!$rv) {
warn $self->{tt}->error();
return {
error => $self->{tt}->error(),
};
}
return 0;
}
All of the above is sanitised because there is a lot of other stuff going on.
I believe what's important is that the data going in looks correct, here is a full dump of the complete data that is being processed by tt (at the point of processing). The thing that is causing the problem is bubbles->[*]->{'release'} (note, that release == area in the data. The name was changed for unrelated reasons). As you can see, dumper thinks it's a string. TT deals with everything else fine.
data $VAR1 = {
'system' => {
system stuff
},
'features' => {
site feature config
},
'message_count' => '0',
'bubbles' => [
bless( {
'history' => [
{
'creator' => '73',
'points' => '10',
'screenname' => 'sarah10',
'classname' => 'Flootit::M::Bubbles',
'id' => '1378',
'updated' => '1352050471',
'type' => 'teleport',
'label' => 'teleport',
'class' => 'Flootit::M::Bubbles'
}
],
'creator' => '6',
'release' => 'Escaldes-Engordany',
'image' => 'http://six.flooting.com/files/833/7888.png',
'pop_time' => '1352050644',
'y' => $VAR1->{'y'},
'taken_by' => '0',
'city' => '3',
'title' => 'hey a new bubble',
'id' => '566',
'class' => 'Flootit::M::Bubbles',
'prize' => 'go for it kids'
}, 'Flootit::M::Bubbles' ),
bless( {
'history' => [
{
'creator' => '6',
'points' => '10',
'screenname' => 'sarah20',
'classname' => 'Flootit::M::Bubbles',
'id' => '1723',
'updated' => '1349548017',
'type' => 'teleport',
'label' => 'teleport',
'class' => 'Flootit::M::Bubbles'
},
{
'creator' => '6',
'points' => '5',
'screenname' => 'sarah20',
'classname' => 'Flootit::M::Bubbles',
'id' => '1732',
'updated' => '1349547952',
'type' => 'blow',
'label' => 'blow',
'class' => 'Flootit::M::Bubbles'
}
],
'creator' => '89',
'release' => 'Ordino',
'image' => 'http://six.flooting.com/files/1651/8035.png',
'pop_time' => '1351203843',
'y' => $VAR1->{'y'},
'taken_by' => '0',
'city' => '3',
'title' => 'test4',
'id' => '1780',
'class' => 'Flootit::M::Bubbles',
'prize' => 'asdfasdf dsadsasdfasdfasdf'
}, 'Flootit::M::Bubbles' ),
bless( {
'history' => [],
'creator' => '6',
'release' => 'Andorra la Vella',
'image' => 'http://six.flooting.com/files/1671/8042.png',
'pop_time' => '0',
'y' => $VAR1->{'y'},
'taken_by' => '0',
'city' => '3',
'title' => 'Pretty flowers, tres joli',
'id' => '1797',
'class' => 'Flootit::M::Bubbles',
'prize' => 'With lots of pretty pictures'
}, 'Flootit::M::Bubbles' ),
bless( {
'history' => [],
'creator' => '6',
'release' => 'Hillrise Ward',
'image' => 'http://six.flooting.com/files/1509/8003.png',
'pop_time' => '0',
'y' => $VAR1->{'y'},
'taken_by' => '0',
'city' => '3',
'title' => 'Test beats',
'id' => '1546',
'class' => 'Flootit::M::Bubbles',
'prize' => 'Sound great'
}, 'Flootit::M::Bubbles' )
]
};
What comes out after processing is this (in $output)
There is a
[% FOREACH floot IN bubbles %]
Floating around ARRAY(0xfaf5d448). from [% floot.release %]
if we make this [% floot.release.2 %] it gives the correct value.
All the other fields can be referenced correctly - go figure.
The code that puts "bubbles" together is;
my $bubbles = $y->model('Bubbles')->search(['type' => 'golden', 'image' => '!NULL',
'bubble_prizes' => ['p', { 'p.bubble' => 'self.id'}], ], {
order_by => '(created>CURRENT_DATE() AND thumbsup+thumbsdown<10) DESC, COALESCE(thumbsup,0)-COALESCE(thumbsdown,0) DESC, pop_time DESC',
count => 10,
fields => ['p.title as title', 'p.prize as prize', 'city', 'taken_by', 'pop_time', 'id', 'creator'],
});
for (my $i=0; $i<#$bubbles; $i++) {
# Find specified bubbles (see below for when not found here)
my ($rellat, $rellng, $area) = $bubbles->[$i]->release() ;
$bubbles->[$i]->{'release'} = $area;
}
}
The controller then takes $bubble, bundles it up with session / site data, puts it inside an anonymous hash (as you can see in the data above) and passes it to view for processing.
The code for release is :
sub release {
my $self = shift;
my $postcode = $self->y->model('Prizes')->find({bubble => $self->id})->postcode;
my ( $user_lat, $user_long, $region_name );
if($postcode)
{
( $user_lat, $user_long, $region_name ) = $self->y->api('Location')->from_postcode($postcode);
return ( $user_lat, $user_long, $region_name );
}
}
API::Location is quite large, however the relevant lines are;
$postcode_record = $self->y->model('GeoData')->find( {
source => "ALL_COUNTRIES_POSTCODES",
country => $country_code,
sourceid => $postcode, } );
return ( $postcode_record->latitude, $postcode_record->longitude, $postcode_record->town );
The data dumps I've shown you are taken from inside TT.pm (part of view).
So, any ideas what might be going on or where to start? What can I do to try and debug this further? I'm out of ideas.
Maybe it's because $area is a blessed object; Try this to convert to a scalar string :
$string = ''.$area;
# e.g.
$hash->{'area'} = ''.$area;
Following #Moritz comment, to check that $area is blessed:
print ref($area);
use Data::Dumper; warn Dumper($area);
And q{""} overloaded:
print defined ${ref($area).'::'}{'(""'};
EDIT
sub release can return
- undef if $postcode evaluate to false
- a list but as it is used in as scalar context returns the last argument $region_name like parenthesized list (comma expression)
sub release {
my $self = shift;
my $postcode = $self->y->model('Prizes')->find({bubble => $self->id})->postcode;
my ( $user_lat, $user_long, $region_name );
if($postcode)
{
( $user_lat, $user_long, $region_name ) = $self->y->api('Location')->from_postcode($postcode);
return ( $user_lat, $user_long, $region_name );
}
}
It will be relevant to Dump $region_name or $area, or to look at from_postcode.
I found that the problem went away on other development servers and the production server.
I therefore tried uninstalling and reinstalling TT, however that didn't help.
As it appears it's an environment issue on my dev server, so I am retiring the box and starting a new one.

Combining 2+ 'deep' (multi-dimensional) hashes in perl

There is a question that explains exactly what I want here: how to merge 2 deep hashes in perl
However, the answer there does not seem to work for me (suggestions of using the Merge module).
I have two hashes like so:
$VAR1 = {
'57494' => {
'name' => 'John Smith',
'age' => '9',
'height' => '120'
},
'57495' => {
'name' => 'Amy Pond',
'age' => '17',
'height' => '168'
}
}
};
$VAR1 = {
'57494' => {
'name_address' => 'Peter Smith',
'address' => '5 Cambridge Road',
'post_code' => 'CR5 0FS'
}
}
};
If I use Hash::Merge or the %c = {%a,%b} format I get this every time:
$VAR1 = '57494';
$VAR2 = {
'name_address' => 'Peter Smith',
'address' => '5 Cambridge Road',
'post_code' => 'CR5 0FS'
};
(so it basically overwrote the first data with the second and messed up the keys) when I want:
$VAR1 = {
'57494' => {
'name' => 'John Smith',
'age' => '9',
'height' => '120'
'name_address' => 'Peter Smith',
'address' => '5 Cambridge Road',
'post_code' => 'CR5 0FS'
},
'57495' => {
'name' => 'Amy Pond',
'age' => '17',
'height' => '168'
}
}
};
So when the keys are the same, the data merges together, otherwise the new keys are just appended onto the end. I hope this make sense. Maybe I've done something incorrectly using Merge or need to 'manually' add them in loops, but I'm spending too much time thinking about it, regardless!
Edit: how I use Merge to see if I'm doing something silly:
I have:
use Hash::Merge qw( merge );
...hash data above as %hash1 and %hash2...
my %combined_hash = %{ merge( %hash1,%hash2 ) };
print Dumper(%combined_hash);
If I do it with references, it works like a charm.
use strict; use warnings;
use Data::Dumper;
use Hash::Merge qw(merge);
my $h1 = {
'57494' => {
'name' => 'John Smith',
'age' => '9',
'height' => '120'
},
'57495' => {
'name' => 'Amy Pond',
'age' => '17',
'height' => '168'
}
};
my $h2 = {
'57494' => {
'name_address' => 'Peter Smith',
'address' => '5 Cambridge Road',
'post_code' => 'CR5 0FS'
}
};
my $h3 = merge( $h1, $h2 );
print Dumper $h3;
Output:
$VAR1 = {
'57495' => {
'name' => 'Amy Pond',
'age' => '17',
'height' => '168'
},
'57494' => {
'name_address' => 'Peter Smith',
'name' => 'John Smith',
'post_code' => 'CR5 0FS',
'address' => '5 Cambridge Road',
'height' => '120',
'age' => '9'
}
};
If, however, I do it with hashes instead of hash refs, it doesn't:
my %hash1 = (
'57494' => {
'name' => 'John Smith',
'age' => '9',
'height' => '120'
},
'57495' => {
'name' => 'Amy Pond',
'age' => '17',
'height' => '168'
}
);
my %hash2 = (
'57494' => {
'name_address' => 'Peter Smith',
'address' => '5 Cambridge Road',
'post_code' => 'CR5 0FS'
}
);
my %h3 = merge( %hash1, %hash2 );
print Dumper \%h3;
__END__
$VAR1 = {
'57495' => undef
};
That is because the merge from Hash::Merge can only take references, but you are passing it hashes. In addition, you need to call it in scalar context.
Try it like so:
# +--------+--- references
# ,-- SCALAR context | |
my $combined_hash = %{ merge( \%hash1, \%hash2 ) };
print Dumper($combined_hash);
for my $key (keys %fromhash) {
if(not exists $tohash{$key}) {
$tohash{$key} = {};
}
for my $subkey (keys %{$fromhash{$key}}) {
${$tohash{$key}}{$subkey} = ${$fromhash{$key}}{$subkey};
}
}
With more or less braces depending on whether my last coffee was any good.
Python is definitely more comfortable for this kind of thing, because it doesn't make you think about references:
for key in fromdict:
if key not in todict:
todict[key] = {}
todict[key] = dict(fromdict[key].items() + todict[key].items())
Or if todict is a defaultdict (creating keys on read as well as assignment):
for key in fromdict:
todict[key] = dict(dict(fromdict[key]).items() + dict(todict[key]).items())