X-Git-Url: http://git.shiar.net/sheet.git/blobdiff_plain/302931daee1a9a4499ba441421b683c97bec36e3..HEAD:/perl.plp diff --git a/perl.plp b/perl.plp index 99863ff..596e4d8 100644 --- a/perl.plp +++ b/perl.plp @@ -2,7 +2,7 @@ Html({ title => 'perl version cheat sheet', - version => '1.4', + version => '1.6', keywords => [qw' perl version feature features comparison sheet cheat overview summary @@ -11,6 +11,7 @@ Html({ data => ['perl.inc.pl'], }); +use experimental 'signatures'; :>

Perl release summary

@@ -32,9 +33,13 @@ eval { use Time::Piece; use Time::Seconds; - my @versions = sort keys %{$info}; my $now = Time::Piece->new; - $now = $now->strptime($_, '%Y-%m-%d') for $get{at} // (); + if (my $ts = $get{at}) { + $now = $now->strptime($ts, '%Y-%m-%d'); + say "Compatibility details emulated for $ts."; + } + my $ts = $now->strftime('%F'); + my @versions = sort grep { $info->{$_}{release} le $ts } keys %{$info}; # perlpolicy: «We "officially" support the two most recent stable release # series. [...] we will attempt to fix critical issues» @@ -52,8 +57,9 @@ eval { $info->{$vcore}{versum} //= "official security patches"; # «We encourage vendors to ship the most recent supported release of Perl - # at the time of their code freeze» with debian&ubuntu having 5 years LTS - my $vendoreol = ($now - ONE_YEAR * 5)->strftime('%F'); + # at the time of their code freeze» + # assume debian ships after 1 year, and expires after 5 years LTS + my $vendoreol = ($now - ONE_YEAR * 6)->strftime('%F'); my $vdebian = first { $info->{$_}{release} ge $vendoreol && $info->{$_}{distro}{debian} } @versions; @@ -81,33 +87,56 @@ for my $vernum (reverse sort keys %{$info}) { say '
'; for (@{ $verrow->{new} }) { my ($topic, $desc, $attr) = @{$_}; - if ($attr) { - my $title; - if (defined $attr->{experimental}) { - $title = 'experimental'; - } - if ($attr->{dropped}) { - next unless exists $get{v}; - $title = sprintf 'removed in %vd', $attr->{dropped}; - } - elsif ($attr->{stable}) { - $title .= sprintf ' until %vd', $attr->{stable}; - } - if ($attr->{experimental}) { - $title = sprintf '%s', - $attr->{experimental}, $title; - } - if ($attr->{feature}) { - my $prefix = sprintf 'feature', - $attr->{feature}; - $title = join ', ', $prefix, $title // (); - } - $desc .= sprintf ' (%s)', $title; + $desc .= featattrs($attr); + my $ref = defined $attr->{name} && sprintf ' id="%s"', $attr->{name}; + say sprintf '%s
%s', $ref, $topic, $desc || '
'; + } + if (my $mods = $verrow->{modules}) { + for (@{$mods}) { + my ($name, $desc, $attr) = @{$_}; + my $ref = lc $name =~ s/::/_/gr; + $desc .= featattrs($attr); + printf '
use %s', $ref, $name; + say '
', $desc; } - say sprintf '
%s
%s', $topic, $desc || '
'; } say sprintf '
Unicode
v%s', $_ for $verrow->{unicode} || (); say '
'; say "\n"; } +sub featattrs ($attr) { + $attr or return ''; + ref $attr or $attr = {eg => $attr}; + my $title; + if (defined $attr->{experimental}) { + $title = 'experimental'; + } + if (defined $attr->{dropped}) { + return '' unless exists $get{v}; + $title = sprintf 'removed in %vd', $_ for $attr->{dropped} || (); + } + elsif ($attr->{stable}) { + $title .= sprintf ' until %vd', $attr->{stable}; + } + if ($attr->{experimental}) { + $title = sprintf '%s', + $attr->{experimental}, $title; + $attr->{name} //= $attr->{experimental}; + } + if ($attr->{feature}) { + my $prefix = sprintf 'feature', + $attr->{feature}; + $title = join ', ', $prefix, $title // (); + $attr->{name} //= $attr->{feature}; + } + $title = $title ? sprintf ' (%s)', $title : ''; + + if (my $eg = $attr->{eg}) { + my $pre = Entity($eg); + $pre =~ s<\N{ZERO WIDTH SPACE}>{}g; + $pre = " {$pre}"; + $title = $pre . $title; + } + return $title; +}