#! /usr/bin/env perl

# Simplified BSD License (FreeBSD License)
#
# Copyright (c) 2026, Daily Data Inc.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# 1. Redistributions of source code must retain the above copyright notice, this
#    list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright notice,
#    this list of conditions and the following disclaimer in the documentation
#    and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

# YAMLPatch.pm - a path-addressed, formatting-preserving editor for block-style YAML.
#
# Motivation: general YAML libraries (YAML::Tiny, YAML::XS) load a document into a data
# structure and, on save, re-serialize the WHOLE thing from that structure. That loses
# comments, re-sorts keys, re-quotes scalars, and can silently reinterpret bare words
# ('off' is a YAML 1.1 boolean). None of that is acceptable when the file being edited is a
# live config someone reads, or when other tooling asserts on the physical layout of specific
# lines (this module exists because exactly that happened - see sneakernet's TESTING.md Steps
# 2.1 and 3.1, which grep for lines by their position relative to a heading).
#
# YAMLPatch never builds a document model and re-serializes it. It parses just enough
# structure to map dotted paths ('transport.compression.method') to individual physical
# lines, and every mutation rewrites only the line(s) that path owns. Everything else in the
# file - comments, blank lines, key order, quoting style elsewhere - is untouched, byte for
# byte.
#
# This comes at a deliberate cost: only a restricted subset of YAML is supported (see
# "SUPPORTED SUBSET" below). Outside that subset, every operation refuses rather than
# guessing. A handful of constructs can be individually re-enabled as opaque, non-addressable
# values via the allow_* options - see 'RELAXATION FLAGS'.
#
# SUPPORTED SUBSET (parse fails outside this without the matching allow_* flag):
#   - 2-space-multiple indentation, no tabs, ever
#   - block mappings ('key:' / 'key: value'), one document
#   - block sequences of INLINE SCALARS ONLY ('- value'); a sequence item that itself opens a
#     nested map or sequence is outside the subset
#   - scalar values: bare, 'single-quoted', or "double-quoted" (double-quoted supports \" and
#     \\ only - no other escapes)
#   - full-line comments and trailing inline comments (' # ...' after a value)
#   - no anchors/aliases/tags, no flow collections ([...]/{...}), no block scalars (|/>), no
#     duplicate sibling keys, no second '---' document - unless explicitly allowed (below)
#
# RELAXATION FLAGS (passed to load_file/load_string), each accepts the named construct as an
# OPAQUE, whole-value leaf - located and replaceable as a unit, never parsed into or addressed
# by sub-path:
#   allow_flow         - a value starting with '[' or '{' is stored as opaque raw text
#   allow_block_scalar - a '|'/'>' block scalar (with its indented continuation lines) is
#                         stored as one opaque multi-line leaf
#   allow_anchors      - a value containing an anchor/alias/tag marker (&x, *x, !!tag) is
#                         stored as opaque raw text instead of being dequoted
#   allow_multidoc     - a second '---' document separator is permitted; everything from that
#                         line to EOF is preserved verbatim as an opaque trailing blob, never
#                         parsed or addressable
#
# The harness this module was built for passes NONE of these flags, by design - it wants the
# strict subset. They exist for this module's general-purpose use elsewhere.

package YAMLPatch;

use strict;
use warnings;
use Carp qw(croak);
use File::Basename qw(dirname basename);
use Fcntl qw(:flock O_WRONLY O_CREAT O_EXCL);

our $VERSION = '1.0.0';

# ---------------------------------------------------------------------------
# YAML 1.1 words that MUST NOT be emitted bare, because a stricter/different
# parser than the one that wrote them would read them as booleans/null rather
# than as the string the caller meant.
# ---------------------------------------------------------------------------
my $BOOLISH_RE = qr/^(?:true|false|yes|no|on|off|y|n|null|~)$/i;

