chiark / gitweb /
Add script to perform encoder tests from BurntSushi/toml-tests
authorJeff Ober <jober@ziprecruiter.com>
Mon, 13 Jan 2020 15:40:30 +0000 (10:40 -0500)
committerJeff Ober <jober@ziprecruiter.com>
Mon, 13 Jan 2020 15:40:30 +0000 (10:40 -0500)
.gitignore
lib/TOML/Tiny/Writer.pm
test-bin/from-toml
test-bin/to-toml [new file with mode: 0755]

index 7f5bacd25e61ee2fa087a0b1463932365518e8e1..21f46caa1f88d58bf0718eb43b8f94727a24e539 100644 (file)
@@ -1,2 +1,3 @@
 .build
 scratch.pl
+TOML-Tiny-*
index a3d04f678d64b2da25970fd17d0a3f5722055ab1..d9f21b358ca36e8b58d265779f509a6b7320914d 100644 (file)
@@ -7,6 +7,7 @@ use v5.18;
 
 use Data::Dumper;
 use Scalar::Util qw(looks_like_number);
+use Math::BigFloat;
 use TOML::Tiny::Grammar;
 
 my @KEYS;
@@ -64,7 +65,6 @@ sub to_toml {
         push @buff, to_toml($data->{$k});
         pop @KEYS;
       }
-
     }
 
     when ('ARRAY') {
@@ -85,6 +85,10 @@ sub to_toml {
       return $$data ? 'true' : 'false';
     }
 
+    when (/DateTime/) {
+      return $data->stringify;
+    }
+
     when ('') {
       for ($data) {
         when (looks_like_number($_)) {
@@ -106,7 +110,7 @@ sub to_toml {
     }
 
     when ('Math::BigFloat') {
-      return $data->bstr;
+      return $data->bnstr;
     }
 
     when (defined) {
index 85ea20d344bcd2edb880652494c2e89e931e50c4..3aeb5692a8bfcde84d424cb589dd4128b39f107a 100755 (executable)
@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-use v5.14;
+use v5.18;
 use lib './lib';
 
 use JSON::PP   qw();
diff --git a/test-bin/to-toml b/test-bin/to-toml
new file mode 100755 (executable)
index 0000000..490c5ac
--- /dev/null
@@ -0,0 +1,79 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+no warnings 'experimental';
+use lib './lib';
+use v5.18;
+
+use DateTime;
+use DateTime::Format::RFC3339;
+use Math::BigInt;
+use Math::BigFloat;
+use JSON::PP;
+use JSON::PP::Boolean;
+use TOML::Tiny qw(to_toml);
+
+binmode STDIN,  ':encoding(UTF-8)';
+binmode STDOUT, ':encoding(UTF-8)';
+
+sub deannotate {
+  my $data = shift;
+
+  for (ref $data) {
+    when ('HASH') {
+      if (exists $data->{type} && exists $data->{value} && keys(%$data) == 2) {
+        for ($data->{type}) {
+          when ('bool') {
+            my $bool = !!($data->{value} eq 'true');
+            return bless \$bool, 'JSON::PP::Boolean';
+          }
+
+          when ('integer') {
+            return Math::BigInt->new($data->{value});
+          }
+
+          when ('float') {
+            # Math::BigFloat's constructor will return a Math::BigInt for
+            # non-fractional values. This works around that to force a
+            # BigFloat.
+            return Math::BigFloat->bzero + Math::BigFloat->new($data->{value});
+          }
+
+          when ('datetime') {
+            return DateTime::Format::RFC3339->parse_datetime($data->{value});
+          }
+
+          when ('array') {
+            return [ map{ deannotate($_) } @{$data->{value}} ];
+          }
+
+          default{
+            return $data->{value};
+          }
+        }
+      }
+
+      my %object;
+      $object{$_} = deannotate($data->{$_}) for keys %$data;
+      return \%object;
+    }
+
+    when ('ARRAY') {
+      return [ map{ deannotate($_) } @$data ];
+    }
+
+    default{
+      return $data;
+    }
+  }
+}
+
+my $src  = do{ local $/; <STDIN> };
+my $json = JSON::PP->new->utf8(0)->decode($src);
+my $data = deannotate($json);
+my $toml = to_toml($data);
+
+say $toml;
+
+exit 0;