Geek Answers Handbook

Recursively print data structures in Perl

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

I wrote a subroutine for hash recursive analysis and printed them with the correct indentation. Although the routine worked as expected, my teacher was not sure of the readability and elegance of the code below.

I would be very happy to receive the opinions of Perl experts on the possible optimization of the code below.

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
+5
8
  • use strict;
  • , use warnings.
  • , , , . "recurseErrors" . , . ?
  • . recurseErrors $str, .
  • shift = @_, str()
  • , recurseErrors, .
  • , , 99 109.

, , .

+8

Data:: Dumper - , :

use Data::Dumper;

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

perl, perl-crit ( script CPAN, , , , "make test" ). , . recurseErrors , ( ref-type ref).

, Data:: Dumper, , , .

+6

, :

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

defined or:

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

Perls:

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

, , , .

+3

, ,

  • str.
  • , , .
  • str, .
  • , , , .
  • undefined ,

, , .

+1

, .

sub recurse{
  ...
  recurse_A(@_) if $ref eq 'ARRAY';
  recurse_H(@_) if $ref eq 'HASH';
  ...
}

sub recurse_A{ ... }
sub recurse_H{ ... }

, , .

sub example{
  my( $one, $two, $three, $optional_four ) = @_;

( , Komodo, , , )

- , .

"$var" eq $var;

, , - , "", .

package My_Class;
use overload
  '""' => 'Stringify',
;
sub new{
  my( $class, $name ) = @_;
  my $self = bless { name => $name }, $class;
  return $self;
}
sub Stringify{
  my( $self ) = @_;
  return $self->{name};
}


my $object = My_Class->new;
my $string = "$object";
+1

I struggled with the same problem before and found my way here. I almost used the solution posted here, but found a more suitable one (for me anyway). Read about Depth First Recursion here .

Sub in the article above works fine with a link containing other hashes, arrays, or scalars. However, it did not print the Hash key names, so I changed it a bit:

#!/usr/bin/perl
#
# See:
#
# http://perldesignpatterns.com/?DepthFirstRecursion
#
use strict;
use warnings;

my %hash = (
  'a' => {
    'one' => 1111,
    'two' => 222,
  },
  'b' => [ 'foo', 'bar' ],
  'c' => 'test',
  'd' => {
    'states' => {
      'virginia' => 'richmond',
      'texas' => 'austin',
    },
    'planets' => [ 'venus','earth','mars' ],
    'constellations' => ['orion','ursa major' ],
    'galaxies' => {
      'milky way' => 'barred spiral',
      'm87' => 'elliptical',
    },
  },
);

&expand_references2(\%hash);

sub expand_references2 {
  my $indenting = -1;
  my $inner; $inner = sub {
    my $ref = $_[0];
    my $key = $_[1];
    $indenting++;
    if(ref $ref eq 'ARRAY'){
      print '  ' x $indenting,'ARRAY:';
      printf("%s\n",($key) ? $key : '');
      $inner->($_) for @{$ref};
    }elsif(ref $ref eq 'HASH'){
      print '  ' x $indenting,'HASH:';
      printf("%s\n",($key) ? $key : '');
      for my $k(sort keys %{$ref}){
        $inner->($ref->{$k},$k);
      }
    }else{
      if($key){
        print '  ' x $indenting,$key,' => ',$ref,"\n";
      }else{
        print '  ' x $indenting,$ref,"\n";
      }
    }
    $indenting--;
  };
  $inner->($_) for @_;
}
+1
source 
    #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 ;
0
source

More articles:


All Articles