Hacks en perl

De knowledge
Révision datée du 7 octobre 2025 à 13:32 par Jpinon (discussion | contributions) (Page créée avec « 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.<syntaxhighlight lang="perl"> use JSON; </syntaxhighlight>Un lien est donné dans [https://metacpan.org/pod/JSON 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 Open WR... »)
(diff) ← Version précédente | Voir la version actuelle (diff) | Version suivante → (diff)
Aller à la navigation Aller à la recherche

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.