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>%s',
  26                         (map {
  27                                 sprintf ' title="%s"', Entity($_)
  28                         } $data->{agents}->{$_}->{name} // ()),
  29                         $_
  30                 )
  31         } @agents),
  32 );
  33 print '<thead>', $header;
  34 say '</thead>';
  35 say '<tfoot>', $header;
  36
  37 sub saytitlecol {
  38         my ($row) = @_;
  39         print '<td>', Entity($row->{title});
  40 }
  41
  42 my %TSTATS = (
  43         l5 => '✔',
  44         l4 => '✔',
  45         l3 => '±',
  46         l2 => '*',
  47         l1 => '✘',
  48 );
  49
  50 sub saysupportcols {
  51         my ($row, $agent) = @_;
  52         my $support = $row->{support}->{$agent};
  53         my $level = (
  54                 !defined $support ? 'l1' :
  55                 ref $support ne 'HASH' ? 'l0' :
  56                 $support->{alt} ? 'l2' :
  57                 $support->{partial} ? 'l3' :
  58                 $support->{optional} ? 'l4' :
  59                 'l5'
  60         );
  61         my $title = join(' ',
  62                 defined $support ? 'supported' : 'unsupported',
  63                 'in', $data->{agents}->{$agent}->{abbr} // $agent,
  64         );
  65         $title .= " ($_)"
  66                 for ref $support && ($support->{note} // $support->{optional}) || ();
  67         my $header = defined $support ? '✔' : '✘';
  68         printf('<td class="%s" title="%s">%s',
  69                 join(' ', X => $level),
  70                 $title,
  71                 $TSTATS{$level} // (ref $support ? '?' : $support),
  72         );
  73 }
  74
  75 say '<tbody>';
  76 for my $row (sort {
  77         $a->{title} cmp $b->{title}
  78 } @{ $data->{feature} }) {
  79         (my $id = lc $row->{title}) =~ s/\W+/-/g;
  80         printf '<tr id="%s">', $id;
  81         saytitlecol($row);
  82         saysupportcols($row, $_) for @agents;
  83         say '</tr>';
  84 }
  85 say '</tbody>';
  86 say '</table>';
  87