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

Это то, что я пишу, используя 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.

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

[% 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) %]

person singingfish    schedule 04.11.2010    source источник
comment
По сути, это проблема составления списка с форматированием, верно?   -  person Axeman    schedule 04.11.2010


Ответы (2)


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

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";
    }
}
person FMc    schedule 04.11.2010

Если вам нужно решение Template Toolkit, см. ниже.

Перл-код:

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 = '' %]
person bob.faist    schedule 04.11.2010
comment
Это не совсем так. Внутренний материал получается как соединение самых нижних элементов исходного массива, это должен быть путь обратно к вершине. В остальном спасибо :) - person singingfish; 05.11.2010