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         data => ['shell.inc.pl'],
   8 });
   9
  10 say "<h1>Shell compatibility</h1>\n";
  11
  12 my $data = Data('shell');
  13 my @agents = keys %{ $data->{agents} };
  14
  15 print '<table class="mapped">';
  16 print '<col>';  # should match first thead row
  17 printf '<colgroup span="%d">', 1 for @agents;
  18 say '</colgroup><col>';
  19
  20 my $header = join('',
  21         '<tr>',
  22         '<th>feature',
  23         (map {
  24                 sprintf('<th%s>%s',
  25                         (map {
  26                                 sprintf ' title="%s"', Entity($_)
  27                         } $data->{agents}->{$_}->{name} // ()),
  28                         $_
  29                 )
  30         } @agents),
  31 );
  32 print '<thead>', $header;
  33 say '</thead>';
  34 say '<tfoot>', $header;
  35
  36 sub saytitlecol {
  37         my ($row) = @_;
  38         print '<td>', Entity($row->{title});
  39 }
  40
  41 my %TSTATS = (
  42         l5 => '✔',
  43         l4 => '✔',
  44         l3 => '±',
  45         l2 => '*',
  46         l1 => '✘',
  47 );
  48
  49 sub saysupportcols {
  50         my ($row, $agent) = @_;
  51         my $support = $row->{support}->{$agent};
  52         my $level = (
  53                 !defined $support ? 'l1' :
  54                 ref $support ne 'HASH' ? 'l0' :
  55                 $support->{alt} ? 'l2' :
  56                 $support->{partial} ? 'l3' :
  57                 $support->{optional} ? 'l4' :
  58                 'l5'
  59         );
  60         my $title = join(' ',
  61                 defined $support ? 'supported' : 'unsupported',
  62                 'in', $data->{agents}->{$agent}->{abbr} // $agent,
  63         );
  64         $title .= " ($_)"
  65                 for ref $support && ($support->{note} // $support->{optional}) || ();
  66         my $header = defined $support ? '✔' : '✘';
  67         printf('<td class="%s" title="%s">%s',
  68                 join(' ', X => $level),
  69                 $title,
  70                 $TSTATS{$level} // (ref $support ? '?' : $support),
  71         );
  72 }
  73
  74 say '<tbody>';
  75 for my $row (sort {
  76         $a->{title} cmp $b->{title}
  77 } @{ $data->{feature} }) {
  78         (my $id = lc $row->{title}) =~ s/\W+/-/g;
  79         printf '<tr id="%s">', $id;
  80         saytitlecol($row);
  81         saysupportcols($row, $_) for @agents;
  82         say '</tr>';
  83 }
  84 say '</tbody>';
  85 say '</table>';
  86