Построение "интроспективных" вложенных HTML-таблиц

Question

Это то, что я пишу с использованием Template Toolkit в Perl, но это более общая проблема алгоритма. Моя основная проблема заключается в том, что с учетом структуры данных, как это:

my @array = (
    [qw /00 01/],
    [qw /10/],
    [qw /20 21/],
    [qw /30 31 32 33 /],
);

Мне нужен вывод, как это (упрощено для иллюстрации):

<00>
  <10>
    <20> <30>(00/10/20/30)</30> <31>(00/10/20/31)</31>
         <32>(00/10/20/32)</32> <33>(00/10/20/30)</33>
    </20>
    <21> <30>(00/10/21/30)</30> <31>(00/10/21/31)</31>
         <32>(00/10/21/31)</32> <33>(00/10/21/31)</33>
    </21>
  </10>
</00>
<01>
  <10>
    <20> <30>(01/10/20/30)</30> <31>(01/10/20/31)</31>
         <32>(01/10/20/32)</32> <33>(01/10/20/33)</33>
    </20>
    <21> <30>(01/10/21/30)</30> <31>(01/10/21/31)</31>
         <32>(01/10/21/32)</32> <33>(01/10/21/33)</33>
    </21>
</10>
</01>

Это упрощенный пример вложенных HTML-таблиц, которые являются реальным результатом. Путь в центральных узлах на самом деле является аргументами, вызываемыми другой подпрограммой для заполнения вложенных таблиц данными. Я вполне уверен, что транспонирование исходной структуры массива будет полезным, поэтому я написал Array::Transpose::Ragged и выпустил его на CPAN сегодня.

Я управлял реализацией, которая строит вложенную структуру изнутри наружу (используя Template Toolkit perl - см. Ниже), но к тому времени, когда я добираюсь до внешних частей структуры, у меня больше нет возможности заполнять требуемые данные в центральные узлы. Вот эта реализация того, чего она стоит:

[% SET inner = "(path data should go here)" %]
[% MACRO process_groups(line, inner) BLOCK %]
[% FOREACH l IN line %]
<[% l %]>[% inner %]</[% l %]>
[% END %]
[% END %]
[% WHILE (x = records.pop) %]
[% inner = process_groups(x, inner) %]
[% END %]
[% inner %]

Любые предложения о подходе, который я должен принять, чтобы получить это право

ОБНОВИТЬ:

Для интереса я думал, что выложу версию принятого ответа TT. Немного сложно, потому что TT не так гибок, как perl, но здесь идет речь:

#!/usr/bin/env perl
use warnings;
use strict;
use Template;
my $template = Template->new();
my @array = (
    [ qw/00 01/ ], [ qw/10/ ],[ qw/20 21/ ], [ qw/30 31 32 33/ ]);
my $stash = { records => \@array, };
$template->process(\*DATA, $stash) || die $template->error(), "\n";

__END__
[% MACRO print_output(data, path_elements) BLOCK; %]
[% current = data.0; remaining = data.slice(1); %]
[% FOREACH d IN current %]
<[% d %]>
[% IF remaining.size > 0  %]
[% path_elements.push(d); print_output(remaining, path_elements); %]
[% SET discard = path_elements.pop %]
[% ELSE %]
([% path_elements.join('/')  _ '/' _ d  %])
[% END %]
</[% d %]>
[% END %]
[% END %]
[% SET path = []; print_output(records, path) %]

А еще лучше вот фактическая структура вложенных таблиц в TT:

[% MACRO print_output(data, path_elements) BLOCK; %]
<table> <tr>
[% current = data.0; remaining = data.slice(1); %]
[% FOREACH d IN current %]
<th>[% d %]</th>
[% END %] </tr>
<tr>
[% FOREACH d IN current %]
[% IF remaining.size > 0  %]
<td id="[% d %]">[% path_elements.push(d); print_output(remaining, path_elements); %]</td>
[% SET discard = path_elements.pop %]
[% ELSE %]
<td>([% path_elements.join('/')  _ '/' _ d  %])</td>
[% END %]
[% END %]
</tr></table>
[% END %]
[% SET path = []; print_output(records, path) %]

Answer 1

Не уверен, что понимаю весь контекст, в котором вы работаете, но вот небольшая проблема:

use strict;
use warnings;

my @array = (
    [ qw/00 01/ ],
    [ qw/10/ ],
    [ qw/20 21/ ],
    [ qw/30 31 32 33/ ],
);
print_output(\@array);

sub print_output {
    my ($data, @path_elements) = @_;
    my $level = @path_elements;
    my ($current, @remaining) = @$data;
    for my $d (@$current){
        print '  ' x $level, "<$d>\n";    
        if (@remaining){
            print_output(\@remaining, @path_elements, $d);        
        }
        else {
            print '  ' x ($level + 1), "(", join('/', @path_elements, $d), ")\n";
        }
        print '  ' x $level, "</$d>\n";
    }
}

Answer 2

Если вы хотите решение Template Toolkit, см. Ниже.

Код Perl:

use strict;
use Template;

my @array = (
    [qw /00 01/],
    [qw /10/],
    [qw /20 21/],
    [qw /30 31 32 33/],
);

my $tt = Template->new(POST_CHOMP => 1);

$tt->process('template.tt', { DATA => \@array }) or die "TT Error : " . $tt->error();

TT шаблон (исправлено) (template.tt):

[% BLOCK display -%]
   [% arr = DATA.$i %]
   [% IF i == DATA.max %]
      [% FOREACH t IN arr -%]
         <[% t %]>
             [% tmp_c = c.substr(1) %]
             [% "($tmp_c/$t)" %]
         </[% t %]>
      [% END %]
   [% ELSE %]
      [% FOREACH t IN arr -%]
         <[% t %]>
            [% INCLUDE display i = i+1, c = "$c/$t" %]
         </[% t %]>
      [% END -%]
   [% END %]
[% END -%]

[% INCLUDE display i = 0, c = '' %]