perlpal has asked for the wisdom of the Perl Monks concerning the following question:

I have a nested data structure (hash at the top level, then mixture of hashes and arrays at lower levels, arbitrarily deep)

I need to recursively search this data structure for a hash key given the value iff the hash key is a switch.

I have written a sub - routine that accomplishes this to quite some extent but fails in returning keys when the nesting level becomes deeper.

For instance , running the code on the nested hash below results in 

$VAR1 = {
          '-P' => 'hostPassword',
          'alternate_param_options' => [
                                         'all',
                                         'objects',
                                         {
                                           '-H' => [
                                                     'hosting-storage-
+system',
                                                     'vfiler'
                                                   ],
                                           '-S' => [
                                                     'saf'
                                                   ]
                                         },
                                         undef
                                       ],
          'single_switches' => [
                                 '-N'
                               ],
          'mandatory' => [
                           'end'
                         ],
          '-U' => 'hostLogin'
        };

[download]

Output : (switches are not taken as parameters in the logic implemented) 

Param List : hostPassword all objects hosting-storage-system vfiler sa
+f  end hostLogin

Value : hostPassword

Key : -P

Value : all

Key :

Value : objects

Key :

Value : hosting-storage-system

Key :

Value : vfiler

Key :

Value : saf

Key :

Value :

Key :

Value : end

Key :

Value : hostLogin

Key : -U

[download]

I get correct keys for "hostpassword" as "-P" and "hostLogin" as "-U" . The value "all" has no key as "alternate_param_options" is not a switch .

The issue lies with the values "hosting-storage-system" and "vfiler" which should have "-H" as assigned keys ; and "saf" which should have "-S" as assigned key.

The code is mentioned in the link below : 

