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, {}] })
  \{
    (?: (?&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 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. Attention c'est assez sensible aux espaces. L'objet JSON {"nom":"Jean PINON", "taille": 175} va provoquer une erreur alors que {"nom":"Jean PINON","taille":175} marche parfaitement.

$ ./json.pl 
{"nom":"Jean Pinon", "age": 15}
$VAR1 = 'no match';
{"nom":"Jean Pinon","age":15}
$VAR1 = {
          'age' => 15,
          'nom' => 'Jean Pinon'
        };

Je penses que la regexp est corrigible mais... j'ai pas encore le courage!