Description: | Answer to this node.
Merges multiple hashes recursively. Usage: $href = mergehashes(\%h1,%h2,%h3); Keys' values are turned into an array ref. Any key that has a single non-ref value will be converted back to a scalar. Dies on circular references. (This is a feature) |
#!/usr/bin/perl -w use warnings; use strict; BEGIN { my %SeenMerged = (); sub mergehashes{ # Dies on circular references my @hashrefs = @_; die "Passed a non hashref" if grep { ref $_ ne 'HASH' } @h +ashrefs; my %merged = (); my @seen = grep { ref $_ eq 'HASH' } @SeenMerged{@hashref +s}; # Break circular links.. if (@seen){ die "contains a circular reference! bailing..."; } @SeenMerged{@hashrefs} = @hashrefs; foreach my $h (@hashrefs){ while (my ($k,$v) = each %$h ){ push @{$merged{$k}}, $v; } } while (my ($k,$v) = each %merged){ my @hashes = grep { ref $_ eq 'HASH' } @$v; $merged{$k} = $v->[0] if (@$v == 1 && !ref $v->[0]); + $merged{$k} = mergehashes(@hashes) if @hashes; } delete @SeenMerged{@hashrefs}; return \%merged; } }
# EXAMPLE use Data::Dumper; my (%hash1,%hash2); %hash1 = ( red => 1, brown => { green => 1, blue => { yellow => 1, }, black => 1, }, gray => 1, ); %hash2 = ( white => 1, brown => { purple => 1, }, ); my $merged = mergehashes(\%hash1, \%hash2 ); print Dumper($merged); __END__ outputs $VAR1 = { 'gray' => 1, 'white' => 1, 'brown' => { 'blue' => { 'yellow' => 1 }, 'purple' => 1, 'green' => 1, 'black' => 1 }, 'red' => 1 };
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Merge Multiple Hashes
by blakem (Monsignor) on Sep 10, 2002 at 18:02 UTC | |
Re: Merge Multiple Hashes
by Anonymous Monk on May 05, 2020 at 21:53 UTC |