#-----------------------------------------------------------------------------
# Integer
#-----------------------------------------------------------------------------
+ (?<DecFirstChar> [1-9])
(?<DecChar> [0-9])
- (?<HexChar> (?&DecChar) | [a-f A-F])
+ (?<HexChar> [0-9 a-f A-F])
(?<OctChar> [0-7])
(?<BinChar> [01])
- (?<Dec> [-+]? (?&DecChar) (?: (?&DecChar) | (?: _ (?&DecChar) ))*)
+ (?<Zero> [-+]? 0)
+ (?<Dec> (?&Zero) | (?: [-+]? (?&DecFirstChar) (?: (?&DecChar) | (?: _ (?&DecChar) ))*))
(?<Hex> 0x (?&HexChar) (?: (?&HexChar) | (?: [_] (?&HexChar) ))*)
(?<Oct> 0o (?&OctChar) (?: (?&OctChar) | (?: [_] (?&OctChar) ))*)
(?<Bin> 0b (?&BinChar) (?: (?&BinChar) | (?: [_] (?&BinChar) ))*)
#-----------------------------------------------------------------------------
(?<Exponent> [eE] (?&Dec))
(?<SpecialFloat> [-+]? (?:inf) | (?:nan))
- (?<Fraction> [.] [_0-9]+)
+ (?<Fraction> [.] (?&Dec) )
(?<Float>
(?:
bless{
inflate_datetime => $param{inflate_datetime} || sub{ shift },
inflate_boolean => $param{inflate_boolean} || sub{ shift eq 'true' ? $TRUE : $FALSE },
+ strict_arrays => $param{strict_arrays},
annotated => $param{annotated},
}, $class;
}
my ($self, $toml) = @_;
$self->{tokenizer} = TOML::Tiny::Tokenizer->new(source => $toml);
- $self->{keys} = [];
- $self->{root} = {};
+ $self->{keys} = [];
+ $self->{root} = {};
+ $self->{tables} = {}; # "seen" hash of explicitly defined table names
$self->parse_table;
my $result = $self->{root};
delete $self->{tokenizer};
delete $self->{keys};
delete $self->{root};
+ delete $self->{tables};
return annotate($result) if $self->{annotated};
return $result;
sub set_keys {
my $self = shift;
- my $value = $self->parse_value;
+ my $value = shift // $self->parse_value;
my @keys = $self->get_keys;
my $key = pop @keys;
my $node = $self->scan_to_key(\@keys);
+ $self->parse_error(undef, 'duplicate key: '.join('.', @keys, $key))
+ if exists $node->{$key};
$node->{$key} = $value;
}
$self->push_keys($token);
$self->scan_to_key([$self->get_keys]);
+ my @keys = $self->get_keys;
+ my $key = join '.', @keys;
+ if (exists $self->{tables}{$key}) {
+ # Tables cannot be redefined, *except* when doing so within a goddamn table
+ # array. Gawd I hate TOML.
+ my $in_a_stupid_table_array = 0;
+ my $node = $self->{root};
+ for my $key (@keys) {
+ if (exists $node->{$key} && ref($node->{$key}) eq 'ARRAY') {
+ $in_a_stupid_table_array = 1;
+ last;
+ } else {
+ $node = $node->{$key};
+ }
+ }
+
+ $self->parse_error($token, "table $key is already defined")
+ unless $in_a_stupid_table_array;
+ } else {
+ $self->{tables}{$key} = 1;
+ }
+
TOKEN: while (my $token = $self->next_token) {
for ($token->type) {
next TOKEN when /EOL/;
}
}
+ 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;
+ }
+ }
+
return \@array;
}