# Characters that make a bare scalar ambiguous or structurally dangerous if
# they appear in the leading position (YAML indicator characters), plus the
# ': ' / trailing ':' / ' #' shapes that would be misread as structure.
sub _looks_safe_bare {
    my ($v) = @_;
    return 0 unless defined $v && length $v;
    return 0 if $v =~ /^\s|\s$/;              # leading/trailing whitespace
    return 0 if $v =~ /^[#\-\?:>|&*!%@`"'\[\]\{\},]/; # leading indicator char
    return 0 if $v =~ /:(?:\s|$)/;             # ': ' or trailing ':' mid-string
    return 0 if $v =~ /\s#/;                   # would start an inline comment
    return 0 if $v =~ /\n/;                    # no embedded newlines
    return 0 if $v =~ $BOOLISH_RE;              # YAML 1.1 boolean/null word
    return 1;
}

sub _default_style_for {
    my ($value) = @_;
    return 'single' if !defined $value || $value eq '';
    return 'single' if $value =~ $BOOLISH_RE;
    return 'bare' if _looks_safe_bare($value);
    return 'single';
}

# ---------------------------------------------------------------------------
# Construction / parsing
# ---------------------------------------------------------------------------

sub load_file {
    my ($class, $path, %opts) = @_;
    croak "YAMLPatch: load_file: no path given" unless defined $path && length $path;
    open my $fh, '<', $path or croak "YAMLPatch: cannot read '$path': $!";
    local $/;
    my $text = <$fh>;
    close $fh;
    $text = '' unless defined $text;
    my $self = $class->load_string($text, %opts);
    $self->{_source_path} = $path;
    return $self;
}

sub load_string {
    my ($class, $text, %opts) = @_;
    $text = '' unless defined $text;

    my $trailing_newline = ($text eq '' || $text =~ /\n\z/) ? 1 : 0;
    my $body = $text;
    $body =~ s/\n\z// if $trailing_newline && $text ne '';
    my @raw_lines = ($text eq '') ? () : split(/\n/, $body, -1);

    my $self = bless {
        raw_lines         => \@raw_lines,
        trailing_newline  => $trailing_newline,
        opts              => {
            allow_flow         => $opts{allow_flow}         ? 1 : 0,
            allow_block_scalar => $opts{allow_block_scalar} ? 1 : 0,
            allow_anchors      => $opts{allow_anchors}      ? 1 : 0,
            allow_multidoc     => $opts{allow_multidoc}     ? 1 : 0,
        },
        _source_path      => undef,
        _trailing_opaque  => [],   # lines from a second '---' onward, if allow_multidoc
        _intent           => { added => {}, removed => {}, changed => {} },
        _unsafe_used      => 0,
        _baseline_paths   => undef, # flattened real-path map at load / last successful save
        _original_text    => undef, # text as loaded / last successfully saved, for diff()
    }, $class;

    $self->{parsed} = $self->_parse(\@raw_lines, $self->{opts});
    $self->{_baseline_paths} = $self->_flatten_real();
    $self->{_original_text}  = $self->as_text;
    return $self;
}

# ---------------------------------------------------------------------------
# The parser. Returns a hashref:
#   { records => \@records, by_path => \%path_to_index, by_path_commented => \%... }
# @records has one entry per element of @raw_lines EXCEPT that a multi-line
# opaque value (block scalar, or the multidoc tail) is represented by a single
# record at its start index of kind 'kv'/'seqitem' with span => N, and the
# lines it consumes get a record of kind 'continuation' pointing back via
# 'owner'.
# ---------------------------------------------------------------------------

sub _parse {
    my ($self, $raw_lines, $ropts) = @_;
    my @records;
    my %by_path;
    my %by_path_commented;
    my @stack;   # each: { indent => N, key => 'name', kind => 'map'|'seq', seq_count => 0, path => 'a.b' }
    my $structuralSeen = 0;
    my $i = 0;
    my $n = scalar(@$raw_lines);

    while ($i < $n) {
        my $line = $raw_lines->[$i];

        # ---- multi-document tail -------------------------------------------------
        # A '---' before any real (mapping/sequence) content has been seen is just this
        # document's optional leading marker. A '---' AFTER real content - regardless of
        # whether THIS document had a leading marker of its own - starts a second document.
        if ($line =~ /^---\s*(?:#.*)?$/) {
            if (!$structuralSeen) {
                $records[$i] = { n => $i, raw => $line, kind => 'docstart' };
                $i++;
                next;
            }
            if (!$ropts->{allow_multidoc}) {
                croak "YAMLPatch: second '---' document separator at line " . ($i + 1)
                    . " - outside the supported subset (pass allow_multidoc => 1 to treat it,"
                    . " and everything after it, as an opaque trailing blob)";
            }
            # Everything from here to EOF is opaque and unaddressable.
            $self->{_trailing_opaque} = [ @$raw_lines[$i .. $n - 1] ];
            for my $j ($i .. $n - 1) {
                $records[$j] = { n => $j, raw => $raw_lines->[$j], kind => 'opaque_tail' };
            }
            last;
        }

        # ---- blank line -----------------------------------------------------------
        if ($line =~ /^\s*$/) {
            $records[$i] = { n => $i, raw => $line, kind => 'blank' };
            $i++;
            next;
        }

        my ($indent, $rest) = $self->_split_indent($line, $i);

        # A comment doesn't count as "real" content for leading-'---'-marker purposes,
        # but a sequence item or mapping key does - set once we reach either branch below.
        $structuralSeen = 1 if $rest !~ /^#/;

        # ---- full-line comment ------------------------------------------------------
        if ($rest =~ /^#(.*)$/) {
            my $commentText = $1;
            my $rec = { n => $i, raw => $line, kind => 'comment', indent => $indent };
            # Tentative path: what would this be if uncommented? Only meaningful for
            # '#key: value' or '#key:' shaped comments.
            if ($commentText =~ /^([A-Za-z_][\w-]*):(?:\s+(.*))?$/) {
                my ($ckey, $cval) = ($1, $2);
                my @tmp = @stack;
                pop @tmp while @tmp && $tmp[-1]{indent} >= $indent;
                my $parentPath = join('.', map { $_->{key} } @tmp);
                my $cpath = length($parentPath) ? "$parentPath.$ckey" : $ckey;
                $rec->{would_be_path} = $cpath;
                $rec->{would_be_key}  = $ckey;
                $by_path_commented{$cpath} ||= $i;
            }
            $records[$i] = $rec;
            $i++;
            next;
        }

        # ---- sequence item ------------------------------------------------------
        if ($rest =~ /^-(?:\s+(.*)|())$/) {
            my $val = defined $1 ? $1 : '';
            pop @stack while @stack && $stack[-1]{indent} > $indent;
            croak "YAMLPatch: sequence item with no owning key at line " . ($i + 1)
                unless @stack && $stack[-1]{indent} <= $indent;
            my $owner = $stack[-1];
            if ($owner->{kind} eq 'map' && !$owner->{has_inline_value}) {
                $owner->{kind} = 'seq';
            }
            croak "YAMLPatch: sequence item under a non-sequence key at line " . ($i + 1)
                unless $owner->{kind} eq 'seq';
            if ($val eq '') {
                croak "YAMLPatch: sequence item has no inline scalar at line " . ($i + 1)
                    . " - nested structures under a sequence item are outside the supported subset";
            }
            my ($value, $value_raw, $style, $note) = $self->_parse_scalar($val, $i, $ropts);
            my $idx = $owner->{seq_count}++;
            my $path = "$owner->{path}\[$idx]";
            $records[$i] = {
                n => $i, raw => $line, kind => 'seqitem', indent => $indent,
                path => $path, value => $value, value_raw => $value_raw,
                style => $style, inline_note => $note,
            };
            $by_path{$path} = $i;
            $i++;
            next;
        }

        # ---- mapping key ------------------------------------------------------
        if ($rest =~ /^([A-Za-z_][\w-]*):(?:\s+(.*)|())$/) {
            my ($key, $val) = ($1, defined $2 ? $2 : '');
            pop @stack while @stack && $stack[-1]{indent} >= $indent;
            my $parentPath = join('.', map { $_->{key} } @stack);
            my $path = length($parentPath) ? "$parentPath.$key" : $key;
            croak "YAMLPatch: duplicate key '$key' (path '$path') at line " . ($i + 1)
                if exists $by_path{$path};

            if ($val eq '') {
                # Container: a nested map or sequence follows (or this is a truly
                # empty/null value - indistinguishable until we see what follows;
                # we resolve that lazily via has_inline_value below).
                my $frame = {
                    indent => $indent, key => $key, kind => 'map',
                    seq_count => 0, path => $path, has_inline_value => 0,
                };
                $records[$i] = {
                    n => $i, raw => $line, kind => 'mapopen', indent => $indent,
                    path => $path, key => $key,
                };
                $by_path{$path} = $i;
                push @stack, $frame;
                $i++;
                next;
            }

            # Block scalar?
            if ($val =~ /^([|>])([+-]?)(\d*)\s*(?:#.*)?$/) {
                if (!$ropts->{allow_block_scalar}) {
                    croak "YAMLPatch: block scalar ('$val') at line " . ($i + 1)
                        . " - outside the supported subset (pass allow_block_scalar => 1 to treat"
                        . " it as an opaque leaf)";
                }
                my ($span, $blockText) = $self->_consume_block_scalar($raw_lines, $i, $indent);
                $records[$i] = {
                    n => $i, raw => $line, kind => 'kv', indent => $indent,
                    path => $path, key => $key, value => $blockText, value_raw => $val,
                    style => 'block_opaque', inline_note => undef, span => $span,
                };
                for my $j ($i + 1 .. $i + $span - 1) {
                    $records[$j] = { n => $j, raw => $raw_lines->[$j], kind => 'continuation', owner => $i };
                }
                $by_path{$path} = $i;
                push @stack, { indent => $indent, key => $key, kind => 'map', seq_count => 0, path => $path, has_inline_value => 1 };
                $i += $span;
                next;
            }

            my ($value, $value_raw, $style, $note) = $self->_parse_scalar($val, $i, $ropts);
            $records[$i] = {
                n => $i, raw => $line, kind => 'kv', indent => $indent,
                path => $path, key => $key, value => $value, value_raw => $value_raw,
                style => $style, inline_note => $note,
            };
            $by_path{$path} = $i;
            push @stack, { indent => $indent, key => $key, kind => 'map', seq_count => 0, path => $path, has_inline_value => 1 };
            $i++;
            next;
        }

        croak "YAMLPatch: line " . ($i + 1) . " is not blank / comment / 'key:' / 'key: value' /"
            . " '- item' - outside the supported subset: " . $line;
    }

    return { records => \@records, by_path => \%by_path, by_path_commented => \%by_path_commented };
}

sub _split_indent {
    my ($self, $line, $i) = @_;
    croak "YAMLPatch: tab character in indentation at line " . ($i + 1) if $line =~ /^\t/;
    my ($ws) = $line =~ /^( *)/;
    croak "YAMLPatch: tab character in indentation at line " . ($i + 1)
        if substr($line, length($ws), 1) eq "\t";
    my $indent = length($ws);
    croak "YAMLPatch: indentation not a multiple of 2 at line " . ($i + 1)
        if $indent % 2 != 0;
    return ($indent, substr($line, $indent));
}

sub _consume_block_scalar {
    my ($self, $raw_lines, $start, $keyIndent) = @_;
    my $n = scalar(@$raw_lines);
    my $j = $start + 1;
    my @content;
    while ($j < $n) {
        my $l = $raw_lines->[$j];
        if ($l !~ /^\s*$/) {
            my ($ind) = $l =~ /^( *)/;
            last if length($ind) <= $keyIndent;
        }
        push @content, $l;
        $j++;
    }
    # trim trailing blank lines from the captured block (they belong to whatever follows)
    pop @content while @content && $content[-1] =~ /^\s*$/;
    my $span = ($j - $start);
    # recompute span to only include what we kept, but continuation records must still
    # cover every raw line up to $j - 1 that is part of this block visually; simplest and
    # safe: span covers start..($start + scalar(@content)) i.e. only kept lines are "owned".
    # Any blank lines trimmed off are re-parsed normally on the next loop iteration.
    $span = scalar(@content) + 1;
    return ($span, join("\n", @content));
}

sub _parse_scalar {
    my ($self, $val, $i, $ropts) = @_;
    $val =~ s/^\s+//;

    # A real anchor/alias/tag sigil is immediately followed by an identifier character
    # ('&name', '*name', '!tag' / '!!type'). Require that, rather than a bare leading
    # sigil - otherwise an ordinary bare value that happens to start with '*' or '!'
    # (e.g. a redaction placeholder like '**redacted**') is misdetected as YAML metadata.
    if ($val =~ /^[&*][A-Za-z_]/ || $val =~ /^!(?:![A-Za-z]|[A-Za-z])/) {
        if (!$ropts->{allow_anchors}) {
            croak "YAMLPatch: anchor/alias/tag construct ('$val') at line " . ($i + 1)
                . " - outside the supported subset (pass allow_anchors => 1 to treat it as opaque)";
        }
        return ($val, $val, 'anchor_opaque', undef);
    }

    if ($val =~ /^[\[\{]/) {
        if (!$ropts->{allow_flow}) {
            croak "YAMLPatch: flow-style collection ('$val') at line " . ($i + 1)
                . " - outside the supported subset (pass allow_flow => 1 to treat it as opaque -"
                . " this is exactly the construct that made YAML::Tiny silently corrupt"
                . " sneakernet's cleanupScriptSchedule lists)";
        }
        my ($content, $note) = $self->_split_trailing_comment($val);
        return ($content, $content, 'flow_opaque', $note);
    }

    if ($val =~ /^'/) {
        if ($val =~ /^'([^']*)'(.*)$/) {
            my ($inner, $rest) = ($1, $2);
            my $note = $self->_require_comment_or_empty($rest, $i);
            return ($inner, "'$inner'", 'single', $note);
        }
        croak "YAMLPatch: malformed or unsupported single-quoted value at line " . ($i + 1)
            . " (embedded quotes are outside the supported subset): $val";
    }

    if ($val =~ /^"/) {
        if ($val =~ /^"((?:[^"\\]|\\.)*)"(.*)$/) {
            my ($inner, $rest) = ($1, $2);
            my $note = $self->_require_comment_or_empty($rest, $i);
            (my $unescaped = $inner) =~ s/\\(["\\])/$1/g;
            return ($unescaped, qq("$inner"), 'double', $note);
        }
        croak "YAMLPatch: malformed or unsupported double-quoted value at line " . ($i + 1) . ": $val";
    }

    my ($content, $note) = $self->_split_trailing_comment($val);
    $content =~ s/\s+$//;
    return ($content, $content, 'bare', $note);
}

sub _split_trailing_comment {
    my ($self, $str) = @_;
    if ($str =~ /^(.*?)\s+(#.*)$/) {
        return ($1, $2);
    }
    return ($str, undef);
}

sub _require_comment_or_empty {
    my ($self, $rest, $i) = @_;
    $rest =~ s/^\s+//;
    return undef if $rest eq '';
    return $rest if $rest =~ /^#/;
    croak "YAMLPatch: unexpected content after quoted value at line " . ($i + 1) . ": $rest";
}

# ---------------------------------------------------------------------------
# Read-only accessors
# ---------------------------------------------------------------------------

sub get {
    my ($self, $path) = @_;
    my $p = $self->{parsed};
    if (exists $p->{by_path}{$path}) {
        my $rec = $p->{records}[ $p->{by_path}{$path} ];
        return {
            value       => $rec->{value},
            value_raw   => $rec->{value_raw},
            style       => $rec->{style},
            line        => $rec->{n} + 1,
            commented   => 0,
            kind        => $rec->{kind},
        };
    }
    return undef;
}

sub exists_path {
    my ($self, $path) = @_;
    return exists $self->{parsed}{by_path}{$path} ? 1 : 0;
}

sub exists_commented {
    my ($self, $path) = @_;
    return exists $self->{parsed}{by_path_commented}{$path} ? 1 : 0;
}

sub path_list {
    my ($self) = @_;
    return sort keys %{ $self->{parsed}{by_path} };
}

sub as_text {
    my ($self) = @_;
    my $text = join("\n", @{ $self->{raw_lines} });
    $text .= "\n" if $self->{trailing_newline} && @{ $self->{raw_lines} };
    $text = '' unless @{ $self->{raw_lines} };
    return $text;
}

sub source_path { return $_[0]->{_source_path} }

# ---------------------------------------------------------------------------
# Internal: flatten the real (non-commented) paths to value strings, for
# gate-3 delta computation. Opaque/multi-line values flatten to their stored
# 'value' text as a single unit.
# ---------------------------------------------------------------------------

sub _flatten_real {
    my ($self) = @_;
    my %flat;
    my $p = $self->{parsed};
    for my $path (keys %{ $p->{by_path} }) {
        my $rec = $p->{records}[ $p->{by_path}{$path} ];
        next unless $rec->{kind} eq 'kv' || $rec->{kind} eq 'seqitem';
        $flat{$path} = $rec->{value};
    }
    return \%flat;
}

# ---------------------------------------------------------------------------
# Mutators. Every mutator: (1) operates on a COPY of raw_lines, (2) re-parses
# the copy under the same relaxation options to confirm it is still within
# the supported subset (this is gate 1/5, checked eagerly), (3) commits the
# copy as the new state, (4) records intent.
# ---------------------------------------------------------------------------

sub _apply_new_lines {
    my ($self, $new_lines) = @_;
    my $reparsed = $self->_parse($new_lines, $self->{opts});  # dies if out of subset
    $self->{raw_lines} = $new_lines;
    $self->{parsed} = $reparsed;
    return;
}

sub _record_changed {
    my ($self, $path, $old, $new) = @_;
    return if defined($old) && defined($new) && $old eq $new;
    if (exists $self->{_intent}{added}{$path}) {
        $self->{_intent}{added}{$path} = $new;
        return;
    }
    $self->{_intent}{changed}{$path} = [ $old, $new ];
}

sub _record_added   { my ($self, $path, $val) = @_; $self->{_intent}{added}{$path}   = $val; delete $self->{_intent}{removed}{$path}; }
sub _record_removed {
    my ($self, $path, $val) = @_;
    if (exists $self->{_intent}{added}{$path}) { delete $self->{_intent}{added}{$path}; return; }
    $self->{_intent}{removed}{$path} = $val;
}

sub set {
    my ($self, $path, $value, %opts) = @_;
    croak "YAMLPatch: set: value is undef (use delete() to remove '$path')" unless defined $value;
    my $p = $self->{parsed};

    unless (exists $p->{by_path}{$path}) {
        if (exists $p->{by_path_commented}{$path}) {
            croak "YAMLPatch: set('$path'): this path exists only as a commented-out line"
                . " (line " . ($p->{by_path_commented}{$path} + 1) . ") - call uncomment('$path')"
                . " first, or use insert_kv() if you intend to add a second, active copy";
        }
        croak "YAMLPatch: set('$path'): path does not exist";
    }

    my $idx = $p->{by_path}{$path};
    my $rec = $p->{records}[$idx];
    croak "YAMLPatch: set('$path'): not a scalar (kind=$rec->{kind}) - use insert_kv/insert_block instead"
        unless $rec->{kind} eq 'kv' || $rec->{kind} eq 'seqitem';
    croak "YAMLPatch: set('$path'): existing value is an opaque $rec->{style} construct - rewriting"
        . " it wholesale is not supported; delete() and insert_kv() instead"
        if defined $rec->{style} && $rec->{style} =~ /_opaque$/;

    my $style = $opts{style} // 'keep';
    if ($style eq 'keep') {
        $style = $rec->{style};
        if ($style eq 'bare' && !_looks_safe_bare("$value")) {
            croak "YAMLPatch: set('$path'): existing style is 'bare' but new value '$value' is not"
                . " safe to emit unquoted - pass style => 'single' or 'double' explicitly";
        }
    }
    my $value_raw = _format_value($value, $style, $path);

    my $indentStr = ' ' x $rec->{indent};
    my $prefix = $rec->{kind} eq 'seqitem' ? "$indentStr- " : "$indentStr$rec->{key}: ";
    my $note = defined $rec->{inline_note} ? "  $rec->{inline_note}" : '';
    my $newLine = "$prefix$value_raw$note";

    my @new_lines = @{ $self->{raw_lines} };
    $new_lines[$idx] = $newLine;
    my $oldValue = $rec->{value};
    $self->_apply_new_lines(\@new_lines);
    $self->_record_changed($path, $oldValue, "$value");
    return $self;
}

sub delete {   ## no critic (ProhibitBuiltinHomonyms)
    my ($self, $path) = @_;
    my $p = $self->{parsed};
    croak "YAMLPatch: delete('$path'): path does not exist" unless exists $p->{by_path}{$path};
    my $idx = $p->{by_path}{$path};
    my $rec = $p->{records}[$idx];
    my $indent = defined $rec->{indent} ? $rec->{indent} : 0;

    my ($start, $end) = $self->_subtree_extent($idx, $indent);
    my $removedFlat = $self->_flatten_range($start, $end);

    my @new_lines = @{ $self->{raw_lines} };
    splice(@new_lines, $start, $end - $start + 1);
    $self->_apply_new_lines(\@new_lines);
    for my $rp (keys %$removedFlat) {
        $self->_record_removed($rp, $removedFlat->{$rp});
    }
    return $self;
}

sub comment_out {
    my ($self, $path) = @_;
    my $p = $self->{parsed};
    croak "YAMLPatch: comment_out('$path'): path does not exist" unless exists $p->{by_path}{$path};
    my $idx = $p->{by_path}{$path};
    my $rec = $p->{records}[$idx];
    my $indent = defined $rec->{indent} ? $rec->{indent} : 0;

    my ($start, $end) = $self->_subtree_extent($idx, $indent);
    my $removedFlat = $self->_flatten_range($start, $end);

    my @new_lines = @{ $self->{raw_lines} };
    for my $j ($start .. $end) {
        next if $new_lines[$j] =~ /^\s*$/;              # don't comment blank lines
        $new_lines[$j] =~ s/^(\s*)/$1#/;
    }
    $self->_apply_new_lines(\@new_lines);
    for my $rp (keys %$removedFlat) {
        $self->_record_removed($rp, $removedFlat->{$rp});
    }
    return $self;
}

sub uncomment {
    my ($self, $path) = @_;
    my $p = $self->{parsed};
    croak "YAMLPatch: uncomment('$path'): no commented-out line for this path"
        unless exists $p->{by_path_commented}{$path};
    croak "YAMLPatch: uncomment('$path'): this path already exists uncommented"
        if exists $p->{by_path}{$path};

    my $anchorIdx = $p->{by_path_commented}{$path};
    my $anchorRec = $p->{records}[$anchorIdx];
    my $anchorIndent = $anchorRec->{indent};

    # Extent: contiguous run of comment lines starting here whose (post-#) indent is
    # >= this comment's indent, stopping at the first line that is not a comment, or
    # is a comment at a lesser indent. Trailing blank/comment-without-would-be-path
    # lines at the tail are NOT trimmed here the way real subtrees are - a commented
    # block was written by a human or by comment_out() as a contiguous unit.
    my $raw = $self->{raw_lines};
    my $end = $anchorIdx;
    my $j = $anchorIdx + 1;
    while ($j < scalar(@$raw)) {
        my $line = $raw->[$j];
        last if $line =~ /^\s*$/;
        my ($ind) = $line =~ /^( *)/;
        last unless $line =~ /^\s*#/;
        last if length($ind) < $anchorIndent;
        $end = $j;
        $j++;
    }

    my @new_lines = @$raw;
    for my $k ($anchorIdx .. $end) {
        $new_lines[$k] =~ s/^(\s*)#/$1/;
    }
    $self->_apply_new_lines(\@new_lines);

    my $newFlat = $self->_flatten_real();
    for my $rp (keys %$newFlat) {
        next unless $rp eq $path || index($rp, "$path.") == 0 || index($rp, "$path\[") == 0;
        $self->_record_added($rp, $newFlat->{$rp});
    }
    return $self;
}

sub insert_kv {
    my ($self, %opts) = @_;
    my $parent = $opts{parent} // '';
    my $key    = $opts{key}    // croak "YAMLPatch: insert_kv: 'key' is required";
    my $value  = $opts{value}  // croak "YAMLPatch: insert_kv: 'value' is required";
    my $style  = $opts{style}  // _default_style_for($value);

    my $path = length($parent) ? "$parent.$key" : $key;
    croak "YAMLPatch: insert_kv: path '$path' already exists" if $self->exists_path($path);

    my ($parentIndent, $insertAt) = $self->_container_insertion_point($parent, %opts);
    my $indentStr = ' ' x ($parentIndent + 2);
    my $value_raw = _format_value($value, $style, $path);
    my $newLine = "$indentStr$key: $value_raw";

    my @new_lines = @{ $self->{raw_lines} };
    splice(@new_lines, $insertAt, 0, $newLine);
    $self->_apply_new_lines(\@new_lines);
    $self->_record_added($path, "$value");
    return $self;
}

sub insert_block {
    my ($self, %opts) = @_;
    my $parent = $opts{parent} // '';
    my $key    = $opts{key}    // croak "YAMLPatch: insert_block: 'key' is required";
    my $text   = $opts{text}   // croak "YAMLPatch: insert_block: 'text' is required";

    my $path = length($parent) ? "$parent.$key" : $key;
    croak "YAMLPatch: insert_block: path '$path' already exists" if $self->exists_path($path);

    my ($parentIndent, $insertAt) = $self->_container_insertion_point($parent, %opts);
    my $childIndent = $parentIndent + 2;

    # Parse the snippet standalone (dedented to zero) purely to validate it is within the
    # subset and to discover which sub-paths it introduces; we then re-indent its literal
    # text for splicing rather than re-emitting from the parse (preserves caller formatting).
    my @snippetLines = split /\n/, $text;
    pop @snippetLines while @snippetLines && $snippetLines[-1] =~ /^\s*$/;
    croak "YAMLPatch: insert_block: 'text' is empty" unless @snippetLines;
    my ($baseIndent) = $snippetLines[0] =~ /^( *)/;
    my @reindented = map {
        my $l = $_;
        if ($l =~ /^\s*$/) { $l }
        else {
            croak "YAMLPatch: insert_block: line does not start with the block's base indent: $l"
                unless substr($l, 0, length $baseIndent) eq $baseIndent || $l eq '';
            (' ' x $childIndent) . substr($l, length $baseIndent);
        }
    } @snippetLines;

    my $standalone = YAMLPatch->load_string(join("\n", @snippetLines) . "\n", %{ $self->{opts} });
    my @subPaths = $standalone->path_list;

    my @new_lines = @{ $self->{raw_lines} };
    splice(@new_lines, $insertAt, 0, @reindented);
    $self->_apply_new_lines(\@new_lines);

    # 'text' may be written either way: just the child keys/values with no wrapper (the
    # standalone parse's paths are then relative to the new node itself, so prefix with the
    # full '$path'), or - the documented/actual usage (see YAMLPatch.md and Steps 4.3/4.4) - a
    # literal "$key:\n  ..." block, exactly as a caller would write it out by hand to insert as
    # a sibling. In that second case the standalone parse's own paths already start with '$key',
    # so prefixing with '$path' (which itself already ends in '.$key') would double it up into
    # '$parent.$key.$key...'. Detect which shape it is by checking whether the standalone parse
    # has a top-level path exactly equal to '$key'.
    my $wrapped = $standalone->exists_path($key);
    for my $sp (@subPaths) {
        my $v = $standalone->get($sp);
        # Gate 3's real-delta comparison (_flatten_real) only ever tracks 'kv'/'seqitem'
        # leaves, never pure containers - a container path like the wrapper key itself, or a
        # nested mapping within the block, would never appear there, so declaring it as
        # "added" would always mismatch. Skip it; its own leaves are still recorded below.
        next unless $v && ($v->{kind} eq 'kv' || $v->{kind} eq 'seqitem');
        my $full = $wrapped ? (length($parent) ? "$parent.$sp" : $sp) : "$path.$sp";
        $self->_record_added($full, $v->{value});
    }
    return $self;
}

sub append_raw {
    my ($self, $text, %opts) = @_;
    croak "YAMLPatch: append_raw refuses without allow_unsafe => 1 - this operation "
        . "deliberately bypasses the normal subset/round-trip guarantees"
        unless $opts{allow_unsafe};
    my @new_lines = @{ $self->{raw_lines} };
    my @appendLines = split /\n/, $text, -1;
    pop @appendLines if @appendLines && $appendLines[-1] eq '' && $text =~ /\n\z/;
    push @new_lines, @appendLines;
    $self->{raw_lines} = \@new_lines;   # NOTE: deliberately skips _apply_new_lines/_parse
    $self->{_unsafe_used} = 1;
    return $self;
}

# ---------------------------------------------------------------------------
# Insertion-point helper shared by insert_kv/insert_block
# ---------------------------------------------------------------------------

sub _container_insertion_point {
    my ($self, $parent, %opts) = @_;
    my $p = $self->{parsed};

    my $parentIndent;
    my ($rangeStart, $rangeEnd);
    if ($parent eq '') {
        $parentIndent = -2;   # so children sit at indent 0
        $rangeStart = 0;
        $rangeEnd = scalar(@{ $self->{raw_lines} }) - 1;
    } else {
        croak "YAMLPatch: parent path '$parent' does not exist" unless exists $p->{by_path}{$parent};
        my $idx = $p->{by_path}{$parent};
        my $rec = $p->{records}[$idx];
        croak "YAMLPatch: parent path '$parent' is not a container (kind=$rec->{kind})"
            unless $rec->{kind} eq 'mapopen';
        $parentIndent = $rec->{indent};
        ($rangeStart, $rangeEnd) = $self->_subtree_extent($idx, $parentIndent);
        $rangeStart = $idx + 1;
    }

    if (defined $opts{after} || defined $opts{before}) {
        my $siblingKey = $opts{after} // $opts{before};
        my $siblingPath = $parent eq '' ? $siblingKey : "$parent.$siblingKey";
        croak "YAMLPatch: sibling '$siblingPath' (for after/before) does not exist"
            unless exists $p->{by_path}{$siblingPath};
        my $sIdx = $p->{by_path}{$siblingPath};
        my $sRec = $p->{records}[$sIdx];
        my ($sStart, $sEnd) = $self->_subtree_extent($sIdx, $sRec->{indent});
        return ($parentIndent, defined $opts{after} ? $sEnd + 1 : $sStart);
    }

    return ($parentIndent, $rangeEnd + 1);
}

# ---------------------------------------------------------------------------
# Subtree extent: from a record's start line at $indent, collect forward while
# lines are blank/comment OR have indent > $indent (or, for the very next
# line, indent == $indent AND it is a sequence item belonging to this key -
# handled naturally because such lines were already given indent > owner in
# no case; the YAML same-indent-sequence quirk means we special-case it here).
# Trailing blank/comment lines are trimmed back off (they belong to the next
# sibling), except when $end would then be before $start.
# ---------------------------------------------------------------------------

sub _subtree_extent {
    my ($self, $startIdx, $indent) = @_;
    my $raw = $self->{raw_lines};
    my $n = scalar(@$raw);
    my $end = $startIdx;
    my $j = $startIdx + 1;
    while ($j < $n) {
        my $line = $raw->[$j];
        if ($line =~ /^\s*$/) { $end = $j; $j++; next; }
        my ($ind) = $line =~ /^( *)/;
        $ind = length($ind);
        if ($ind > $indent) { $end = $j; $j++; next; }
        if ($ind == $indent && $line =~ /^\s*-(\s|$)/) { $end = $j; $j++; next; } # same-indent seq item
        last;
    }
    # Trim trailing BLANK lines only - they belong to whichever sibling follows, so a
    # deleted/commented block doesn't donate its trailing whitespace to the next one.
    # Trailing COMMENT lines are deliberately NOT trimmed: in practice a comment
    # immediately inside a block (e.g. a commented-out '#maxDelta: 0.9' sibling field)
    # is far more often part of THIS block than a banner for the next one, and treating
    # it as "not part of the subtree" would leave it orphaned - re-parented to whatever
    # sibling happens to follow - when this block is deleted or commented out.
    while ($end > $startIdx) {
        my $line = $raw->[$end];
        last if $line !~ /^\s*$/;
        $end--;
    }
    return ($startIdx, $end);
}

sub _flatten_range {
    my ($self, $start, $end) = @_;
    my %flat;
    my $p = $self->{parsed};
    for my $path (keys %{ $p->{by_path} }) {
        my $idx = $p->{by_path}{$path};
        next unless $idx >= $start && $idx <= $end;
        my $rec = $p->{records}[$idx];
        next unless $rec->{kind} eq 'kv' || $rec->{kind} eq 'seqitem';
        $flat{$path} = $rec->{value};
    }
    return \%flat;
}

# ---------------------------------------------------------------------------
# Value formatting
# ---------------------------------------------------------------------------

sub _format_value {
    my ($value, $style, $path) = @_;
    $value = "$value";
    if ($style eq 'bare') {
        croak "YAMLPatch: value '$value' for '$path' is not safe to emit as a bare scalar"
            . " (looks like a YAML 1.1 boolean/null, or contains a structural character) -"
            . " use style => 'single' or 'double'"
            unless _looks_safe_bare($value);
        return $value;
    }
    if ($style eq 'single') {
        croak "YAMLPatch: value for '$path' contains a single-quote, which this module's"
            . " single-quoted style does not escape - use style => 'double'"
            if $value =~ /'/;
        return "'$value'";
    }
    if ($style eq 'double') {
        (my $escaped = $value) =~ s/([\\"])/\\$1/g;
        return qq("$escaped");
    }
    croak "YAMLPatch: unknown style '$style' for '$path' (expected bare|single|double|keep)";
}

# ---------------------------------------------------------------------------
# diff / save
# ---------------------------------------------------------------------------

sub diff {
    my ($self, $originalText) = @_;
    $originalText = $self->_original_text unless defined $originalText;
    my @old = split /\n/, $originalText, -1;
    my @new = split /\n/, $self->as_text, -1;
    my $ops = _lcs_align(\@old, \@new);
    my @out;
    my ($oi, $ni) = (1, 1);
    for my $op (@$ops) {
        my ($kind, $text) = @$op;
        if ($kind eq 'same') { $oi++; $ni++; next; }
        if ($kind eq 'del') { push @out, sprintf("-%4d: %s", $oi++, $text); next; }
        push @out, sprintf("+%4d: %s", $ni++, $text);
    }
    return join("\n", @out);
}

sub _original_text {
    my ($self) = @_;
    return $self->{_original_text} if defined $self->{_original_text};
    return $self->as_text; # best effort if load() path not used to capture it
}

# Number of lines actually inserted or deleted between original and current text (for
# gate 4). Uses the same LCS alignment as diff(), then groups consecutive del/add runs
# the way a diffstat does: a maximal run of D deleted lines directly adjacent to A added
# lines counts as max(D, A), not D+A - so a plain one-line set() (delete old, add new)
# counts as 1 "changed line", a pure one-line insertion counts as 1, and a one-line
# insertion followed by everything after it re-matching (the normal case) does NOT
# cascade into "every subsequent line changed".
sub _line_delta_count {
    my ($self) = @_;
    my @old = split /\n/, $self->_original_text, -1;
    my @new = split /\n/, $self->as_text, -1;
    my $ops = _lcs_align(\@old, \@new);
    my $count = 0;
    my ($dels, $adds) = (0, 0);
    my $flush = sub { $count += $dels > $adds ? $dels : $adds; $dels = $adds = 0; };
    for my $op (@$ops) {
        if    ($op->[0] eq 'del')  { $dels++ }
        elsif ($op->[0] eq 'add')  { $adds++ }
        else                       { $flush->() }
    }
    $flush->();
    return $count;
}

# Longest-common-subsequence line alignment. O(N*M) time and space - entirely adequate
# for the config-sized documents (tens to low hundreds of lines) this module targets;
# not intended for diffing large files. Returns a list of ['same'|'del'|'add', $line].
sub _lcs_align {
    my ($old, $new) = @_;
    my ($n, $m) = (scalar(@$old), scalar(@$new));
    my @dp;
    $dp[$n][$_] = 0 for 0 .. $m;
    $dp[$_][$m] = 0 for 0 .. $n;
    for (my $i = $n - 1; $i >= 0; $i--) {
        for (my $j = $m - 1; $j >= 0; $j--) {
            $dp[$i][$j] = $old->[$i] eq $new->[$j]
                ? $dp[$i + 1][$j + 1] + 1
                : ($dp[$i + 1][$j] >= $dp[$i][$j + 1] ? $dp[$i + 1][$j] : $dp[$i][$j + 1]);
        }
    }
    my @ops;
    my ($i, $j) = (0, 0);
    while ($i < $n && $j < $m) {
        if ($old->[$i] eq $new->[$j]) { push @ops, ['same', $old->[$i]]; $i++; $j++; }
        elsif ($dp[$i + 1][$j] >= $dp[$i][$j + 1]) { push @ops, ['del', $old->[$i]]; $i++; }
        else { push @ops, ['add', $new->[$j]]; $j++; }
    }
    push @ops, ['del', $old->[$i++]] while $i < $n;
    push @ops, ['add', $new->[$j++]] while $j < $m;
    return \@ops;
}

# Save with the full commit gate. Dies (leaving the on-disk file untouched)
# on any gate failure.
#
#   $y->save($path, hooks => [ \&hook1, \&hook2 ], max_line_delta => 10, backup => 1);
#
# Each hook is called as $hook->($self, $newText) and must die() (with a
# descriptive message) or return a false value to refuse the commit.
sub save {
    my ($self, $path, %opts) = @_;
    $path //= $self->{_source_path};
    croak "YAMLPatch: save: no path given and none recorded from load_file" unless defined $path;

    my $newText = $self->as_text;

    unless ($self->{_unsafe_used}) {
        # Gate 1 (round-trip) is implicitly already satisfied - every mutator re-parses
        # eagerly - but re-confirm here in case raw_lines was touched some other way.
        eval { $self->_parse($self->{raw_lines}, $self->{opts}); 1 }
            or croak "YAMLPatch: save: gate 1 (round-trip) failed: $@";

        # Gate 2: an independent parser, if available, must also accept it.
        unless ($opts{skip_yaml_tiny_check}) {
            my $hasYamlTiny = eval { require YAML::Tiny; 1 };
            if ($hasYamlTiny) {
                my $doc = eval { YAML::Tiny->read_string($newText) };
                croak "YAMLPatch: save: gate 2 (YAML::Tiny) failed: " . ($@ || 'read_string returned undef')
                    unless $doc && ref($doc) eq 'YAML::Tiny' && ref($doc->[0]) eq 'HASH';
                croak "YAMLPatch: save: gate 2 (YAML::Tiny) failed: parsed to an empty document"
                    unless keys %{ $doc->[0] };
            }
        }

        # Gate 3: semantic delta must equal declared intent, exactly.
        my $before = $self->{_baseline_paths};
        my $after  = $self->_flatten_real();
        my (%added, %removed, %changed);
        for my $k (keys %$after) {
            if (!exists $before->{$k}) { $added{$k} = $after->{$k} }
            elsif ($before->{$k} ne $after->{$k}) { $changed{$k} = [ $before->{$k}, $after->{$k} ] }
        }
        for my $k (keys %$before) {
            $removed{$k} = $before->{$k} unless exists $after->{$k};
        }
        _assert_delta_equals(\%added, \%removed, \%changed, $self->{_intent});

        # Gate 4: bounded line-delta, if the caller declared a bound.
        if (defined $opts{max_line_delta}) {
            my $n = $self->_line_delta_count;
            croak "YAMLPatch: save: gate 4 failed: $n lines changed, expected <= $opts{max_line_delta}"
                if $n > $opts{max_line_delta};
        }

        # Gate 5: mutators can only ever emit constructs inside the permitted subset
        # (enforced structurally - they have no code path to emit flow/anchors/tabs/etc
        # unless append_raw was used, which is excluded from this branch entirely).
    }

    # Gates 6/7: caller-supplied hooks.
    for my $hook (@{ $opts{hooks} // [] }) {
        my $ok = eval { $hook->($self, $newText) };
        croak "YAMLPatch: save: hook failed: $@" if $@;
        croak "YAMLPatch: save: hook refused the commit" unless $ok;
    }

    if ($opts{backup} && -e $path) {
        my $bak = "$path.bak." . time();
        require File::Copy;
        File::Copy::copy($path, $bak) or croak "YAMLPatch: save: backup copy to '$bak' failed: $!";
    }

    my $dir = dirname($path);
    my $tmp = "$dir/" . basename($path) . ".yamlpatch.tmp.$$";
    sysopen(my $fh, $tmp, O_WRONLY | O_CREAT | O_EXCL, 0644)
        or croak "YAMLPatch: save: cannot create temp file '$tmp': $!";
    flock($fh, LOCK_EX) or croak "YAMLPatch: save: cannot lock '$tmp': $!";
    print {$fh} $newText or croak "YAMLPatch: save: write to '$tmp' failed: $!";
    close $fh or croak "YAMLPatch: save: close of '$tmp' failed: $!";
    rename($tmp, $path) or do {
        my $err = $!;
        unlink $tmp;
        croak "YAMLPatch: save: rename '$tmp' -> '$path' failed: $err";
    };

    $self->{_source_path}    = $path;
    $self->{_original_text}  = $newText;
    $self->{_baseline_paths} = $self->_flatten_real();
    $self->{_intent}         = { added => {}, removed => {}, changed => {} };
    $self->{_unsafe_used}    = 0;
    return 1;
}

sub _assert_delta_equals {
    my ($added, $removed, $changed, $intent) = @_;
    my @problems;

    for my $k (keys %$added) {
        push @problems, "added '$k' was not declared" unless exists $intent->{added}{$k};
    }
    for my $k (keys %{ $intent->{added} }) {
        push @problems, "declared add of '$k' did not happen" unless exists $added->{$k};
    }
    for my $k (keys %$removed) {
        push @problems, "removal of '$k' was not declared" unless exists $intent->{removed}{$k};
    }
    for my $k (keys %{ $intent->{removed} }) {
        push @problems, "declared removal of '$k' did not happen" unless exists $removed->{$k};
    }
    for my $k (keys %$changed) {
        push @problems, "change to '$k' was not declared" unless exists $intent->{changed}{$k};
    }
    for my $k (keys %{ $intent->{changed} }) {
        push @problems, "declared change to '$k' did not happen" unless exists $changed->{$k};
    }

    croak "YAMLPatch: save: gate 3 (delta must equal declared intent) failed:\n  "
        . join("\n  ", @problems)
        if @problems;
    return 1;
}

1;

__END__
See YAMLPatch.md for full API documentation, usage examples, and the rationale
for each design decision summarized in the comments above.