2033 private links
Un calendrier de l'Avent avec un code Perl 6 par jour :)
Depuis la version 5.018, Perl affiche des avertissements lorque l'on utilise given/when, tel que :
given is experimental at ...
when is experimental at ...
Pour les supprimer :
no if $] >= 5.018, 'warnings', 'experimental::smartmatch';
Pff, c'est tendu... Pour le fun :
!/usr/bin/env perl
use Data::Dumper qw(Dumper);
my $FROM_JSON = qr{
(?&VALUE) (?{ $_ = $^R->[1] })
(?(DEFINE)
(?<OBJECT>
(?{ [$^R, {}] })
{
(?: (?&KV) # [[$^R, {}], $k, $v]
(?{ # warn Dumper { obj1 => $^R };
[$^R->[0][0], {$^R->[1] => $^R->[2]}] })
(?: , (?&KV) # [[$^R, {...}], $k, $v]
(?{ # warn Dumper { obj2 => $^R };
[$^R->[0][0], {%{$^R->[0][1]}, $^R->[1] => $^R->[2]}] })
)*
)?
}
)
(?<KV>
(?&STRING) # [$^R, "string"]
: (?&VALUE) # [[$^R, "string"], $value]
(?{ # warn Dumper { kv => $^R };
[$^R->[0][0], $^R->[0][1], $^R->[1]] })
)
(?<ARRAY>
(?{ [$^R, []] })
[
(?: (?&VALUE) (?{ [$^R->[0][0], [$^R->[1]]] })
(?: , (?&VALUE) (?{ # warn Dumper { atwo => $^R };
[$^R->[0][0], [@{$^R->[0][1]}, $^R->[1]]] })
)*
)?
]
)
(?<VALUE> \s* ( (?&STRING) |
(?&NUMBER) |
---|
(?&OBJECT)
|
(?&ARRAY)
|
true (?{ [$^R, 1] })
false (?{ [$^R, 0] }) |
---|
null (?{ [$^R, undef] })
)
\s*
)
(?<STRING>
(
"
(?:
[^\"]+
|
\ ["\/bfnrt]
|
\ u [0-9a-fA-f]{4}
)*
"
)
(?{ [$^R, eval $^N] })
)
(?<NUMBER>
(
-?
(?: 0 | [1-9]\d* )
(?: . \d+ )?
(?: [eE] [-+]? \d+ )?
)
(?{ [$^R, eval $^N] })
)
) }xms;
sub fromjson {
local $ = shift;
local $^R;
eval { m{\A$FROMJSON\z}; } and return $;
die $@ if $@;
return 'no match';
}
while (<>) {
chomp;
print Dumper fromjson($);
}
P'tit mémo, ça ne rentrera décidemment jamais dans cette p'tite tête...
De loin la méthode la plus rapide que j'ai trouvé pour perl.