browser: replace smartmatch by equivalent syntax
[sheet.git] / browser.plp
1 <(common.inc.plp)><:
2 use List::Util qw(sum max first);
3
4 Html({
5         title => 'browser compatibility cheat sheet',
6         version => '1.6',
7         description => [
8                 "Compatibility table of new web features (HTML5, CSS3, SVG, Javascript)",
9                 "comparing support and usage share for all popular browser versions.",
10         ],
11         keywords => [qw'
12                 web browser support compatibility usage matrix available feature
13                 html html5 css css3 svg javascript js dom mobile
14                 ie internet explorer firefox chrome safari webkit opera
15         '],
16         data => ['data/browser/support.inc.pl'],
17 });
18
19 say "<h1>Browser compatibility</h1>\n";
20
21 my $caniuse = Data('data/browser/support');
22
23 my %CSTATS = (
24         'n'   => 'l1',
25         'n d' => 'l2',
26         'n x d' => 'l2 ex',
27         'p d' => 'l2',
28         'a d' => 'l2',
29         'y'   => 'l5',
30         'y #' => 'l4',
31         'y x' => 'l5 ex',
32         'y x #' => 'l4 ex',
33         'a'   => 'l3',
34         'a x' => 'l3 ex',
35         'p'   => 'l2',
36         'u'   => 'l0',
37         'u d' => 'l2',
38 );
39 my %DSTATS = (
40         u => 'unknown',
41         n => 'unsupported',
42         p => 'plugin required',
43         a => 'partial',
44         y => 'supported',
45         d => '(disabled by default)',
46         x => sub {
47                 join(' ',
48                         'with prefix',
49                         map {"-$_-"}
50                         $caniuse->{agents}->{$_[0]}->{version_list}->{$_[1]}->{prefix}
51                         // $caniuse->{agents}->{$_[0]}->{prefix} // (),
52                 );
53         },
54 );
55 my %PSTATS = (  # score percentage
56         y => 1,  'y x' => .9,
57         a => .5, 'a x' => .5, 'a d' => .2,
58         p => .2, 'p d' => .1,
59         n => 0,  'n d' => .2, 'n x d' => .2,
60         u => 0,
61 );
62 my %CSTATUS = (
63         unoff => 'l1', # unofficial
64         wd    => 'l2', # draft
65         cr    => 'l3', # candidate
66         pr    => 'l3', # proposed
67         rec   => 'l5', # recommendation
68         ls    => 'l4', # whatwg
69         ietf  => 'l0', # standard
70         other => 'l0', # non-w3
71 );
72 my %versions;
73 while (my ($browser, $row) = each %{ $caniuse->{agents} }) {
74         $versions{$browser} = [@{ $row->{versions} }];
75 }
76
77 my $ref = showlink('Can I use', 'https://caniuse.com/');
78 $ref =~ s/(?=>)/ title="updated $_"/
79         for map { s/[\sT].*//r } $caniuse->{-date} || ();
80 $ref = "Fyrd's $ref page";
81 say '<p id="intro">Alternate rendition of '.$ref;
82
83 my ($canihas, $usage);
84 my $minusage = $get{threshold} // 1;
85 for ($get{usage} // 'wm') {
86         $_ or next;  # none
87         unless (m{ \A [a-z]\w+ (?:/\d[\d-]*\d)? \z }x) {
88                 Alert([
89                         'Invalid browser usage data request',
90                         'Identifier must be alphanumeric name or <q>0</q>.',
91                 ]);
92                 next;
93         }
94
95         $canihas = eval { Data("data/browser/usage-$_") } or do {
96                 Alert('Browser usage data not found', $@);
97                 next;
98         };
99         $usage = $_;
100         my $ref = $canihas->{-title} || 'unknown';
101         $ref = showlink($ref, $_)
102                 for $canihas->{-site} || $canihas->{-source} || ();
103         $ref =~ s/(?=>)/ title="updated $_"/ for $canihas->{-date} || ();
104         print "\nwith $ref browser usage statistics";
105 }
106
107 my @browsers;
108 if ($usage) { # first() does not work inside given >:(
109         # adapt version usage to actual support data
110         my %engineuse;  # prefix => usage sum
111         for my $browser (keys %versions) {
112                 my $row = $canihas->{$browser} // {};
113                 my $verlist = $versions{$browser} or next;
114                 if ($minusage and sum(values %$row) < $minusage) {
115                         delete $versions{$browser};
116                         next;
117                 }
118                 my %supported = map { $_ => 1 } @$verlist;
119
120                 # cascade unknown versions
121                 $row->{$_} //= undef for @$verlist;  # ensure stable keys during iteration
122                 while (my ($version, $usage) = each %$row) {
123                         next if defined $supported{$version};
124                         my $next = first { paddedver($_) ge paddedver($version) } @$verlist
125                                 or warn("No fallback found for $browser v$version; $usage% ignored"), next;
126                         $row->{$next} += $usage;
127                         $row->{$version} = 0;  # balance browser total
128                 }
129
130                 # build row list for each version
131                 if ($minusage) {
132                         my @vershown;  # $verlist replacement
133                         my ($rowusage, @verrow) = (0);  # replacement row tracking
134                         for (@$verlist) {
135                                 push @verrow, $_;  # queue each version
136                                 if (($rowusage += $row->{$_}) >= $minusage) {
137                                         push @vershown, [@verrow];   # add row
138                                         ($rowusage, @verrow) = (0);  # reset row tracking
139                                 }
140                         }
141                         push @vershown, \@verrow if @verrow;  # always add latest
142                         @$verlist = @vershown;
143                 }
144                 else {
145                         @$verlist = map { [$_] } @$verlist;
146                 }
147
148                 # reusable aggregates (grouped by prefix (engine) and browser)
149                 $engineuse{ $caniuse->{agents}->{$browser}->{prefix} } +=
150                 $row->{-total} = sum(values %$row);
151         }
152
153         # order browser columns by usage grouped by engine
154         @browsers = sort {
155                 $engineuse{ $caniuse->{agents}->{$b}->{prefix} } <=>
156                 $engineuse{ $caniuse->{agents}->{$a}->{prefix} }
157                         ||
158                 $canihas->{$b}->{-total} <=> $canihas->{$a}->{-total}
159         } keys %versions;
160 }
161 else {
162         # order browser columns by name grouped by engine
163         @{$_} = map { [$_] } @{$_} for values %versions;
164         @browsers = sort {
165                 $caniuse->{agents}->{$b}->{prefix} cmp
166                 $caniuse->{agents}->{$a}->{prefix}
167                         ||
168                 $a cmp $b
169         } keys %versions;
170 }
171 :>.
172 </p>
173
174 <:
175 $canihas ||= {
176         map {
177                 $_ => +{
178                         map {
179                                 my $zero = $#$_ - 2;  # baseline index
180                                 ($_->[$zero - 2] =>  .5), # past
181                                 ($_->[$zero - 1] => 10 ), # previous
182                                 ($_->[$zero + 2] =>  0 ), # future
183                                 ($_->[$zero + 1] =>  .5), # next
184                                 ($_->[$zero    ] => 30 ), # current
185                         } $caniuse->{agents}->{$_}->{versions}
186                 }
187         } @browsers
188 }; # fallback hash based on release semantics
189
190 # score multiplier for percentage of all browser versions
191 my $usagepct = 99.99 / sum(
192         map { $_->{-total} // values %{$_} }
193         map { $canihas->{$_} }
194         grep { !/^-/ }
195         keys %{$canihas}
196 );
197
198 $_->{usage} = featurescore($_->{stats}) * $usagepct
199         for values %{ $caniuse->{data} };
200
201 print '<table class="mapped">';
202 print '<col span="3">';  # should match first thead row
203 printf '<colgroup span="%d">', scalar @{ $versions{$_} } for @browsers;
204 say '</colgroup><col>';
205
206 my $header = join('',
207         '<tr>',
208         '<th colspan="3" rowspan="2">feature',
209         (map {
210                 my $name = $caniuse->{agents}->{$_}->{browser};
211                 sprintf('<th colspan="%d" class="%s" title="%s">%s',
212                         scalar @{ $versions{$_} },
213                         join(' ', map {"b-a-$_"} grep {$_}
214                                 $_, @{ $caniuse->{agents}->{$_} }{'prefix', 'type'},
215                         ),
216                         join(' ',
217                                 sprintf('%.1f%%', $canihas->{$_}->{-total} * $usagepct),
218                                 $name,
219                         ),
220                         do {
221                                 length $name <= (3 * @{ $versions{$_} }) ? $name
222                                         : $caniuse->{agents}->{$_}->{abbr};
223                         },
224                 )
225         } @browsers),
226         '<th rowspan="2">%',
227 );
228 print '<thead>', $header;
229 # preceding row without any colspan to work around gecko bug
230 print "\n<tr>";
231 for my $browser (@browsers) {
232         for my $span (@{ $versions{$browser} }) {
233                 my $lastver = first {
234                         $caniuse->{agents}->{$browser}->{version_list}->{$_}->{release_date} # stable
235                 } reverse @{$span};
236                 printf('<td title="%s"%s>%s',
237                         join(' ',
238                                 sprintf('%.1f%%', sum(@{ $canihas->{$browser} }{ @{$span} }) * $usagepct),
239                                 'version ' . showversions(@{$span}, undef),
240                                 (map {
241                                         $_ ? sprintf('(released %d)', $_/3600/24/365.25 + 1970) : '(development)'
242                                 } $caniuse->{agents}->{$browser}->{version_list}->{$lastver}->{release_date}),
243                         ),
244                         !defined $lastver && ' class="ex"',
245                         showversions($lastver // $span->[0]),
246                 );
247         }
248 }
249 say '</thead>';
250 say '<tfoot>', $header;
251 {
252         # prefix indicates browser family; count adjacent families
253         my (@families, %familycount);
254         for my $browser (@browsers) {
255                 my $family = $caniuse->{agents}->{$browser}->{prefix};
256                 push @families, $family unless $familycount{$family};
257                 $familycount{$family} += @{ $versions{$browser} };
258         }
259
260         print "\n", '<tr class="cat">';
261         printf '<th colspan="%d">%s', $familycount{$_}, $_ for @families;
262 }
263 say '</tfoot>';
264
265 sub featurescore {
266         # relative amount of support for given feature
267         my $rank = 0;
268         if (my $row = shift) {
269                 if ($canihas) {
270                         while (my ($browser, $versions) = each %$row) {
271                                 ref $versions eq 'HASH' or next;
272                                 my $prev;
273                                 for my $version (@{ $caniuse->{agents}->{$browser}->{versions} }) {
274                                         my $status = $versions->{$version} // $prev;
275                                         $status =~ s/\h\#\d+//g;
276                                         $rank += ($canihas->{$browser}->{$version} || .001) * $PSTATS{$status};
277                                         $prev = $status;
278                                 }
279                         }
280                         return $rank;
281                 }
282
283                 while (my ($browser, $vercols) = each %versions) {
284                         my $div = 0;  # multiplier exponent (decreased to lower value)
285                         my @vers = map { $row->{$browser}->{$_} } @$vercols;
286                         if (my $current = $caniuse->{agents}->{$browser}->{versions}->[-3]) {
287                                 my @future;  # find upcoming releases (after current)
288                                 for (reverse @$vercols) {
289                                         last if $_ eq $current;
290                                         push @future, pop @vers;
291                                         $_ eq 'u' and $_ = $vers[-1] for $future[-1];  # inherit latest value if unknown
292                                 }
293                                 splice @vers, -1, 0, @future;  # move ahead to decrease precedence
294                         }
295                         $rank += $PSTATS{$_} * 2**($div--) for reverse @vers;
296                 }
297         }
298         return $rank;
299 }
300
301 sub formatnotes {
302         my @html = @_;
303         for (@html) {
304                 s/\r\n?/\n/g;  # windows returns
305                 s/\h* $//gmx;  # trailing whitespace
306                 s/(?<= [^.\n]) $/./gmx;  # consistently end each line by a period
307                 Entity($_);
308                 s{  ` ([^`]*)  ` }{<code>$1</code>}gx;
309                 s{ \(\K (?: \Qhttps://caniuse.com\E )? (?: /? \#feat= | / ) }{#}gx;
310                 s{ \[ ([^]]*) \] \( ([^)]*) \) }{<a href="$2">$1</a>}gx;
311         }
312         return @html;
313 }
314
315 sub notestotitle {
316         my @notes = @_;
317         for (@notes) {
318                 EscapeHTML($_);
319                 s{ \[ ([^]]*) \] \( [^)]* \) }{$1}gx;  # strip link urls
320         }
321         return @notes;
322 }
323
324 sub saytitlecol {
325         my ($id) = @_;
326         my $row = $caniuse->{data}->{$id};
327
328         for ($row->{categories}) {
329                 my $cell = $_ ? lc $_->[0] : '-';
330                 $cell =~ s/ api$//;  # trim unessential fluff in 'js api'
331                 printf '<th title="%s">%s', join(' + ', @$_), $cell;
332         }
333
334         print '<td>', map {
335                 sprintf('<a href="%s" onclick="%s">%s</a>',
336                         "#$id",
337                         sprintf("try { %s; return false } catch(err) { return true }",
338                                 "document.getElementById('$id').classList.toggle('target')",
339                         ),
340                         Entity($_),
341                 );
342         } $row->{title};
343         print '<div class=aside>';
344         print "<p>$_</p>"
345                 for formatnotes($row->{description}, $row->{notes} || ());
346         if (my %notes = %{ $row->{notes_by_num} }) {
347                 say '<p>Browser-specific notes:';
348                 say "<br>#$_: ", formatnotes($notes{$_}) for sort keys %notes;
349                 say '</p>';
350         }
351         printf 'Resources: %s.', join(', ', map {
352                 showlink($_->{title}, $_->{url})
353         } @$_) for grep { @$_ } $row->{links} // ();
354         printf '<br>Parent feature: %s.', join(', ', map {
355                 showlink($caniuse->{data}->{$_}->{title}, "#$_")
356         } $_) for $row->{parent} || ();
357         print '</div>';
358 }
359
360 sub saystatuscol {
361         my ($id) = @_;
362         my $row = $caniuse->{data}->{$id};
363
364         for ($row->{status}) {
365                 my $cell = $_ // '-';
366                 $cell = showlink($cell, $_) for $row->{spec} // ();
367                 printf '<td title="%s" class="l %s">%s',
368                         $caniuse->{statuses}->{$_}, $CSTATUS{$_} // '', $cell;
369         }
370 }
371
372 sub saybrowsercols {
373         my ($id, $browser) = @_;
374         my $feature = $caniuse->{data}->{$id};
375         my $data = $feature->{stats}->{$browser};
376         if (ref $data eq 'ARRAY') {
377                 # special case for unsupported
378                 $data = {
379                         map { $_ => 'n' }
380                         keys %{ $caniuse->{agents}->{$browser}->{version_list} }
381                 };
382         }
383
384         my ($prev, @span);
385         for my $ver (@{ $versions{$browser} }, undef) {
386                 my $compare = (
387                         !defined $ver ? undef :      # last column if nameless
388                         ref $data ne 'HASH' ? '' :   # unclassified if no support hash
389                         (first { defined } @{$data}{ reverse @{$ver} })  # last known version
390                         // $prev                     # inherit from predecessor
391                         || 'u'                       # unsure
392                 );
393                 if (defined $prev and not $prev ~~ $compare) {
394                         # different columns
395                         my @vercover = (map { @{$_} } @span);  # accumulated conforming versions
396                         for ($ver ? @{$ver} : ()) {
397                                 last if defined $data->{$_};  # until different
398                                 push @vercover, $_;  # matches from next span start
399                         }
400                         my $usage = sum(@{ $canihas->{$browser} }{@vercover});
401
402                         # strip #\d note references from support class
403                         my @notes;
404                         push @notes, $feature->{notes_by_num}->{$1}
405                                 while $prev =~ s/\h \# (\d+) \b//x;
406
407                         # prepare version hover details
408                         my $title = sprintf('%.1f%% %s', $usage * $usagepct, join(' ',
409                                 (map { ref $_ eq 'CODE' ? $_->($browser, $vercover[0]) : $_ }
410                                  map { $DSTATS{$_} // () }
411                                  map { split / /, $_ }
412                                  $prev
413                                 ),
414                                 'in', $caniuse->{agents}->{$browser}->{abbr},
415                                 showversions(@vercover, undef),
416                         ));
417                         $title .= "\n$_" for notestotitle(@notes);
418
419                         $prev .= ' #' if @notes and $prev =~ /^y/;
420                         printf('<td class="%s" colspan="%d" title="%s">%s',
421                                 join(' ',
422                                         X => $CSTATS{$prev},
423                                         !$usage ? ('p0') : ('p',
424                                                 sprintf('p%01d', $usage * ($usagepct - .0001) / 10),
425                                                 sprintf('p%02d', $usage * ($usagepct - .0001)),
426                                         ),
427                                 ),
428                                 scalar @span,
429                                 $title,
430                                 showversions($span[0]->[0], @span > 1 && defined $ver ? $span[-1]->[-1] : ()),
431                         );
432                         undef $prev;
433                         @span = ();
434                 }
435                 if ($ver) {
436                         my $startversion = first { defined $data->{ $ver->[$_] } }
437                                 reverse 0 .. $#{$ver};  # compare index
438                         push @span, [ @{$ver}[ $startversion .. $#{$ver} ] ];
439                 }
440                 $prev = $compare;
441         }
442 }
443
444 sub sayusagecol {
445         my ($id) = @_;
446         print '<td>', int $caniuse->{data}->{$id}->{usage};
447 }
448
449 say '<tbody>';
450 for my $id (sort {
451         $caniuse->{data}->{$b}->{usage} <=> $caniuse->{data}->{$a}->{usage}
452 } keys %{ $caniuse->{data} }) {
453         $caniuse->{data}->{$id}->{stats} or next;  # skip metadata [summary]
454         printf '<tr id="%s">', $id;
455         saytitlecol($id);
456         saystatuscol($id);
457         saybrowsercols($id, $_) for @browsers;
458         sayusagecol($id);
459         say '</tr>';
460 }
461 say '</tbody>';
462 say '</table>';
463
464 sub paddedver {
465         # normalised version number comparable as string (cmp)
466         $_[0] =~ m/(?:.*-|^)(\d*)(.*)/;
467         # matched (major)(.minor) of last value in range (a-B)
468         return sprintf('%03d', length $1 ? $1 : 999) . $2;
469 }
470
471 sub showversions {
472         # title to describe minumum version and optional maximum for multiple cells
473         my @span = (map { split /-/ } grep { defined } @_);
474         return $span[0] =~ s/\.0\z//r if @_ <= 1;
475         splice @span, 1, -1;
476         return join('‒', @span);
477 }
478
479 :>
480 <hr>
481
482 <div class="legend">
483         <table class="glyphs"><tr>
484         <td class="X l5">supported
485         <td class="X l4">annotated
486         <td class="X l3">partial
487         <td class="X l2">optional
488         <td class="X l1">missing
489         <td class="X l0">unknown
490         <td class="X ex">prefixed
491         </table>
492
493         <p><: if ($usage) { :>
494                 Usage percentage:
495                 <span class="  p0">0</span> -
496                 <span class="p p0 p00">.01</span> -
497                 <span class="p p0 p05">1-9</span> -
498                 <span class="p p1">10</span> -
499                 <span class="p p2">20</span> -
500                 <span class="p p5">majority</span>
501 <: } else { :>
502                 <table class="glyphs"><tr>
503                         <td class="p p1">previous version</td>
504                         <td class="p p3">current</td>
505                         <td class="p p0 p00">upcoming (within months)</td>
506                         <td class="  p0">future (within a year)</td>
507                 </table>
508 <: } :> </p>
509
510         <div class="right">
511                 <ul class="legend legend-set">
512                 <li>default <strong>style</strong> is
513                         <:= defined $get{style} && 'set to ' :><em><:= $style :></em>
514                 <li><strong>usage</strong> source is
515                         <:= !defined $get{usage} && 'default ' :><:= defined $usage ? "<em>$usage</em>" : 'not included (<em>0</em>)' :>
516                 <li>usage <strong>threshold</strong> is
517                         <:= defined $get{threshold} && 'changed to ' :><em><:= $minusage :>%</em>
518                 </ul>
519         </div>
520 </div>
521
522 <script type="text/javascript" src="/searchlocal.js"></script>
523 <script type="text/javascript"><!--
524         prependsearch(document.getElementById('intro'));
525 //--></script>
526