Recursively printing data structures in Perl

Question

I am currently learning Perl. I have Perl hash that contains references to hashes and arrays. The hashes and arrays may in turn contain references to other hashes/arrays.

I wrote a subroutine to parse the hash recursively and print them with proper indentation. Though the routine works as expected, my instructor was not convinced about the readability and elegance of the below code.

I would really appreciate to get the views of Perl experts here on possible optimization of the below code.

Here is my complete code snippet..

# Array of Arrays
$ref_to_AoA = [
     [ "fred", "barney" ],
     [ "george", "jane", "elroy" ],
     [ "homer", "marge", "bart" ],
];


#Array of Hashes
$ref_to_AoH = [ 
{
   husband  => "barney",
   wife     => "betty",
   son      => "bamm bamm",
},
{
   husband => "george",
   wife    => "jane",
   son     => "elroy",
},
];

# Hash of Hashes
$ref_to_HoH = { 
    flintstones => {
        husband   => "fred",
        pal       => "barney",
    },
    jetsons => {
       husband   => "george",
       wife      => "jane",
       "his boy" => "elroy",  # Key quotes needed.
    },
    simpsons => {
       husband   => "homer",
       wife      => "marge",
       kid       => "bart",
    },
};

# Hash which contains references to arrays and hashes
$finalHash = {
   'arrayofArrays' => $ref_to_AoA,
   'arrayofHash' => $ref_to_AoH,
   'hashofHash' => $ref_to_HoH,
};

$string = str($finalHash); 
print "$string\n";

#------------------------------------------------------------------
sub str {
    my $hash = shift;
    my ($space, $newline, $delimiter) = @_;
    $space = "" unless (defined $space);
    $newline = "\n\n\n" unless (defined $newline);
    $delimiter = "\n--------------------------------------------" unless (defined $delimiter);
    my $str = "";

    for (sort keys %{$hash}) {
        my $value = $hash->{$_};
        $str .= "$newline$space$_ == $value$delimiter";
        $str .= recurseErrors($value,$space);
    }
    $str;
}

#------------------------------------------------------------------
sub recurseErrors {
    my $str;
    my ($value,$space) = @_;
    my $ref = ref $value;

    if ($ref eq 'ARRAY') {
        my $i = 0;
        my $isEmpty = 1;
        my @array = @$value;
        $space .= "\t";
        for my $a (@array) {
            if (defined $a) {
                $isEmpty = 0;
                $str .= "\n$space$_\[$i\] :";
                $str .= recurseErrors($a,$space);
            }
            $i++;
        }
        $str .= "= { }" if ($isEmpty);

    } elsif ($ref eq 'HASH') {
        $space .= "\t";
        for my $k (sort keys %$value) {
            if ( ( ref($value->{$k}) eq 'HASH') || (ref $value->{$k} eq 'ARRAY') ) {
                my $val = $value->{$k};
                $str .= "\n\n$space$k == ";
                $str .= "$val";
            }
            else {
                $str .= "\n$space$k == ";
            }
            $str .= recurseErrors($value->{$k},$space);
      }

      # we have reached a scalar (leaf)
    } elsif ($ref eq '') {
        $str .= "$value";
    }
$str
}
#------------------------------------------------------------------

Output:

arrayofArrays == ARRAY(0x9d9baf8)
--------------------------------------------
    arrayofArrays[0] :
     arrayofArrays[0] :fred
     arrayofArrays[1] :barney
    arrayofArrays[1] :
     arrayofArrays[0] :george
     arrayofArrays[1] :jane
     arrayofArrays[2] :elroy
    arrayofArrays[2] :
     arrayofArrays[0] :homer
     arrayofArrays[1] :marge
     arrayofArrays[2] :bart


arrayofHash == ARRAY(0x9d9bba8)
--------------------------------------------
    arrayofHash[0] :
     husband == barney
     son == bamm bamm
     wife == betty
    arrayofHash[1] :
     husband == george
     son == elroy
     wife == jane


hashofHash == HASH(0x9da45f8)
--------------------------------------------

    flintstones == HASH(0x9d9bb48)
     husband == fred
     pal == barney

    jetsons == HASH(0x9d9bbf8)
     his boy == elroy
     husband == george
     wife == jane

    simpsons == HASH(0x9d9bc48)
     husband == homer
     kid == bart
     wife == marge

Answer 1

maybe Data::Dumper is what you want:

use Data::Dumper;

$str = Dumper($foo);
print($str);

Answer 2

Here is one simple example why your code is not easily readable:

$delimiter = "\n--------------------------------------------" unless (defined $delimiter);

You could use the defined or operator:

$delimiter //= "\n" . '-' x 44;

If you are worried about earlier Perls:

defined $delimeter or $delimeter = "\n" . '-' x 44;

