Merge pull request #37 from ijackson/no-string-guessing

Avoid looking at string values to try to find the type

Author: oalders

README.pod

@@ -251,6 +251,17 @@ routine.
     };
   );
 
+=item no_string_guessing
+
+When encoding a Perl scalar it is not always clear what the TOML type
+of the value is supposed to be.  By default, C<TOML::Tiny> will, for
+unblessed scalars, guess based on the scalar's appearance.  Strings
+that look like datetimes, or special floating point values, will be
+encoded as such.
+
+With no_string_guessing, C<TOML::Tiny> will never guess a scalar's
+TOML type from its string value.
+
 =item strict
 
 C<strict> imposes some miscellaneous strictures on C<TOML> input, such as
@@ -285,7 +296,7 @@ tighten things up. C<TOML::Tiny> defaults to (somewhat) stricter parsing,
 enabling some extra strictures with L</strict>.
 
 C<TOML::Tiny> supports a number of options which do not exist in L<TOML>:
-L</inflate_integer>, L</inflate_float>, and L</strict>.
+L</inflate_integer>, L</inflate_float>, L</no_string_guessing>, and L</strict>.
 
 C<TOML::Tiny> ignores invalid surrogate pairs within basic and multiline
 strings (L<TOML> may attempt to decode an invalid pair). Additionally, only

lib/TOML/Tiny.pm

@@ -68,7 +68,11 @@ sub decode {
 
 sub encode {
   my ($self, $data) = @_;
-  TOML::Tiny::Writer::to_toml($data, strict => $self->{strict});
+  TOML::Tiny::Writer::to_toml(
+    $data,
+    strict => $self->{strict},
+    no_string_guessing => $self->{no_string_guessing},
+  );
 }
 
 #-------------------------------------------------------------------------------

lib/TOML/Tiny/Parser.pm

@@ -344,7 +344,7 @@ sub parse_datetime {
   $value =~ tr/z/Z/;
   $value =~ tr/ /T/;
   $value =~ s/t/T/;
-  $value =~ s/(\.\d+)($TimeOffset)$/sprintf(".%06d%s", $1 * 1000000, $2)/e;
+  $value =~ s/(\.\d+)($TimeOffset)$/sprintf(".%09d%s", $1 * 1000000000, $2)/e;
 
   return $self->{inflate_datetime}->($value);
 }

lib/TOML/Tiny/Writer.pm

@@ -17,12 +17,13 @@ my @KEYS;
 sub to_toml {
   my $data  = shift;
   die 'toml: data to encode must be a hashref' if ref $data ne 'HASH';
-  return _to_toml( $data );
+  return _to_toml( $data, { @_ } );
 }
 
-sub _to_toml {
+sub _to_toml ($$);
+sub _to_toml ($$) {
   my $data  = shift;
-  my $param = ref($_[1]) eq 'HASH' ? $_[1] : undef;
+  my $param = shift;
 
   die 'toml: found undefined value, which is unsupported by TOML' if ! defined $data;
 
@@ -82,6 +83,7 @@ sub _to_toml {
       return 'nan'  if Math::BigFloat->new($data)->is_nan;
       return $data;
     }
+    return to_toml_string($data) if $param->{no_string_guessing};
     #return $data if svref_2object(\$data)->FLAGS & (SVf_IOK | SVf_NOK);
     return $data if $data =~ /^$DateTime$/;
     return lc($data) if $data =~ /^$SpecialFloat$/;
@@ -103,7 +105,7 @@ sub to_toml_inline_table {
     if (ref $val eq 'HASH') {
       push @buff, $key . '=' . to_toml_inline_table($val);
     } else {
-      push @buff, $key . '=' . _to_toml($val);
+      push @buff, $key . '=' . _to_toml($val, $param);
     }
   }
 
@@ -144,7 +146,7 @@ sub to_toml_table {
 
       for (@{ $data->{$k} }) {
         push @buff_tables, '', '[[' . join('.', map{ to_toml_key($_) } @KEYS) . ']]';
-        push @buff_tables, _to_toml($_);
+        push @buff_tables, _to_toml($_, $param);
       }
 
       pop @KEYS;

t/faithful.t

@@ -0,0 +1,65 @@
+use utf8;
+use Test2::V0;
+use Data::Dumper;
+use DateTime::Format::ISO8601;
+use TOML::Tiny;
+
+binmode STDIN,  ':encoding(UTF-8)';
+binmode STDOUT, ':encoding(UTF-8)';
+
+my $input = q{
+datetime=2020-05-04T16:37:02.905408062+01:00
+datetimes="2020-05-04T16:37:02.905408062+01:00"
+float=3.14
+floats="3.14"
+uint=3
+uints="3"
+nint=-4
+nints="-4"
+bigint=1852528528562625752750
+bigints="1852528528562625752750"
+hex=0x12
+oct=0o751
+bin=0b11010110
+boolf=false
+boolt=true
+boolfs="false"
+boolts="true"
+dtlocal=1979-05-27T00:32:00.643144312
+dtlocals="1979-05-27T00:32:00.643144312"
+};
+
+sub norm ($) {
+  join "\n", (
+    sort
+    map {
+      s{=0o(\d+)$}{ '='.oct($1) }e;
+      s{=(0[xb]\w+)$}{ '='.eval($1) }e;
+      $_;
+    }
+    grep /./,
+    split /\n/, $_[0]
+  ), ''
+}
+
+my $coder = TOML::Tiny->new(
+  no_string_guessing => 1,
+  inflate_datetime => sub {
+    # RFC3339 bombs out if there is no timezone, so we parse with 8601
+    DateTime::Format::ISO8601->parse_datetime(shift)
+  },
+);
+
+my $parsed = $coder->decode($input);
+my $actual = norm($coder->encode($parsed));
+my $expected = norm($input);
+
+is($actual, $expected, 'round trip') or do{
+  diag 'EXPECTED:';
+  diag Dumper($expected);
+
+  diag 'ACTUAL:';
+  diag Dumper($actual);
+};
+
+done_testing;

t/toml-test/valid/datetime/milliseconds.t

@@ -18,10 +18,10 @@ my $toml = do{ local $/; <$fh>; };
 close $fh;
 
 my $expected1 = {
-               "utc1" => "1987-07-05T17:45:56.123456Z",
-               "utc2" => "1987-07-05T17:45:56.600000Z",
-               "wita1" => "1987-07-05T17:45:56.123456+08:00",
-               "wita2" => "1987-07-05T17:45:56.600000+08:00"
+               "utc1" => "1987-07-05T17:45:56.123456000Z",
+               "utc2" => "1987-07-05T17:45:56.600000000Z",
+               "wita1" => "1987-07-05T17:45:56.123456000+08:00",
+               "wita2" => "1987-07-05T17:45:56.600000000+08:00"
              };