sub do_for_level {
   my ($href, $level, $code) = @_;
   if ($level == 0) {
      %$href = map $code->($_, $href->{$_}), keys %$href if ref $href;
   }
   else {
      map do_for_level($_, $level-1, $code), values %$href;
   }
}

sub flatten_level {
   my ($key, $href) = @_;
   ref $href ? map {$_ => $href->{$_}} keys %$href : ($key, $href);
}

use Data::Dumper;
do_for_level($W, 2, \&flatten_level);
print Dumper($W);
[download]

My inital thoughts: (might update it later)

Change your foreach loop into this:

if (ref $refToHash->{$a} eq 'HASH') 
{
    foreach $b (keys %{$refToHash->{$a}})
    {
        $refToHash->{$b} = $refToHash->{$a}->{$b};
    }
}
delete($refToHash->{$a});
[download]

The problems with your current code:

• You are dereferencing a hash element without checking if the element is a hash referene (use the ref-function)
• You are deleting the original element ($refToHash->{$a}) inside the foreach loop, this is not a good idea...

Note, if you remove the last layer with this code then the previous layer will point to empty hash reference... is that what you want? (add an else statement to the 'if (ref ..)' if it isn't

Thanks for the fast reply. I'm sorry I normally check for hash reference. Can't understand why I didn't here i must have recursion brain ache. Example is the printTree function removed from the original post.

sub printTree
{
    my($a)=shift;
    my(@l);
    
    foreach $b (sort keys %{$a})
    {
        if(ref($a->{$b}) eq 'HASH')        
        {
            $l[$depth]=$b;
            print "@l\n";
            $depth++;
            printTree($a->{$b});
            $depth--;
        }
        else
        {
            $l[$depth]=$b;
            print "@l\n";
        }
    }
}
[download]

my %tree = 
  (
  'x' => 
    {
    'a' => 99,
    'b' => 99,
    'c' => 99,
    }
  'y' => 
    {
    'c' => 99,
    'd' => 99,
    'e' => 99,
    }
  )
[download]

Hi Forsaken real data looks like this

$VAR1 = {                                                  
 'EXCLUSTER01' => {                                        
    'IBFFTDSD72N01A' => {                                  
        'D280_3_TH' => {                                   
             'A' => {                                      
                 'TH_EXCLUSTER01_03' => 999,               
                 'TH_EXCLUSTER01_02' => 999,               
                 'TH_EXCLUSTER01_01' => 999                
                     }                                     
                        }                                  
                         }                                 
  },                                                       

blar 
blar
[download]

It represents the clusters and hosts within a storage array network ie group->hosts->disk arrays->disk controller->volumes. I'm writing a sysadm tool which allows the user to 'drill' into this recursive information. I don't think repetition within the tree is a problem

Ok - new idea. Am I re-inventing the wheel here ? I really want to spend my time focusing on the tool i'm writing not developing and load of recursive functions for tree manipulation. Can anyone suggest a CPAN module that I should consider using ?

use strict;
use warnings;

use Data::Dumper;

my $W={
    'A' => {
        'L' => {
            'D'=>99,
            'X'=>99,
              },
        'C' =>{
            'E'=>99
             },
          }, 
    'X' => {
        'Q'=>{
            'O'=>99,
            },
        'T'=>{
            'U'=>99,
            },
          }, 
    };

remove($W, 2);
print Dumper($W);

sub remove {
    my ($p, $d) = @_;
    if ($d-- > 1) {
        remove($_, ($d)) for values %$p; # Had second decrement here
    }
    else {
        my %newhash;
        for (values %$p) {
            @newhash{keys %$_} = values %$_;
        }
        $_[0] = \%newhash;
    } 
}
[download]

Thanks for all your help. Lots of good stuff here. At the risk of appearing useless I may need some help with code provided by TedPride ( very cool BTW ).

sub remove {
    my ($p, $d) = @_;
    if ($d-- > 1) {
        remove($_, ($d)) for values %$p; # Had second decrement here
    }
    else {
        my %newhash;
        for (values %$p) {
            @newhash{keys %$_} = values %$_;
        }
        $_[0] = \%newhash;
    } 
}
[download]

I've not seen one of these before. It's an hash but it looks like an array ie '@'

for (values %$p) {
            @newhash{keys %$_} = values %$_;
        }
        $_[0] = \%newhash;
[download]

What is going on here then ? Checked out my cookbook etc but can't find a reference to this syntax. One other slight complication is the data can actually look like this;

$W={
    'A' => {
        'L' => {
            'D'=>99,
            'X'=>99,
              },
        'C' =>{
            'E'=>99
             },
          }, 
    'X' => {
        'Q'=>{
            'O'=>99,
            },
        'T'=>{
            'U'=>99,
            },
          }, 
        'W' => 99,
    };
[download]

Now when we collapse level 2 ie LCQT I don't want to change the value for 'W'. So only drop values on the target level if they are HASH. So really it's a mix of H,HOH and HOHOH etc. Thanks again for your help. Jeff

It's a hash slice assignment (in other words, it's not a hash, it is an array). Basically you're saying, here is a list of keys and for each of these keys assign these values (since 'keys' and 'values' return lists). I can't find any particular documentation on it, but it does work :)