my $test_hash1 = {
          '-P' => 'hostPassword',
          'single_switches' => [
                                 '-N'
                               ],
          'alternate_param_options' => [
                                         'all',
                                         'objects',
                                         {
                                           '-H' => [
                                                     'hosting-storage-
+system',
                                                     'vfiler'
                                                   ],
                                           '-S' => [
                                                     'saf'
                                                   ]
                                         },
                                         $VAR1->{'alternate_param_opti
+ons'}[2]
                                       ],
          'mandatory' => [
                           'end'
                         ],
          '-U' => 'hostLogin'
        };

print Dumper($test_hash1);

my @param_list = get_param_list ($test_hash1);

print "\nParam List : @param_list\n";


foreach my $element (@param_list){

        print "\nValue : $element\n";

        my $key =  getKeyValue($test_hash1,$element,"HASH");
        print "\nKey : $key\n";


}


sub get_param_list{

        my $_cli_ref = shift;
        my @_param_list;
        my ($_key,$_value,$_element);

        #print ref $_cli_ref,"\n";

        if ((ref $_cli_ref) =~ /.*?HASH.*/i){

                while (($_key,$_value) = each %$_cli_ref){

                        #print "\nKey : $_key\nValue : $_value\n";getc
+();

                        if ($_value =~ /.*?ARRAY.*/i){

                                push (@_param_list,get_param_list($_va
+lue));

                        }elsif($_value =~ /.*?HASH.*/i){

                                push (@_param_list,get_param_list($_va
+lue));

                        }else{

                                push (@_param_list,$_value) if ($_valu
+e !~ /^\-[a-zA-Z]{1}/);

                        }
                }
        }
  if ((ref $_cli_ref) =~ /.*?ARRAY.*/i){

                foreach $_element (@$_cli_ref){

                        #print "\nElement : $_element\n";

                        if ($_element =~ /.*?ARRAY.*/i){

                                push (@_param_list,get_param_list($_el
+ement));

                        }elsif($_element =~ /.*?HASH.*/i){

                                push (@_param_list,get_param_list($_el
+ement));

                        }else{

                                push (@_param_list,$_element) if ($_el
+ement !~ /^\-[a-zA-Z]{1}/);

                        }
                }
        }

        return @_param_list;
}






sub getKeyValue {

        my $_syn_tree = shift;
        my $_value    = shift;
        my $_type     = shift;

        my ($_hkey,$_hvalue);

        my $_key ;
        my $_key1 ;
        my $_found ;

        if ((ref $_syn_tree) =~ /.*?HASH.*/i){

                while(($_hkey,$_hvalue) = each %$_syn_tree){

                        if ($_hvalue  =~ /.*?(HASH).*/i){

                                $_key = getKeyValue($_hvalue,$_value,$
+1);

                        }elsif($_hvalue =~ /.*?(ARRAY).*/i ){

                                $_key1 = $_hkey if($_hkey =~ /\-[a-zA-
+Z]{1}/);

                                $_found = getKeyValue($_hvalue,$_value
+,$1);

                                $_key = $_key1 if ($_found == 1);

                        }elsif($_hvalue eq $_value){

                                $_key = $_hkey if($_hkey =~ /\-[a-zA-Z
+]{1}/);

                        }else{

                        }
                }
        }

 if((ref $_syn_tree) =~ /.*?ARRAY.*/i){

                foreach (@$_syn_tree){

                        if ($_ eq $_value){

                                $_found = 1;

                        }elsif($_ =~ /.*?(ARRAY).*/i){

                                $_found = getKeyValue($_,$_value,$1);

                        }elsif($_ =~ /.*?(HASH).*/i){

                                $_key = getKeyValue($_,$_value,$1);

                        }else{


                        }
                }
        }

        return $_key if ($_type eq "HASH");
        return $_found if ($_type eq "ARRAY");
}

[download]
Seeking advice to enhance my code. Thanks in Advance!

Replies are listed 'Best First'.
Re: Recursive search in nested hash for selective keys
by BioLion (Curate) on Aug 10, 2009 at 10:07 UTC

    Maybe Data::Find would be of use? It will traverse an arbitrary data structure and allows you to define your own 'match' definition :

    Read more... (1036 Bytes)

    Then you can just parse the 'path' to get the data you want from any matching values.

    Hope this helps,

    Just a something something...
[reply]
[d/l]
Re: Recursive search in nested hash for selective keys
by GrandFather (Saint) on Aug 10, 2009 at 23:46 UTC

    As far as I can tell from your description the following does what you want:

    use warnings;
use strict;

my %hash = (
    '-P'                      => 'hostPassword',
    'alternate_param_options' => [
        'all', 'objects',
        {'-H' => ['hosting-storage-system', 'vfiler'], '-S' => ['saf']
+}, undef
        ],
    'single_switches' => ['-N'],
    'mandatory'       => ['end'],
    '-U'              => 'hostLogin'
    );


delve (\%hash);


sub delve {
    my ($ref, $key) = @_;
    
    if ('ARRAY' eq ref $ref) {
        for my $element (@$ref) {
            if ($key) {
                delve ($element, $key); 
            } elsif (ref $element) {
                delve ($element)
            }
        }
        
        return;
    }
    
    if ('HASH' eq ref ($ref)) {
        for my $nestedKey (keys %$ref) {
            my $value = $ref->{$nestedKey};
            
            if ($nestedKey =~ /^-/) {
                delve ($value, $nestedKey)
            } else {
                delve ($value, $key)
            }
        }
        
        return;
    }
    
    return if ref $ref; # Some other reference type - ignore it
    
    if ($key) {
        printf "%22s: %s\n", $ref, $key;
    }
}

    [download]

    Prints:

              hostPassword: -P
hosting-storage-system: -H
                vfiler: -H
                   saf: -S
             hostLogin: -U

    [download]
    True laziness is hard work
[reply]
[d/l]
[select]
      Thank you , this is precisely what i'm looking for. Just wondering where my code went wrong .
[reply]
      I have slightly modified the script to return a hash reference which has keys as the "search parameter value" and values as "the corresponding key of the search parameter".

      If i pass a single hash ref to delve() , the expected output is returned. However, if i pass successive hash refs to delve() , the returned hash ref is a cumulative hash which has key-value pairs from previous function calls too.

      I need the delve function to return the the hash corresponding to input hash and not a cumulative one.

      I tried declaring the return hash with "my" but it does not work as the function is recursive.

      The modified code for delve is mentioned below : 

      sub delve {
    my ($ref, $key) = @_;

    #my $key_val;

    if ('ARRAY' eq ref $ref) {
        for my $element (@$ref) {
            if ($key) {
                delve ($element, $key);
            } elsif (ref $element) {
                delve ($element)
            }
        }

        return ;
    }

    if ('HASH' eq ref ($ref)) {
        for my $nestedKey (keys %$ref) {
            my $value = $ref->{$nestedKey};

             if ($nestedKey =~ /^-|\w/) {
                delve ($value, $nestedKey)
            } else {
                delve ($value, $key)
            }
        }

        return $key_val;
    }

    return if ref $ref; # Some other reference type - ignore it

    if ($key) {
        printf "%22s: %s\n", $ref, $key;

        $key_val->{$ref} = $key;
        return $key_val;

    }
}

      [download]
[reply]
[d/l]

        I'd pass $key_val in as a third parameter (actually the second parameter with $key the last). However, that doesn't seem to be the real problem. I suspect all you need to do is assign an empty hash to $key_val between iterations to clear the previous contents.

        True laziness is hard work
[reply]

Back to Seekers of Perl Wisdom