view release on metacpan or  search on metacpan

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

sub _utf8_die {
    my ($s, $i) = @_;
    my $prefix = substr($s, 0, $i);
    my $line = 1 + ($prefix =~ tr/\n//);
    my $last_nl = rindex($prefix, "\n");
    my $col = $i - ($last_nl + 1) + 1;
    die "$line:$col: input is not valid UTF-8\n";
}

# Shared input-normalization for every public decode entry point.
# SPEC §"UTF-8 only, NFC-normalized": reject BOM at offset 0, reject
# malformed UTF-8 bytes (5/6-byte forms, > U+10FFFF, lone continuation
# bytes, overlongs, surrogates), reject U+0000 anywhere, then NFC the
# source. Returns the (possibly NFC'd) Perl-internal-encoded string.
sub _normalize_source {
    my ($src) = @_;
    # SPEC §"UTF-8 only, NFC-normalized": DMS source is plain UTF-8 with
    # no byte-order mark. A leading U+FEFF is not silently consumed —
    # reject it explicitly so encoding mistakes surface loudly. (BOMs
    # *inside* string/heredoc bodies are fine; this only fires at offset 0.)
    # We check for the raw UTF-8 BOM bytes (EF BB BF) before any decoding,
    # so the rejection is independent of how the caller passed `$src`.
    if (!utf8::is_utf8($src) && length($src) >= 3
        && substr($src, 0, 3) eq "\xEF\xBB\xBF") {
        die "1:1: BOM (U+FEFF) at file start is not allowed; DMS source is plain UTF-8\n";
    }
    # SPEC §"UTF-8 only": reject malformed UTF-8 bytes (codepoints
    # > U+10FFFF, lone continuation bytes, overlongs, surrogates encoded
    # as bytes). Perl's `utf8::decode` is permissive about 5/6-byte
    # forms and codepoints above U+10FFFF, so we additionally walk the
    # raw bytes to confirm strict UTF-8 conformance.
    if (!utf8::is_utf8($src)) {
        _validate_strict_utf8($src);
        my $copy = $src;
        if (!utf8::decode($copy)) {
            die "1:1: input is not valid UTF-8\n";
        }
        $src = $copy;
    }
    if (length($src) >= 1 && substr($src, 0, 1) eq "\x{FEFF}") {
        die "1:1: BOM (U+FEFF) at file start is not allowed; DMS source is plain UTF-8\n";
    }
    # U+0000 is not allowed anywhere in DMS source (see SPEC §Strings).
    if ((my $nul = index($src, "\0")) >= 0) {
        my $prefix = substr($src, 0, $nul);
        my $line = 1 + ($prefix =~ tr/\n//);
        my $last_nl = rindex($prefix, "\n");
        my $col = $nul - ($last_nl + 1) + 1;
        die "$line:$col: U+0000 (NUL) is not allowed in DMS source\n";
    }
    # SPEC §Unicode normalization: NFC the source before tokenization.