#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;

my %tree=(
          a=>[
              {e=>1,f=>2},
              {g=>3,h=>4,i=>5},
              {j=>6},
             ],
          b=>[
              {k=>1,l=>2,m=>3,n=>4},
              {o=>5,p=>6},
              {q=>7,r=>8,s=>9},
             ],
          c=>[
              {t=>1,u=>2},
             ],
          d=>[
              {v=>1,w=>2,x=>3},
              {y=>4,z=>5},
             ],
          );

print Dumper(\%tree);
print '-'x80,"\n";

my @l=flatten_tree(\%tree,'-');
print "$_->{key} = $_->{value}\n" for(@l);
print '-'x80,"\n";

@l=sort{$b->{value} <=> $a->{value}}@l;
print "$_->{key} = $_->{value}\n" for(@l);
print '-'x80,"\n";

@l=sort{$a->{key} cmp $b->{key}}splice(@l,0,10);
print "$_->{key} = $_->{value}\n" for(@l);
print '-'x80,"\n";

my %restore=restore_tree(@l);
print Dumper(\%restore);

########################################################################
########################################################################

sub flatten_tree
{
  my @l;
  my $ref=shift;
  my $sep=shift || '';
  if($ref)
  {
    return () unless(_flatten_recursive($sep,\@l,$ref,[],[]));
  }
  return @l;
}


sub _flatten_recursive
{
  my $sep=shift;
  my $base=shift;
  my $ref=shift;
  my @types=@{shift()};
  my @path=@{shift()};
  if(defined($ref) && ref($ref) eq 'ARRAY')
  {
    for my $num (0..$#$ref)
    { return 0 unless(_flatten_recursive($sep,$base,$ref->[$num],[@types,'ARRAY'],[@path,$num])); }
  }
  elsif(defined($ref) && ref($ref) eq 'HASH')
  {
    while(my ($key,$val)=each(%$ref))
    { return 0 unless(_flatten_recursive($sep,$base,$val,[@types,'HASH'],[@path,$key])); }
  }
  else
  {
    push(@{$base},{
                    value=>$ref,
                    key=>join($sep,@path),
                    path=>\@path,
                    types=>\@types,
                  });
  }
  return 1;
}

sub restore_tree
{
  my @list=@_;
  if(@list)
  {
    my $ret;
    for my $elm (@list)
    {
      my @path=@{$elm->{path}};
      my @types=@{$elm->{types}};
      my $now;
      while( @path && @types )
      {
        my $key  = shift(@path);
        my $type = shift(@types);

        if($type eq 'ARRAY')
        {
          return () if($key!~/^\d+$/);
          $ret=[] unless($ret);
          $now=\$ret unless($now);

          $now=\$$now->[$key];
        }
        elsif($type eq 'HASH')
        {
          return () unless($key);
          $ret={} unless($ret);
          $now=\$ret unless($now);

          $now=\$$now->{$key};
        }
        else
        { return (); }
      }

      if($now)
      { $$now=$elm->{value}; }
      else
      { return (); }

    }
    return () unless($ret);
    return ref($ret) eq 'ARRAY'?@$ret:%$ret;
  }
}