Conditionals going off the right margin are enough of a turn-off for me not to read the rest of the code.

Answer 3

If you are new to perl, I'd recommend running your code through perl-critic (there is also a script you can install from CPAN, normally I use it as a test so it gets run from the command line whenever I do "make test"). In addition to its output, you might want to break up your functions a bit more. recurseErrors has three cases that could be split into sub functions (or even put into a hash of ref-type to sub-function ref).

If this were a production job, I'd use Data::Dumper, but it sounds like this is homework, so your teacher might not be too pleased.

Answer 4

1. Always use use strict;
2. To be a good boy, use use warnings as well.
3. The names you use for subroutines should make it obvious what the subroutine does. "recurseErrors" kind of violates that principle. Yes, it does recurse. But what errors?
4. On the first line of each subroutine you should declare and initialize any parameters. recurseErrors first declares $str and then declares its parameters.
5. Don't mix shift and = @_ like you do in str()
6. You might consider breaking up what is now called recurseErrors into specialized routines for handling arrays and hashes.
7. There's no need to quote variables like you do on lines 99 and 109.

Apart from that I think your instructor had a bad day that day.

Answer 5

My guess is that he doesn't like that you

1. expect a hash in the str function.
2. call the same function to print arrays as hashes, despite that there appears to be no common function between them.
3. allow various ways to call str, but it never figures into the final result.
4. allow configurable space to be passed in to the root function, but have a tab hardcoded in the recursive function.
5. omit undefined values that actually hold a place in the arrays

Those are issues that I can see, pretty quickly.

Answer 6

    #use strict ; 
    use warnings ; 
    # use module
    use XML::Simple;
    use Data::Dumper;

    #debug print "START SCRIPT " ; 

    my $fileToParse = 'C:/Temp/CDIP/scripts/perl/nps_all_workflows.xml' ; 

    # create object
    my $objXml= new XML::Simple;

    # read XML file
    my $data = $objXml->XMLin("$fileToParse");

    # #debug print "\n FirstLevel is " . $objXml->{'POWERMART'} ; 
    my $level = 1 ; 

    #
    printHashKeyValues ($data ) ;  


    sub printHashKeyValues  
    {
        $level ++ ; 
        my $refHash = shift ; 
        my $parentKey = shift ; 
        my $parentValue = shift ; 


        while( my ($key, $value) = each %$refHash) 
        {


                        if ( defined ( $key ) )
                        {
                                if ( ref ($refHash->{"$key"}) eq 'HASH'  ) 
                                 {
                                 my $newRefHash = $refHash->{"$key"} ; 
                                 #debug print " \n The key is a hash " ; 
                                 printHashKeyValues ($newRefHash , $key , $value) ;
                                 }


                                    if ( ref ($refHash->{"$key"}) eq 'ARRAY'  ) 
                                     {
                                            #debug print " \n the key is an ARRAY " ; 
                                            printArrayValues ( $refHash->{"$key"} ) ; 
                                     }


                        } #eof  if ( defined ( $key ))

                        if ( defined ( $value) )
                        {

                                if (  ref ($refHash->{"$value"}) eq 'HASH'  ) 
                                 {
                                 my $newRefHash = $refHash->{"$value"} ; 
                                #debug print " \n The value is a hash " ; 
                                 printHashKeyValues ($newRefHash , $key , $value) ;
                                 }


                                if ( ref ($refHash->{"$value"}) eq 'ARRAY'  ) 
                                 {
                                        #debug print " \n the value is an ARRAY " ; 
                                        printArrayValues ( $refHash->{"$value"} ) ; 
                                 }

                         } #eof if defined ( $value ) 

                                #debug print "\n key: $key, value: $value.\n";


        } #eof while
    } #eof sub 



    sub printArrayValues
    {
        my $arrRef = shift ; 
        my @array = @$arrRef; 
        my $parrentArrayElement = shift ; 

            #debug print "printArrayValues CALLED " ;

        foreach my $arrayElement ( @array ) 
        {
                        if (defined ( $arrayElement ) )
                        {
                                if   ( ref ($arrayElement) eq 'HASH'  ) 
                             {
                                 #debug print " \n The  \$arrayElement is a hash FROM THE ARRAY " ; 
                                 printHashKeyValues ($arrayElement ) ;  
                             } #eof if 

                                if   ( ref ($arrayElement) eq 'ARRAY'  ) 
                             {
                                 #debug print " \n The \$arrayElement is a ARRAY  FROM THE ARRAY " ; 
                                 printArrayValues ($arrayElement ) ;  
                             } #eof if 

                                #debug print "\n \$arrayElement is $arrayElement " ; 
                        } #eof if ( defined ( $arrayElement ) ) 



        } #eof foreach 

    } #eof sub 




    # #debug print output
    ##debug print Dumper($data);




    1 ;