view release on metacpan or  search on metacpan

lib/DMS/Parser.pm  view on Meta::CPAN

            INNER: while (1) {
                if ($$src_ref =~ /$bulk_re/gc) {
                    my $k = $1;
                    if (exists $t->{$k}) {
                        # Roll back to start of the current line for accurate error pos.
                        my $cur = pos($$src_ref);
                        while ($cur > 0 && substr($$src_ref, $cur - 1, 1) ne "\n") { $cur--; }
                        $self->{pos} = $cur;
                        $self->{line} = $line;
                        $self->{line_start} = $cur;
                        $self->_die("duplicate key: $k");
                    }
                    my $val;
                    if (defined $2) {
                        my $iv = 0 + $2;
                        $val = bless \$iv, 'DMS::Parser::Integer';
                    } elsif (defined $3) {
                        my $iv = 0 + $3;
                        $val = bless \$iv, 'DMS::Parser::Integer';
                    } elsif (defined $4) {
                        my $bv = $4 eq 'true' ? 1 : 0;
                        $val = bless \$bv, 'DMS::Parser::Bool';
                    } elsif (defined $5) {
                        # ASCII-only basic string, no escapes / no NFC.
                        $val = $5;
                    } elsif (defined $6) {
                        # '[]' or '{}'.
                        $val = $6 eq '[]' ? [] : { $ORDER_KEY => [] };
                    } else {
                        # $7: decimal float.
                        my $fv = 0 + $7;
                        $val = bless \$fv, 'DMS::Parser::Float';
                    }
                    push @$order, $k if $order;
                    $t->{$k} = $val;
                    $line++;
                    next INNER;
                }
                # Blank line at any leading whitespace.
                if ($$src_ref =~ /\G[ \t]*\r?\n/gc) {
                    $line++;
                    next INNER;
                }
                # Single-line `#` comment (NOT `###` labeled block) or `//`.
                # Excludes `/*` (C-style block) which spans multiple lines.
                # bench_realistic is 56% comments — taking these in the
                # bulk loop avoids hundreds of _skip_trivia method calls.
                if ($$src_ref =~ /\G[ \t]*(?:#(?!##)|\/\/(?!\*))[^\n\r]*\r?\n/gc) {
                    $line++;
                    next INNER;
                }
                last INNER;
            }
            $self->{pos} = pos($$src_ref) // $self->{pos};
            $self->{line} = $line;
            $self->{line_start} = $self->{pos};
        }
        $self->_skip_trivia;
        last if $self->{pos} >= $self->{len};
        # Inline _measure_line_indent: hot enough that the call cost
        # matters across 50k iterations. For indent==0 (most flat
        # tables) we can skip the regex when pos is already at
        # line_start with no leading space — by far the common case.
        my $li;
        if ($indent == 0 && $self->{pos} == $self->{line_start}
            && substr($self->{src}, $self->{pos}, 1) ne ' ') {
            $li = 0;
        } else {
            pos($self->{src}) = $self->{line_start};
            $li = $self->{src} =~ /\G( +)/g ? length($1) : 0;
        }
        last if $li < $indent;
        if ($li != $indent) {
            die $self->_err_at($self->{line}, $self->{line_start}, $self->{line_start}+$indent,
                "inconsistent indent: expected $indent spaces, got $li");
        }
        $self->{pos} = $self->{line_start} + $indent;
        # SPEC §Lexical "Reserved decorator sigils": reject ! @ $ % ^ & *
        # | ~ ` . , > < ? ; = as the first non-whitespace character of a
        # body line. We sit at exactly that position now (line_start +
        # structural indent), so a single-char check is sufficient.
        $self->_check_reserved_sigil;
        my ($k, $v);
        if ($lite) {
            # Inlined fast-path of parse_kvpair: skip the eval frame and
            # the path push/pop that parse_kvpair adds for non-lite modes.
            $k = $self->parse_key;
            $self->_die("expected ':' after key")
                if substr($self->{src}, $self->{pos}, 1) ne ':';
            $v = $self->_parse_kvpair_after_key($indent);
            $self->_die("duplicate key: $k") if exists $t->{$k};
            push @$order, $k if $order;
            $t->{$k} = $v;
        } else {
            ($k, $v) = $self->parse_kvpair($indent);
            $self->_die("duplicate key: $k") if exists $t->{$k};
            $t->{$k} = $v;
        }
    }
    # Block close: leftover pending comments float on the enclosing
    # container (this table itself).
    $self->_flush_pending_as_floating unless $lite;
    return $t;
}

sub parse_list_block {
    my ($self, $indent) = @_;
    my @items;
    while (1) {
        $self->_skip_trivia;
        last if $self->_eof;
        my $li = $self->_measure_line_indent;
        last if $li < $indent;
        if ($li != $indent) {
            die $self->_err_at($self->{line}, $self->{line_start}, $self->{line_start}+$indent,
                "inconsistent indent: expected $indent spaces, got $li");
        }
        $self->{pos} = $self->{line_start} + $indent;
        if ($self->_peek ne '+') { last; }
        # Commit to a new list item: push its index, attach pending
        # leading comments to it, then parse the value.