Рекурсивная печать структур данных в Perl

Question

Я сейчас изучаю Perl. У меня есть хэш Perl, который содержит ссылки на хэши и массивы. Хэши и массивы могут, в свою очередь, содержать ссылки на другие хэши / массивы.

Я написал подпрограмму для рекурсивного синтаксического анализа хеша и вывода его с правильным отступом. Хотя рутина работает, как и ожидалось, мой инструктор не был убежден в удобочитаемости и элегантности приведенного ниже кода.

Я был бы очень признателен, чтобы узнать мнение экспертов Perl о возможной оптимизации приведенного ниже кода.

Вот мой полный фрагмент кода ..

# 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
}
#------------------------------------------------------------------

Выход:

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

1. Всегда используйте use strict;
2. Чтобы быть хорошим мальчиком, используйте use warnings.
3. Имена, которые вы используете для подпрограмм, должны четко показывать, что делает подпрограмма. «recurseErrors» отчасти нарушает этот принцип. Да, это рекурсивно. Но что за ошибки?
4. В первой строке каждой подпрограммы вы должны объявить и инициализировать любые параметры. recurseErrors сначала объявляет $ str, а затем объявляет его параметры.
5. Не смешивайте shift и = @_, как вы делаете в str ()
6. Возможно, вы захотите разбить то, что сейчас называется recurseErrors, на специализированные подпрограммы для обработки массивов и хэшей.
7. Нет необходимости заключать переменные в кавычки, как вы делаете это в строках 99 и 109.

Кроме того, я думаю, у вашего инструктора был плохой день в этот день.

Answer 2

возможно Данные :: Дампер - это то, что вы хотите:

use Data::Dumper;

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

Answer 3

Если вы новичок в Perl, я бы порекомендовал запустить ваш код через perl-критик (есть также скрипт, который вы можете установить из CPAN, обычно я использую его как тест, чтобы он запускался из командной строки всякий раз, когда я делаю «сделать тест»). В дополнение к его выводу вы можете захотеть немного разбить ваши функции. У recurseErrors есть три случая, которые можно разбить на подфункции (или даже поместить в хэш ref-type для подфункции ref).

Если бы это была производственная работа, я бы использовал Data :: Dumper , но, похоже, это домашняя работа, поэтому ваш учитель может быть не очень доволен.

Answer 4

Вот один простой пример, почему ваш код не так легко читается:

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

Вы можете использовать оператор defined or:

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

Если вы беспокоитесь о ранних Perls:

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

Условие, выходящее из правого поля, достаточно для отключения, чтобы я не читал остальную часть кода.

Answer 5

Я боролся с этой же проблемой раньше и нашел свой путь здесь. Я почти использовал опубликованное здесь решение, но нашел более подходящее (во всяком случае, для меня). Подробнее о глубине первой рекурсии здесь .

Подпункт в вышеприведенной статье прекрасно работает со ссылкой, содержащей другие хэши, массивы или скаляры. Однако он не печатал имена ключей Hash, поэтому я немного изменил его:

#!/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 @_;
}

Answer 6

Вы могли бы выделить блоки кода, которые имеют дело с массивами, и хэши.

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";

Answer 7

Полагаю, ему не нравится, что ты

1. ожидается хеш в функции str.
2. вызывает ту же функцию для печати массивов, что и хэши, несмотря на то, что между ними нет общей функции.
3. допускают различные способы вызова str, но это никогда не фигурирует в конечном результате.
4. позволяет передавать настраиваемое пространство в корневую функцию, но в рекурсивной функции есть вкладка, жестко закодированная.
5. опустить неопределенные значения, которые на самом деле занимают место в массивах

Это проблемы, которые я вижу, довольно быстро.

Answer 8

    #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 ;