use strict;
use warnings;

use Data::Dump qw/pp/;

my $tree = {
    Mammal  => {
        Bovine => ["Cow", "Bison"],
        Canine => ["Dog", "Fox", "Wolf"],
        Equine => ["Horse", "Zebra", "Pony"],
    },
    Reptile => {
        Bird   => ["Pigeon", "Canary", "Owl"],
        Lizard => ["Salamander", "Chameleon"],
        Snake  => ["Python", "Cobra"],
    },
};

my %parent;
init_parent($tree,"");

#pp \%parent;


naive([qw/Cobra/],[qw/Fox/]);

naive([qw/Dog Fox Wolf/],[qw/Fox/]);


sub naive {
    my ($a,$b) =@_;
    
    my $h_a = pedigree(@$a);
    my $h_b = pedigree(@$b);

    my %add= %$h_b;
    delete @add{keys %$h_a};

    my %delete= %$h_a;
    delete @delete{keys %$h_b};

    pp [ [keys %add], [keys %delete]];
}


sub pedigree {
    my @children = @_;
    my %nodes;
    @nodes{@children}=();
    
    while (my @parents = @parent{@children} ) {
        #pp \@parents;
        @nodes{@parents}=@children;
        last if exists $nodes{""};
        @children=@parents;
    }
    
    \%nodes; 
}

      

sub init_parent {
    my ($tree,$parent) = @_;
    if (ref $tree eq "HASH") {
        while (my($key,$subtree) =each %$tree) {
            $parent{$key}=$parent;
            init_parent($subtree, $key);
        }
    } elsif (ref $tree eq "ARRAY") {
        for my $leave (@$tree) {
            $parent{$leave} = $parent;
        }
    } else {
        die "Corrupt Tree $tree";
    }
}
[download]