=head1 EXPORTS
+C<TOML::Tiny> exports the following to functions for compatibility with the
+C<TOML> module. See L<TOML/FUNCTIONS>.
+
=head2 from_toml
+Parses a string of C<TOML>-formatted source and returns the resulting data
+structure. Any arguments after the first are passed to L<TOML::Tiny::Parser>'s
+constructor.
+
+If there is a syntax error in the C<TOML> source, C<from_toml> will die with
+an explanation which includes the line number of the error.
+
+ my $result = eval{ from_toml($toml_string) };
+
+Alternately, this routine may be called in list context, in which case syntax
+errors will result in returning two values, C<undef> and an error message.
+
+ my ($result, $error) = from_toml($toml_string);
+
=head2 to_toml
+Encodes a hash ref as a C<TOML>-formatted string.
+
+ my $toml = to_toml({foo => {'bar' => 'bat'}});
+
+ # [foo]
+ # bar="bat"
+
=head1 OBJECT API
=head2 new
+=over
+
+=item inflate_datetime
+
+By default, C<TOML::Tiny> treats TOML datetimes as strings in the generated
+data structure. The C<inflate_datetime> parameter allows the caller to provide
+a routine to intercept those as they are generated:
+
+ use DateTime::Format::RFC3339;
+
+ my $parser = TOML::Tiny->new(
+ inflate_datetime => sub{
+ my $dt_string = shift;
+ return DateTime::Format::RFC3339->parse_datetime($dt_string);
+ },
+ );
+
+=item inflate_boolean
+
+By default, boolean values in a C<TOML> document result in a C<1> or C<0>.
+If L<Types::Serialiser> is installed, they will instead be C<Types::Serialiser::true>
+or C<Types::Serialiser::false>.
+
+If you wish to override this, you can provide your own routine to generate values:
+
+ my $parser = TOML::Tiny->new(
+ inflate_boolean => sub{
+ my $bool = shift;
+ if ($bool eq 'true') {
+ return 'The Truth';
+ } else {
+ return 'A Lie';
+ }
+ },
+ );
+
+=item strict_arrays
+
+C<TOML v5> specified homogenous arrays. This has since been removed and will no
+longer be part of the standard as of C<v6> (as of the time of writing; the
+author of C<TOML> has gone back and forth on the issue, so no guarantees).
+
+By default, C<TOML::Tiny> is flexible and supports heterogenous arrays. If you
+wish to require strictly typed arrays (for C<TOML>'s definition of "type",
+anyway), C<strict_arrays> will produce an error when encountering arrays with
+heterogenous types.
+
+=item annotated
+
+This is an internal flag to produce and expect C<JSON> compliant with
+L<BurntSushi's TOML test suite|https://github.com/BurntSushi/toml-test>.
+
+=back
+
=head2 decode
+Decodes C<TOML> and returns a hash ref. Dies on parse error.
+
=head2 encode
+Encodes a perl hash ref as a C<TOML>-formatted string. Dies when encountering
+an array of mixed types if C<strict_arrays> was set.
+
=head2 parse
-=head1 COMPATIBILITY
+Alias for C<encode> to provide compatibility with C<TOML::Parser> when
+overriding the parser by setting C<$TOML::Parser>.
+
+=head1 DIFFERENCES FROM TOML AND TOML::Parser MODULES
+
+=head1 TOML VERSION COMPATIBILITY
=head1 AUTHOR
+++ /dev/null
-Script to test with https://github.com/BurntSushi/toml-test
#-------------------------------------------------------------------------------
sub new {
my ($class, %param) = @_;
- bless{ parser => TOML::Tiny::Parser->new(%param) }, $class;
+ bless{ %param, parser => TOML::Tiny::Parser->new(%param) }, $class;
}
sub encode {
sub decode {
my ($self, $data) = @_;
- TOML::Tiny::Writer::to_toml($data);
+ TOML::Tiny::Writer::to_toml($data,
+ annotated => $self->{annotated},
+ strict_arrays => $self->{strict_arrays},
+ );
}
#-------------------------------------------------------------------------------
=head1 EXPORTS
+C<TOML::Tiny> exports the following to functions for compatibility with the
+C<TOML> module. See L<TOML/FUNCTIONS>.
+
=head2 from_toml
+Parses a string of C<TOML>-formatted source and returns the resulting data
+structure. Any arguments after the first are passed to L<TOML::Tiny::Parser>'s
+constructor.
+
+If there is a syntax error in the C<TOML> source, C<from_toml> will die with
+an explanation which includes the line number of the error.
+
+ my $result = eval{ from_toml($toml_string) };
+
+Alternately, this routine may be called in list context, in which case syntax
+errors will result in returning two values, C<undef> and an error message.
+
+ my ($result, $error) = from_toml($toml_string);
+
=head2 to_toml
+Encodes a hash ref as a C<TOML>-formatted string.
+
+ my $toml = to_toml({foo => {'bar' => 'bat'}});
+
+ # [foo]
+ # bar="bat"
+
=head1 OBJECT API
=head2 new
+=over
+
+=item inflate_datetime
+
+By default, C<TOML::Tiny> treats TOML datetimes as strings in the generated
+data structure. The C<inflate_datetime> parameter allows the caller to provide
+a routine to intercept those as they are generated:
+
+ use DateTime::Format::RFC3339;
+
+ my $parser = TOML::Tiny->new(
+ inflate_datetime => sub{
+ my $dt_string = shift;
+ return DateTime::Format::RFC3339->parse_datetime($dt_string);
+ },
+ );
+
+=item inflate_boolean
+
+By default, boolean values in a C<TOML> document result in a C<1> or C<0>.
+If L<Types::Serialiser> is installed, they will instead be C<Types::Serialiser::true>
+or C<Types::Serialiser::false>.
+
+If you wish to override this, you can provide your own routine to generate values:
+
+ my $parser = TOML::Tiny->new(
+ inflate_boolean => sub{
+ my $bool = shift;
+ if ($bool eq 'true') {
+ return 'The Truth';
+ } else {
+ return 'A Lie';
+ }
+ },
+ );
+
+=item strict_arrays
+
+C<TOML v5> specified homogenous arrays. This has since been removed and will no
+longer be part of the standard as of C<v6> (as of the time of writing; the
+author of C<TOML> has gone back and forth on the issue, so no guarantees).
+
+By default, C<TOML::Tiny> is flexible and supports heterogenous arrays. If you
+wish to require strictly typed arrays (for C<TOML>'s definition of "type",
+anyway), C<strict_arrays> will produce an error when encountering arrays with
+heterogenous types.
+
+=item annotated
+
+This is an internal flag to produce and expect C<JSON> compliant with
+L<BurntSushi's TOML test suite|https://github.com/BurntSushi/toml-test>.
+
+=back
+
=head2 decode
+Decodes C<TOML> and returns a hash ref. Dies on parse error.
+
=head2 encode
+Encodes a perl hash ref as a C<TOML>-formatted string. Dies when encountering
+an array of mixed types if C<strict_arrays> was set.
+
=head2 parse
+Alias for C<encode> to provide compatibility with C<TOML::Parser> when
+overriding the parser by setting C<$TOML::Parser>.
+
+
+=head1 DIFFERENCES FROM TOML AND TOML::Parser MODULES
+
-=head1 COMPATIBILITY
+=head1 TOML VERSION COMPATIBILITY
use Scalar::Util qw(looks_like_number);
use TOML::Tiny::Grammar;
use TOML::Tiny::Tokenizer;
+use TOML::Tiny::Util qw(is_strict_array);
our $TRUE = 1;
our $FALSE = 0;
}
if (@array > 1 && $self->{strict_arrays}) {
- my @types = map{
- my $type;
-
- if (my $ref = ref $_) {
- $type = $ref eq 'ARRAY' ? 'array' : 'table';
- }
- else {
- if (/^(true|false)$/) {
- $type = 'bool';
- }
- elsif (looks_like_number($_)) {
- if ("$_" =~ /[.]/) {
- $type = 'float';
- } else {
- $type = 'integer';
- }
- }
- elsif (/(?&DateTime) $TOML/x) {
- $type = 'datetime';
- }
- else {
- $type = 'string';
- }
- }
- } @array;
-
- my $t = shift @types;
- for (@types) {
- $self->parse_error(undef, "expected value of type $t, but found $_")
- if $_ ne $t;
- }
+ my ($ok, $err) = is_strict_array(\@array);
+ $self->parse_error(undef, $err)
+ unless $ok;
}
return \@array;
--- /dev/null
+package TOML::Tiny::Util;
+
+use strict;
+use warnings;
+no warnings 'experimental';
+use v5.18;
+
+use Scalar::Util qw(looks_like_number);
+use TOML::Tiny::Grammar;
+
+use parent 'Exporter';
+
+our @EXPORT_OK = qw(
+ is_strict_array
+);
+
+sub is_strict_array {
+ my $arr = shift;
+
+ my @types = map{
+ my $value = $_;
+ my $type;
+
+ for (ref $value) {
+ $type = 'array' when /ARRAY/;
+ $type = 'table' when /HASH/;
+ $type = 'float' when /Math::BigFloat/;
+ $type = 'integer' when /Math::BigInt/;
+ $type = 'bool' when /JSON::PP::Boolean/;
+
+ when ('') {
+ for ($value) {
+ $type = 'bool' when /(?&Boolean) $TOML/x;
+ $type = 'float' when /(?&Float) $TOML/x;
+ $type = 'integer' when /(?&Integer) $TOML/x;
+ $type = 'datetime' when /(?&DateTime) $TOML/x;
+ default{ $type = 'string' };
+ }
+ }
+
+ default{
+ $type = $_;
+ }
+ }
+
+ $type;
+ } @$arr;
+
+ my $t = shift @types;
+
+ for (@types) {
+ return (undef, "expected value of type $t, but found $_")
+ if $_ ne $t;
+ }
+
+ return (1, undef);
+}
+
+1;
use v5.18;
use Data::Dumper;
+use DateTime::Format::RFC3339;
use Scalar::Util qw(looks_like_number);
use Math::BigFloat;
use TOML::Tiny::Grammar;
+use TOML::Tiny::Util qw(is_strict_array);
my @KEYS;
sub to_toml {
my $data = shift;
+ my %param = @_;
+
+ if ($param{annotated} && caller ne 'TOML:Tiny::Writer') {
+ $data = deannotate($data);
+ }
+
my @buff;
for (ref $data) {
when ('HASH') {
for my $k (grep{ ref($data->{$_}) !~ /HASH|ARRAY/ } sort keys %$data) {
my $key = to_toml_key($k);
- my $val = to_toml($data->{$k});
+ my $val = to_toml($data->{$k}, %param);
push @buff, "$key=$val";
}
if (@inline) {
my $key = to_toml_key($k);
- my $val = to_toml(\@inline);
+ my $val = to_toml(\@inline, %param);
push @buff, "$key=$val";
}
for my $k (sort keys %$_) {
my $key = to_toml_key($k);
- my $val = to_toml($_->{$k});
+ my $val = to_toml($_->{$k}, %param);
push @buff, "$key=$val";
}
}
for my $k (grep{ ref $data->{$_} eq 'HASH' } sort keys %$data) {
push @KEYS, $k;
push @buff, '', '[' . join('.', map{ to_toml_key($_) } @KEYS) . ']';
- push @buff, to_toml($data->{$k});
+ push @buff, to_toml($data->{$k}, %param);
pop @KEYS;
}
}
when ('ARRAY') {
- push @buff, '[' . join(', ', map{ to_toml($_) } @$data) . ']';
+ if (@$data && $param{strict_arrays}) {
+ my ($ok, $err) = is_strict_array($data);
+ die "toml: found heterogenous array, but strict_arrays is set ($err)\n" unless $ok;
+ }
+
+ push @buff, '[' . join(', ', map{ to_toml($_, %param) } @$data) . ']';
}
when ('SCALAR') {
} elsif ($$_ eq '0') {
return 'false';
} else {
- push @buff, to_toml($$_);
+ push @buff, to_toml($$_, %param);
}
}
return $data->stringify;
}
+ when ('Math::BigInt') {
+ return $data->bstr;
+ }
+
+ when ('Math::BigFloat') {
+ return $data->bnstr;
+ }
+
when ('') {
for ($data) {
when (looks_like_number($_)) {
}
}
- when ('Math::BigInt') {
- return $data->bstr;
- }
-
- when ('Math::BigFloat') {
- return $data->bnstr;
- }
-
- when (defined) {
- die 'unhandled: '.Dumper($_);
- }
-
default{
die 'unhandled: '.Dumper($_);
}
return '"' . $arg . '"';
}
+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;
+ }
+ }
+}
+
1;
use Test2::V0;
use TOML::Tiny;
-my $src = do{ local $/; <DATA> };
-my $data = from_toml($src);
-my $toml = to_toml($data);
-my $got = from_toml($toml);
+my $src = do{ local $/; <DATA> };
-is $got, $data, 'to_toml <=> from_toml';
+subtest basics => sub{
+ my $data = from_toml($src);
+ my $toml = to_toml($data);
+ my $got = from_toml($toml);
+ is $got, $data, 'to_toml <=> from_toml';
+};
+
+subtest strict_arrays => sub{
+ subtest with_bad_array => sub{
+ my ($data, $error) = from_toml $src, strict_arrays => 1;
+ is $data, U, 'result undefined';
+ ok $error, 'error message';
+ like $error, qr/expected value of type/, $error, 'expected error';
+ };
+
+ subtest without_bad_array => sub{
+ my $toml = $src;
+ $toml =~ s/^hetero_array.*$//m;
+ my ($data, $error) = from_toml $toml, strict_arrays => 1;
+ ok $data, 'result defined';
+ ok !$error, 'no error';
+ };
+};
done_testing;
title = "TOML Example"
+hetero_array = ["life", "universe", "everything", 42]
+
[owner]
name = "Tom Preston-Werner"
dob = 1979-05-27T07:32:00-08:00 # First class dates
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);
+my $toml = to_toml($json, strict_arrays => 1, annotated => 1);
say $toml;
~ianmdlvl / nailing-cargo.git / commitdiff