=item inflate_integer
TOML integers are 64 bit and may not match the size of the compiled perl's
-internal integer type. By default, integers are left as-is as perl strings
-which may be upgraded as needed by the caller.
+internal integer type. By default, integers other than smallish
+decimal integers are left as-is as perl strings which may be upgraded
+as needed by the caller.
my $parser = TOML::Tiny->new(
inflate_integer => sub{
anyway), C<strict_arrays> will produce an error when encountering arrays with
heterogenous types.
+=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 numbers, or like datetimes, will be encoded as such.
+
+With no_string_guessing, C<TOML::Tiny> will look at the perl innards
+to find the currently stored value type. If it is a number, the
+scalar will be encoded as a number. If it's a string, as a string.
+Dates and times which weren't built with DateTime come out as strings.
+
+Specifying C<inflate_float>, C<inflate_integer>, and
+C<inflate_datetime> is likely to be helpful with this option.
+
+=item datetime_formatter
+
+When encoding a DateTime object, by default C<TOML::Tiny> will use the
+default formatter. This is not right for TOML which requires RFC3339.
+If you have C<DateTime::Format::RFC3339> available, use this instead:
+
+ my $parser = TOML::Tiny->new(
+ datetime_formatter => DateTime::Format::RFC3339->new(),
+ );
+
=back
=head2 decode
on test => sub{
requires 'Data::Dumper' => '0';
requires 'DateTime::Format::RFC3339' => '0';
+ requires 'DateTime::Format::ISO8601' => '0';
+ requires 'Types::Serialiser' => '0';
requires 'Math::BigInt' => '>= 1.999718';
requires 'TOML::Parser' => '0';
requires 'Test2::V0' => '0';
my ($self, $data) = @_;
TOML::Tiny::Writer::to_toml($data,
strict_arrays => $self->{strict_arrays},
+ datetime_formatter => $self->{datetime_formatter},
+ no_string_guessing => $self->{no_string_guessing},
);
}
=item inflate_integer
TOML integers are 64 bit and may not match the size of the compiled perl's
-internal integer type. By default, integers are left as-is as perl strings
-which may be upgraded as needed by the caller.
+internal integer type. By default, integers other than smallish
+decimal integers are left as-is as perl strings which may be upgraded
+as needed by the caller.
my $parser = TOML::Tiny->new(
inflate_integer => sub{
anyway), C<strict_arrays> will produce an error when encountering arrays with
heterogenous types.
+=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 numbers, or like datetimes, will be encoded as such.
+
+With no_string_guessing, C<TOML::Tiny> will look at the perl innards
+to find the currently stored value type. If it is a number, the
+scalar will be encoded as a number. If it's a string, as a string.
+Dates and times which weren't built with DateTime come out as strings.
+
+Specifying C<inflate_float>, C<inflate_integer>, and
+C<inflate_datetime> is likely to be helpful with this option.
+
+=item datetime_formatter
+
+When encoding a DateTime object, by default C<TOML::Tiny> will use the
+default formatter. This is not right for TOML which requires RFC3339.
+If you have C<DateTime::Format::RFC3339> available, use this instead:
+
+ my $parser = TOML::Tiny->new(
+ datetime_formatter => DateTime::Format::RFC3339->new(),
+ );
+
=back
=head2 decode
--- /dev/null
+
+package TOML::Tiny::Faithful;
+use parent TOML::Tiny;
+use DateTime::Format::ISO8601;
+use DateTime::Format::RFC3339;
+
+use DateTime;
+use Types::Serialiser; # ensures that Parser DTRT with booleans
+
+our @EXPORT = qw(
+ from_toml
+ to_toml
+);
+
+sub _options {
+ inflate_datetime => sub {
+ # RFC3339 bombs out if there is no timezone, so we parse with 8601
+ DateTime::Format::ISO8601->parse_datetime(shift)
+ },
+ inflate_integer => sub {
+ use bignum;
+ my $s = shift;
+ $s =~ m/^0o/
+ ? Math::BigInt->from_oct($')
+ : Math::BigInt->new($s);
+ },
+ inflate_float => sub { 0. + shift; },
+ no_string_guessing => 1,
+ datetime_formatter => TOML::Tiny::Faithful::DateTime::Formatter->new(),
+}
+
+sub new {
+ my ($class, %param) = @_;
+ bless TOML::Tiny->new(_options(), %param), $class;
+}
+sub from_toml {
+ my $source = shift;
+ TOML::Tiny::from_toml($source, _options(), @_);
+}
+sub to_toml {
+ my $source = shift;
+ TOML::Tiny::to_toml($source, _options(), @_);
+}
+
+package TOML::Tiny::Faithful::DateTime::Formatter;
+use DateTime::Format::RFC3339;
+
+our $base = DateTime::Format::RFC3339->new();
+
+sub new ($) {
+ my ($class) = @_;
+ bless { }, $class;
+}
+
+sub format_datetime {
+ my ($self,$dt) = @_;
+ # RFC3339 always prints a timezone. This is correct for RFC3339
+ # but in our application we sometimes have "local datetime"s
+ # where the time_zone is DateTime::TimeZone::Floating.
+ # We could use ISO8601 but it never prints the nanoseconds.
+ # It is easier to strip the timezone offset than add the ns.
+ my $r = DateTime::Format::RFC3339->new()->format_datetime($dt);
+ if ((ref $dt->time_zone()) =~ m/Floating/) {
+ $r =~ s/\+[0-9:.]+$//;
+ }
+ $r
+}
+
+1;
+
+=head1 SYNOPSIS
+
+ use TOML::Tiny::Faithful qw(from_toml to_toml);
+
+ binmode STDIN, ':encoding(UTF-8)';
+ binmode STDOUT, ':encoding(UTF-8)';
+
+ # Decoding TOML
+ my $toml = do{ local $/; <STDIN> };
+ my ($parsed, $error) = from_toml $toml;
+
+ # Encoding TOML
+ say to_toml({
+ stuff => {
+ about => ['other', 'stuff'],
+ },
+ });
+
+ # Object API
+ my $parser = TOML::Tiny::Faithful->new;
+ my $data = $parser->decode($toml);
+ say $parser->encode($data);
+
+
+=head1 DESCRIPTION
+
+C<TOML::Tiny::Faithful> is a trivial wrapper around C<TOML::Tiny>
+which sets C<inflate_integer>, C<inflate_float>, C<inflate_datetime>,
+C<no_string_guessing> and C<datetime_formatter> to try to make the
+TOML output faithful to any input TOML.
+
+=head1 SEE ALSO
+
+=over
+
+=item L<TOML::Tiny>
+
+=back
sub tokenize_integer {
$_[1] =~ tr/_+//d;
- $_[1];
+ $_[1] !~ m/^0[xob]/ && $_[1] + 0 eq $_[0] ? $_[1] + 0 : "$_[1]"
}
sub tokenize_string {
my @KEYS;
+use B qw( svref_2object SVf_IOK SVf_NOK );
+
sub to_toml {
my $data = shift;
my %param = @_;
}
when (/DateTime/) {
- return $data->stringify;
+ my $formatter = $param{datetime_formatter};
+ return $formatter ? $formatter->format_datetime($data) : "$data";
}
when ('Math::BigInt') {
return $data->bnstr;
}
+ when (!! $param{no_string_guessing}) {
+ # Thanks to ikegami on Stack Overflow for the trick!
+ # https://stackoverflow.com/questions/12686335/how-to-tell-apart-numeric-scalars-and-string-scalars-in-perl/12693984#12693984
+
+ my $sv = svref_2object(\$data);
+ my $svflags = $sv->FLAGS;
+
+ if ($svflags & (SVf_IOK | SVf_NOK)) {
+ return $data;
+ } else {
+ return to_toml_string($data);
+ }
+ }
+
when ('') {
for ($data) {
when (looks_like_number($_)) {
--- /dev/null
+use utf8;
+use Test2::V0;
+use Data::Dumper;
+use DateTime;
+use DateTime::Format::RFC3339;
+use Math::BigInt;
+use Math::BigFloat;
+use TOML::Tiny::Faithful;
+
+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 $parsed = from_toml($input);
+my $actual = norm(to_toml($parsed));
+my $expected = norm($input);
+
+is($actual, $expected, 'round trip') or do{
+ diag 'EXPECTED:';
+ diag Dumper($expected);
+
+ diag 'ACTUAL:';
+ diag Dumper($actual);
+};
+
+done_testing;
~ianmdlvl / nailing-cargo.git / commitdiff