#!/usr/bin/perl
use strict; use warnings;
use YAML::XS;
use Benchmark qw(cmpthese);
my $data;
{local $/;$data = <DATA>};

cmpthese( -5, {
        recursive => sub {my $d = Load $data; mergekeys_recursive( $d ); },
        tail_call => sub {my $d = Load $data; mergekeys_tail( $d ); },
        loop => sub {my $d = Load $data; mergekeys_loop( $d ); },
    }
);

sub mergekeys_recursive
{
    my ($ref) = @_;
    my $type = ref $ref;
    if ($type eq 'HASH')
    {
        my $tmphref = $ref->{'<<'};
        if ($tmphref)
        {
            die "Merge key does not support merging non-hashmaps"
                unless (ref $tmphref eq 'HASH');
            my %tmphash = %$tmphref;
            delete $ref->{'<<'};
            %$ref = (%tmphash, %$ref);
        }
        mergekeys_recursive($_) for (values %$ref);
    }
    elsif ($type eq 'ARRAY')
    {
        mergekeys_recursive($_) for (@$ref);
    }
    return $ref;
}

sub mergekeys_tail
{
    my ($ref) = (@_);
    _mergekeys($ref);
    return $ref;
}
sub _mergekeys
{
    my $ref = shift or return;
    my $type = ref $ref;
    if ($type eq 'HASH')
    {
        my $tmphref = $ref->{'<<'};
        if ($tmphref)
        {
            die "Merge key does not support merging non-hashmaps"
                unless (ref $tmphref eq 'HASH');
            my %tmphash = %$tmphref;
            delete $ref->{'<<'};
            %$ref = (%tmphash, %$ref);
        }
        push @_, grep {ref eq 'HASH' or ref eq 'ARRAY'} values %$ref;
    }
    elsif ($type eq 'ARRAY')
    {
        push @_, grep {ref eq 'HASH' or ref eq 'ARRAY'} @$ref;
    }
    goto &_mergekeys;
}

sub mergekeys_loop
{
    my ($orig) = @_;
    while (my $ref = shift)
    {
        my $type = ref $ref;
        if ($type eq 'HASH')
        {
            my $tmphref = $ref->{'<<'};
            if ($tmphref)
            {
                die "Merge key does not support merging non-hashmaps"
                    unless (ref $tmphref eq 'HASH');
                my %tmphash = %$tmphref;
                delete $ref->{'<<'};
                %$ref = (%tmphash, %$ref);
            }
            push @_, grep {ref eq 'HASH' or ref eq 'ARRAY'} values %$ref;
        }
        elsif ($type eq 'ARRAY')
        {
            push @_, grep {ref eq 'HASH' or ref eq 'ARRAY'} @$ref;
        }
    }
    return $orig;
}
__DATA__