Hacks en perl

Perl est merveilleux puissant mais... pas très clair. Je vais poser ici quelques hacks perl qui vous feront passer pour des pros.

JSON vers PERL

Il y a un module perl pour cela. Le module JSON.

use JSON;

Un lien est donné dans metacpan. mais c'est lourd et, parfois on n'a pas la place de l'installer. C'est notamment le cas pour les mini modules GLINET sous OpenWRT.

Ici on parle de méthodes "roots" qui marchent sans aucun modules.

On utilise des expressions rationnelles (regexp) :

#!/usr/bin/env perl

use Data::Dumper qw(Dumper);

my $FROM_JSON = qr{

(?&VALUE) (?{ $_ = $^R->[1] })

(?(DEFINE)

(?<OBJECT>
  (?{ [$^R, {}] })
  \{
    (?: \s* (?&KV)
      (?{
        [$^R->[0][0], { $^R->[1] => $^R->[2] }]
      })
      (?: \s*,\s* (?&KV)
        (?{
          [$^R->[0][0], { %{$^R->[0][1]}, $^R->[1] => $^R->[2] }]
        })
      )*
    )?
  \}
)

(?<KV>
  (?&STRING) \s* : \s* (?&VALUE)
  (?{ # warn Dumper { kv => $^R };
     [$^R->[0][0], $^R->[0][1], $^R->[1]] })
)

(?<ARRAY>
  (?{ [$^R, []] })
  \[
    (?: \s* (?&VALUE)
      (?{ [$^R->[0][0], [$^R->[1]]] })
      (?: \s*,\s* (?&VALUE)
        (?{ # warn Dumper { atwo => $^R };
           [$^R->[0][0], [@{$^R->[0][1]}, $^R->[1]]] })
      )*
    )?
  \s* \]
)
(?<VALUE>
  \s*
  (
      (?&STRING)
    |
      (?&NUMBER)
    |
      (?&OBJECT)
    |
      (?&ARRAY)
    |
    true (?{ [$^R, 1] })
  |
    false (?{ [$^R, 0] })
  |
    null (?{ [$^R, undef] })
  )
  \s*
)

(?<STRING>
  (
    "
    (?:
      [^\\"]+
    |
      \\ ["\\/bfnrt]
    )*
    "
  )

  (?{ [$^R, eval $^N] })
)

(?<NUMBER>
  (
    -?
    (?: 0 | [1-9]\d* )
    (?: \. \d+ )?
    (?: [eE] [-+]? \d+ )?
  )

  (?{ [$^R, eval $^N] })
)

) }xms;

sub from_json {
  local $_ = shift;
  local $^R;
  eval { m{\A$FROM_JSON\z}; } and return $_;
  die $@ if $@;
  return 'no match';
}

while (<>) {
  chomp;
  print Dumper from_json($_);
}

La fonction from_json() accepte une chaine (la "phrase" JSON) et renvoie un objet perl reflétant la structure de la "phrase" JSON.