Удаление пустых и одноэлементных ссылок на массивы из сложной структуры данных Perl

Я пытаюсь привести в порядок большую структуру данных в Perl, которая была прочитана из JSON. Два стереотипных элемента выглядят так (в JSON):

[
    [ [ {'payload':'test'} ], [ [ {'payload':'reply'} ], [] ] ],
    [ [ {'payload':'another thread'} ] 
]

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

[
    [ {'payload':'test'}, [ {'payload':'reply'} ] ],
    [ {'payload':'another thread'} ]
]

В настоящее время мой код выглядит следующим образом:

use v5.12;
use strict;
use warnings;
use JSON::XS;
use Data::Walk;

sub cleanup {
    if (ref $_ eq 'ARRAY') {
        if (scalar(@{$_}) == 0) {
            die 'mysteriously I never reach this branch!';
            while (my ($key,$value) = each @{$Data::Walk::container}) {
                if ($value == $_) {
                    delete ${$Data::Walk::container}[$key]
                }
            }
        } elsif (scalar(@{$_}) == 1 and ref @{$_}[0]) {
            $_ = @{$_}[0];
        } else {
            my $tail = ${$_}[scalar(@{$_})-1];
            if (ref $tail eq 'ARRAY' and scalar(@{$tail}) == 0) {
                $#{$_}--;
            }
        }
    }
}

sub get {
    my $begin = shift;
    $begin = 0 unless $begin;
    my $end = shift();
    $end = $begin + 25 unless $end;
    my $threads;
    {
        local $/;
        open(my $f, '<emails.json');
        $threads = decode_json <$f>;
        close($f);
    }
    $threads = [ @{$threads}[$begin .. $end] ];
    walkdepth(\&eliminate_singleton, $threads);
    return $threads;
}

print JSON::XS->new->ascii->pretty->encode(&get('subject:joke'));

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


person mmirate    schedule 26.06.2012    source источник
comment
+1 за хороший вопрос. Вам следует называть себя Hedgepruner. ;-)   -  person simbabque    schedule 26.06.2012
comment
Было бы очень полезно, если бы вы разместили программу, которая демонстрирует проблему. В его нынешнем виде код запускает программу notmuch с запросом subject:joke для генерации данных JSON. Эти вещи несущественны для проблемы и неизвестны людям, которые пытаются вам помочь, и требуется значительный объем работы, чтобы разобрать ваш код и отличить соответствующие части от нерелевантных. Хорошо, что вы показали некоторые данные, но в настоящее время это недопустимый JSON, и нетривиально увидеть, как его использовать в вашей программе. В результате очень мало ответов.   -  person Borodin    schedule 26.06.2012


Ответы (1)


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

So

[
  "data1",
  [],
  "data3",
]

конвертируется в

[
  "data1",
  "data3",
]

а также

{
  "key1" : ["val1", "val2"],
  "key2" : ["val3"],
  "key3" : ["val4", "val5"],
}

конвертируется в

{
  "key1" : ["val1", "val2"],
  "key2" : "val3",
  "key3" : ["val4", "val5"],
}

В вашей программе последнее соответствует тому, что "tags" : ["inbox"] становится "tags" : "inbox".

Если это так, то эта версия eliminate_singleton делает то, что вы хотите.

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

use Scalar::Util 'reftype';

sub eliminate_singleton {

  my $node = $_;
  my $type = reftype $node // '';

  if ($type eq 'ARRAY') {
    for (my $i = $#$node; $i >= 0; $i--) {
      my $subnode = $node->[$i];
      my $subtype = reftype($subnode) // '';
      delete $node->[$i] if $subtype eq 'ARRAY' and @$subnode == 0;
    }
  }
  elsif ($type eq 'HASH') {
    for my $k (keys %$node) {
      my $subnode = $node->{$k};
      my $subtype = reftype($subnode) // '';
      if ($subtype eq 'ARRAY' and @$subnode == 1) {
        $node->{$k} = $node->{$k}[0];
      };
    }
  }
}
person Borodin    schedule 26.06.2012
comment
Нет, не хеш-элементы, элементы массива. Каждое представление сообщения, хэш-ссылка, содержится ровно одной посторонней ссылкой на массив с 1 элементом. - person mmirate; 26.06.2012