From: Jeff Ober Date: Mon, 13 Jan 2020 18:27:22 +0000 (-0500) Subject: Flesh out docs, object API X-Git-Tag: nailing-cargo/1.0.0~234^2~47 X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=commitdiff_plain;h=c746ad5f884003427bf4c334372a529ad31f8cc9;p=nailing-cargo.git Flesh out docs, object API --- diff --git a/README.pod b/README.pod index c65dc47..7ef69a1 100644 --- a/README.pod +++ b/README.pod @@ -49,21 +49,109 @@ L modules, and could even be used to override C<$TOML::Parser>: =head1 EXPORTS +C exports the following to functions for compatibility with the +C module. See L. + =head2 from_toml +Parses a string of C-formatted source and returns the resulting data +structure. Any arguments after the first are passed to L's +constructor. + +If there is a syntax error in the C source, C 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 and an error message. + + my ($result, $error) = from_toml($toml_string); + =head2 to_toml +Encodes a hash ref as a C-formatted string. + + my $toml = to_toml({foo => {'bar' => 'bat'}}); + + # [foo] + # bar="bat" + =head1 OBJECT API =head2 new +=over + +=item inflate_datetime + +By default, C treats TOML datetimes as strings in the generated +data structure. The C 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 document result in a C<1> or C<0>. +If L is installed, they will instead be C +or C. + +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 specified homogenous arrays. This has since been removed and will no +longer be part of the standard as of C (as of the time of writing; the +author of C has gone back and forth on the issue, so no guarantees). + +By default, C is flexible and supports heterogenous arrays. If you +wish to require strictly typed arrays (for C's definition of "type", +anyway), C will produce an error when encountering arrays with +heterogenous types. + +=item annotated + +This is an internal flag to produce and expect C compliant with +L. + +=back + =head2 decode +Decodes C and returns a hash ref. Dies on parse error. + =head2 encode +Encodes a perl hash ref as a C-formatted string. Dies when encountering +an array of mixed types if C was set. + =head2 parse -=head1 COMPATIBILITY +Alias for C to provide compatibility with C when +overriding the parser by setting C<$TOML::Parser>. + +=head1 DIFFERENCES FROM TOML AND TOML::Parser MODULES + +=head1 TOML VERSION COMPATIBILITY =head1 AUTHOR diff --git a/TODO.md b/TODO.md deleted file mode 100644 index b597437..0000000 --- a/TODO.md +++ /dev/null @@ -1 +0,0 @@ -Script to test with https://github.com/BurntSushi/toml-test diff --git a/lib/TOML/Tiny.pm b/lib/TOML/Tiny.pm index 284a4ad..3ee6906 100644 --- a/lib/TOML/Tiny.pm +++ b/lib/TOML/Tiny.pm @@ -40,7 +40,7 @@ sub to_toml { #------------------------------------------------------------------------------- sub new { my ($class, %param) = @_; - bless{ parser => TOML::Tiny::Parser->new(%param) }, $class; + bless{ %param, parser => TOML::Tiny::Parser->new(%param) }, $class; } sub encode { @@ -50,7 +50,10 @@ 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}, + ); } #------------------------------------------------------------------------------- @@ -103,20 +106,109 @@ L modules, and could even be used to override C<$TOML::Parser>: =head1 EXPORTS +C exports the following to functions for compatibility with the +C module. See L. + =head2 from_toml +Parses a string of C-formatted source and returns the resulting data +structure. Any arguments after the first are passed to L's +constructor. + +If there is a syntax error in the C source, C 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 and an error message. + + my ($result, $error) = from_toml($toml_string); + =head2 to_toml +Encodes a hash ref as a C-formatted string. + + my $toml = to_toml({foo => {'bar' => 'bat'}}); + + # [foo] + # bar="bat" + =head1 OBJECT API =head2 new +=over + +=item inflate_datetime + +By default, C treats TOML datetimes as strings in the generated +data structure. The C 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 document result in a C<1> or C<0>. +If L is installed, they will instead be C +or C. + +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 specified homogenous arrays. This has since been removed and will no +longer be part of the standard as of C (as of the time of writing; the +author of C has gone back and forth on the issue, so no guarantees). + +By default, C is flexible and supports heterogenous arrays. If you +wish to require strictly typed arrays (for C's definition of "type", +anyway), C will produce an error when encountering arrays with +heterogenous types. + +=item annotated + +This is an internal flag to produce and expect C compliant with +L. + +=back + =head2 decode +Decodes C and returns a hash ref. Dies on parse error. + =head2 encode +Encodes a perl hash ref as a C-formatted string. Dies when encountering +an array of mixed types if C was set. + =head2 parse +Alias for C to provide compatibility with C when +overriding the parser by setting C<$TOML::Parser>. + + +=head1 DIFFERENCES FROM TOML AND TOML::Parser MODULES + -=head1 COMPATIBILITY +=head1 TOML VERSION COMPATIBILITY diff --git a/lib/TOML/Tiny/Parser.pm b/lib/TOML/Tiny/Parser.pm index e69624f..e20a314 100644 --- a/lib/TOML/Tiny/Parser.pm +++ b/lib/TOML/Tiny/Parser.pm @@ -11,6 +11,7 @@ use List::Util qw(all); 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; @@ -329,37 +330,9 @@ sub parse_inline_array { } 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; diff --git a/lib/TOML/Tiny/Util.pm b/lib/TOML/Tiny/Util.pm new file mode 100644 index 0000000..c5fc35f --- /dev/null +++ b/lib/TOML/Tiny/Util.pm @@ -0,0 +1,59 @@ +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; diff --git a/lib/TOML/Tiny/Writer.pm b/lib/TOML/Tiny/Writer.pm index d9f21b3..e127a0e 100644 --- a/lib/TOML/Tiny/Writer.pm +++ b/lib/TOML/Tiny/Writer.pm @@ -6,21 +6,29 @@ no warnings qw(experimental); 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"; } @@ -38,7 +46,7 @@ sub to_toml { if (@inline) { my $key = to_toml_key($k); - my $val = to_toml(\@inline); + my $val = to_toml(\@inline, %param); push @buff, "$key=$val"; } @@ -50,7 +58,7 @@ sub to_toml { 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"; } } @@ -62,13 +70,18 @@ sub to_toml { 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') { @@ -77,7 +90,7 @@ sub to_toml { } elsif ($$_ eq '0') { return 'false'; } else { - push @buff, to_toml($$_); + push @buff, to_toml($$_, %param); } } @@ -89,6 +102,14 @@ sub to_toml { return $data->stringify; } + when ('Math::BigInt') { + return $data->bstr; + } + + when ('Math::BigFloat') { + return $data->bnstr; + } + when ('') { for ($data) { when (looks_like_number($_)) { @@ -105,18 +126,6 @@ sub to_toml { } } - when ('Math::BigInt') { - return $data->bstr; - } - - when ('Math::BigFloat') { - return $data->bnstr; - } - - when (defined) { - die 'unhandled: '.Dumper($_); - } - default{ die 'unhandled: '.Dumper($_); } @@ -154,4 +163,56 @@ sub to_toml_string { 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; diff --git a/t/writer.t b/t/writer.t index e6bdf7c..f88e5a6 100644 --- a/t/writer.t +++ b/t/writer.t @@ -1,12 +1,31 @@ use Test2::V0; use TOML::Tiny; -my $src = do{ local $/; }; -my $data = from_toml($src); -my $toml = to_toml($data); -my $got = from_toml($toml); +my $src = do{ local $/; }; -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; @@ -15,6 +34,8 @@ __DATA__ 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 diff --git a/test-bin/to-toml b/test-bin/to-toml index 490c5ac..0862230 100755 --- a/test-bin/to-toml +++ b/test-bin/to-toml @@ -6,73 +6,15 @@ 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 $/; }; 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;