#!/usr/bin/perl
use strict;
use warnings;
use YAML::XS;
use Data::Dumper;

my $data;
{local $/;$data = <>};

sub mergekeys
{   
    return _mergekeys($_[0], []);
}

sub _mergekeys
{   
    my $ref = shift;
    my $resolveStack = shift; 
    my $reftype = ref $ref;

    # If this hash or array is already on the resolution stack, then somewhere, a child data structure is trying to inherit from one of its parents,
    # and hence by extension trying to inherit itself.
    if ($reftype =~ /HASH|ARRAY/ and (grep $_ == $ref, @$resolveStack) > 0)
    {   
        # Halt and catch fire, or store the cyclic reference and not process it further. Not complaining seems to
        # be the behaviour of ruby's YAML parser, so let's go for that.

        #die "Cyclic inheritance detected: ".($ref)." is already on the resolution stack!\n" .
        #    "Dump of cyclic data structure (may have inheritance already partially resolved):\n".Dumper($ref);
        return $ref;
    }
    
    if (ref($ref) eq 'HASH')
    {   
        push @$resolveStack, $ref;
        if (exists $ref->{'<<'})
        {   
            my $inherits = $ref->{'<<'}; # can be either a single href, or an array of hrefs
            die "Undefined value for merge key '<<' in ".Dumper($ref) unless defined $inherits; # catch edge cases that YAML::XS won't catch, like "<<: &foo"
            die "Merge key does not support merging non-hashmaps" unless ref($inherits) =~ /HASH|ARRAY/;
            $inherits = [$inherits] if ref($inherits) eq 'HASH'; # normalize for further processing

            # For each of the hashes/arrays we're inheriting, have them resolve their inheritance first before applying them onto ourselves.
            # Also, remove the '<<' reference only afterwards, since by recursion these will have already been removed from our inheritees,                                                                                                   # and this also allows us to show the cyclic reference by dumping out the structure when we detect one.
            foreach my $inherit (@$inherits)
            {   
                $inherit = _mergekeys($inherit, $resolveStack);
                %$ref = (%$inherit, %$ref);
            }
            delete $ref->{'<<'};
        }

        _mergekeys($_, $resolveStack) for (values %$ref);
        die "Fatal error: imbalanced recursion stack in _mergekeys. This likely implies a programming error and/or a YAML file from hell." unless pop(@$resolveStack) eq $ref;
    }
    elsif (ref($ref) eq 'ARRAY')
    {   
        push @$resolveStack, $ref;
        _mergekeys($_, $resolveStack) for (@$ref);
        die "Fatal error: imbalanced recursion stack in _mergekeys. This likely implies a programming error and/or a YAML file from hell." unless pop(@$resolveStack) eq $ref;
    }

    return $ref;

}

my $yml = Load($data);
mergekeys $yml;
print Dumper $yml;

##</code><code>##

---
key0: &id00
  zero:   0
key1: &id01
  <<: *id00
  subkey_a: asdf
  subkey_b: qwer
  Z:   "key1.Z"
key2: &id02
  everyday: apple
  X:   1
  Y:   2
  Z:   "key2.Z"
  A:
    - <<: *id00
      zero:  "00"
    - <<: *id01
    - <<: *id02   #cycle!
      everyday: shuffling
      Y:        3000
  <<:  *id00
key3: &id03
  <<: [*id01, *id02, *id01]
  subkey_a: foo
  subkey_c: bar
  deeper:
    challenger:   deep
    <<:           *id00

##</code><code>##

$ perl merge_keys.pl cyclic_test2.yml 
$VAR1 = {
          'key2' => {
                      'everyday' => 'apple',
                      'Z' => 'key2.Z',
                      'A' => [
                               {
                                 'zero' => '00'
                               },
                               {
                                 'Z' => 'key1.Z',
                                 'subkey_b' => 'qwer',
                                 'subkey_a' => 'asdf',
                                 'zero' => 0
                               },
                               {
                                 'A' => $VAR1->{'key2'}{'A'},
                                 'Z' => 'key2.Z',
                                 'everyday' => 'shuffling',
                                 'X' => 1,
                                 'zero' => 0,
                                 'Y' => 3000
                               }
                             ],
                      'X' => 1,
                      'zero' => 0,
                      'Y' => 2
                    },
          'key1' => {
                      'subkey_b' => 'qwer',
                      'Z' => 'key1.Z',
                      'subkey_a' => 'asdf',
                      'zero' => 0
                    },
          'key0' => {
                      'zero' => 0
                    },
          'key3' => {
                      'A' => $VAR1->{'key2'}{'A'},
                      'subkey_b' => 'qwer',
                      'subkey_a' => 'foo',
                      'X' => 1,
                      'Y' => 2,
                      'everyday' => 'apple',
                      'Z' => 'key1.Z',
                      'subkey_c' => 'bar',
                      'zero' => 0,
                      'deeper' => {
                                    'challenger' => 'deep',
                                    'zero' => 0
                                  }
                    }
        };

##</code><code>##

$ ruby -ryaml -rpp -e 'x = YAML.load_file("cyclic_test2.yml"); print PP.pp(x);'
{"key0"=>{"zero"=>0},
 "key1"=>{"zero"=>0, "subkey_a"=>"asdf", "subkey_b"=>"qwer", "Z"=>"key1.Z"},
 "key2"=>
  {"everyday"=>"apple",
   "X"=>1,
   "Y"=>2,
   "Z"=>"key2.Z",
   "A"=>
    [{"zero"=>"00"},
     {"zero"=>0, "subkey_a"=>"asdf", "subkey_b"=>"qwer", "Z"=>"key1.Z"},
     {"everyday"=>"shuffling", "X"=>1, "Y"=>3000, "Z"=>"key2.Z"}],
   "zero"=>0},
 "key3"=>
  {"zero"=>0,
   "subkey_a"=>"foo",
   "subkey_b"=>"qwer",
   "Z"=>"key1.Z",
   "everyday"=>"apple",
   "X"=>1,
   "Y"=>2,
   "A"=>
    [{"zero"=>"00"},
     {"zero"=>0, "subkey_a"=>"asdf", "subkey_b"=>"qwer", "Z"=>"key1.Z"},
     {"everyday"=>"shuffling", "X"=>1, "Y"=>3000, "Z"=>"key2.Z"}],
   "subkey_c"=>"bar",
   "deeper"=>{"challenger"=>"deep", "zero"=>0}}}