From: Jeff Ober <jober@ziprecruiter.com>
Date: Mon, 13 Jan 2020 15:40:30 +0000 (-0500)
Subject: Add script to perform encoder tests from BurntSushi/toml-tests
X-Git-Tag: nailing-cargo/1.0.0~234^2~49
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=commitdiff_plain;h=202662ba4badcc20a609d5d5b20ffdc1404ed9ba;p=nailing-cargo.git

Add script to perform encoder tests from BurntSushi/toml-tests
---

diff --git a/.gitignore b/.gitignore
index 7f5bacd..21f46ca 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,3 @@
 .build
 scratch.pl
+TOML-Tiny-*
diff --git a/lib/TOML/Tiny/Writer.pm b/lib/TOML/Tiny/Writer.pm
index a3d04f6..d9f21b3 100644
--- a/lib/TOML/Tiny/Writer.pm
+++ b/lib/TOML/Tiny/Writer.pm
@@ -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) {
diff --git a/test-bin/from-toml b/test-bin/from-toml
index 85ea20d..3aeb569 100755
--- a/test-bin/from-toml
+++ b/test-bin/from-toml
@@ -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
index 0000000..490c5ac
--- /dev/null
+++ b/test-bin/to-toml
@@ -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;