shell.plp

   1 <(common.inc.plp)><:
   2 use List::Util qw(sum max first);
   3
   4 Html({
   5         title => 'Shell compatibility cheat sheet',
   6         version => '1.0',
   7         stylesheet => [qw'circus dark mono red light'],
   8         data => ['shell.inc.pl'],
   9 });
  10
  11 say "<h1>Shell compatibility</h1>\n";
  12
  13 my $data = do 'shell.inc.pl' or die $@ || $!;
  14 my @agents = keys %{ $data->{agents} };
  15
  16 print '<table class="mapped">';
  17 print '<col>';  # should match first thead row
  18 printf '<colgroup span="%d">', 1 for @agents;
  19 say '</colgroup><col>';
  20
  21 my $header = join('',
  22         '<tr>',
  23         '<th>feature',
  24         (map {
  25                 sprintf('<th>%s', Entity($_->{name}))
  26         } @{ $data->{agents} }{@agents}),
  27 );
  28 print '<thead>', $header;
  29 say '</thead>';
  30 say '<tfoot>', $header;
  31
  32 sub saytitlecol {
  33         my ($row) = @_;
  34         print '<td>', Entity($row->{title});
  35 }
  36
  37 my %DSTATS = (
  38         Y => 'feature can be done',
  39         N => 'feature is not present',
  40         F => 'feature can only be done by using the shells function mechanism',
  41         L => 'the readline library must be linked into the shell to enable this feature',
  42 );
  43 my %CSTATS = (
  44         N => 'l1',
  45         F => 'l2',
  46         L => 'l4',
  47         Y => 'l5',
  48 );
  49
  50 sub saysupportcols {
  51         my ($row, $agent) = @_;
  52         my $stat = $row->{support}->{$agent};
  53         my $title = join(' ',
  54                 $DSTATS{$stat} // 'unknown support',
  55                 'in', $agent,
  56         );
  57         printf('<td class="%s" title="%s">%s',
  58                 join(' ',
  59                         X => $CSTATS{$stat},
  60                 ),
  61                 $title,
  62                 $stat,
  63         );
  64 }
  65
  66 say '<tbody>';
  67 for my $row (sort {
  68         $a->{title} cmp $b->{title}
  69 } @{ $data->{feature} }) {
  70         (my $id = lc $row->{title}) =~ s/\W+/-/g;
  71         printf '<tr id="%s">', $id;
  72         saytitlecol($row);
  73         saysupportcols($row, $_) for @agents;
  74         say '</tr>';
  75 }
  76 say '</tbody>';
  77 say '</table>';
  78