1 package TOML::Tiny::Writer;
5 no warnings qw(experimental);
9 use DateTime::Format::RFC3339;
10 use Scalar::Util qw(looks_like_number);
11 use TOML::Tiny::Grammar;
12 use TOML::Tiny::Util qw(is_strict_array);
23 # Generate simple key/value pairs for scalar data
24 for my $k (grep{ ref($data->{$_}) !~ /HASH|ARRAY/ } sort keys %$data) {
25 my $key = to_toml_key($k);
26 my $val = to_toml($data->{$k}, %param);
27 push @buff, "$key=$val";
30 # For values which are arrays, generate inline arrays for non-table
31 # values, array-of-tables for table values.
32 ARRAY: for my $k (grep{ ref $data->{$_} eq 'ARRAY' } sort keys %$data) {
34 if (!@{$data->{$k}}) {
35 my $key = to_toml_key($k);
36 push @buff, "$key=[]";
43 # Sort table and non-table values into separate containers
44 for my $v (@{$data->{$k}}) {
45 if (ref $v eq 'HASH') {
46 push @table_array, $v;
52 # Non-table values become an inline table
54 my $key = to_toml_key($k);
55 my $val = to_toml(\@inline, %param);
56 push @buff, "$key=$val";
59 # Table values become an array-of-tables
64 push @buff, '', '[[' . join('.', map{ to_toml_key($_) } @KEYS) . ']]';
65 push @buff, to_toml($_);
73 for my $k (grep{ ref $data->{$_} eq 'HASH' } sort keys %$data) {
74 if (!keys(%{$data->{$k}})) {
76 my $key = to_toml_key($k);
77 push @buff, "$key={}";
81 push @buff, '', '[' . join('.', map{ to_toml_key($_) } @KEYS) . ']';
82 push @buff, to_toml($data->{$k}, %param);
89 if (@$data && $param{strict_arrays}) {
90 my ($ok, $err) = is_strict_array($data);
91 die "toml: found heterogenous array, but strict_arrays is set ($err)\n" unless $ok;
94 push @buff, '[' . join(', ', map{ to_toml($_, %param) } @$data) . ']';
100 } elsif ($$_ eq '0') {
103 push @buff, to_toml($$_, %param);
107 when (/JSON::PP::Boolean/) {
108 return $$data ? 'true' : 'false';
112 return $data->stringify;
115 when ('Math::BigInt') {
119 when ('Math::BigFloat') {
125 when (looks_like_number($_)) {
134 return to_toml_string($data);
140 die 'unhandled: '.Dumper($_);
150 if ($str =~ /^[-_A-Za-z0-9]+$/) {
174 $arg =~ s/([\x22\x5c\n\r\t\f\b])/$escape->{$1}/g;
175 $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
177 return '"' . $arg . '"';