script/adr-index

Rama main · réplica de lectura del repositorio original.

#!/usr/bin/env perl
# SPDX-FileCopyrightText: 2026 GPForum Contributors
# SPDX-License-Identifier: BSD-3-Clause

package main;

use v5.40;

use Carp qw(croak);
use Const::Fast;
use English qw(-no_match_vars);

our $VERSION = '0.001';

# Writes the index of docs/adr/ into docs/adr/README.md, between two markers.
#
# There were 103 ADRs and a README that indexed none of them, so the only way
# to find the decision on, say, effective visibility was to guess a filename.
# A hand-kept list would drift the day the next ADR landed; this one is
# generated, and `--check` fails when the README no longer matches the files,
# which the test suite runs.

const my $DIRECTORY => 'docs/adr';
const my $README    => "$DIRECTORY/README.md";
const my $START     => '<!-- adr-index:start -->';
const my $END       => '<!-- adr-index:end -->';

my $check = grep { $_ eq '--check' } @ARGV;

my $index   = _index();
my $current = _slurp($README);
my $wanted  = _with_index( $current, $index );

if ($check) {
    if ( $wanted ne $current ) {
        _say( *STDERR, "adr-index: $README is stale; run script/adr-index" );
        exit 1;
    }
    _say( *STDOUT, 'adr-index status=ok' );
    exit 0;
}

if ( $wanted ne $current ) {
    open my $handle, '>', $README or croak "open $README: $ERRNO";
    print {$handle} $wanted or croak "write $README: $ERRNO";
    close $handle           or croak "close $README: $ERRNO";
}
_say( *STDOUT, "adr-index wrote $README" );
exit 0;

sub _index {
    opendir my $dir, $DIRECTORY or croak "opendir $DIRECTORY: $ERRNO";
    my @files = sort grep { /\A [[:digit:]]{4} - .+ [.]md \z/msx } readdir $dir;
    closedir $dir or croak "closedir $DIRECTORY: $ERRNO";

    my @rows;
    my %seen;
    for my $file (@files) {
        my ($number) = $file =~ /\A ([[:digit:]]{4})/msx;
        next if $number eq '0000';
        $seen{ $number + 0 } = 1;
        my $text = _slurp("$DIRECTORY/$file");
        my ($title) =
          $text =~ /\A [#] \s* ADR \s* [[:digit:]]+ : \s* ([^\n]+)/msx;
        my ($status) =
          $text =~ /^[#][#] \s* Status \s*\n+ \s* ([[:alpha:]]+)/msx;
        $title  //= $file;
        $status //= 'Unstated';
        push @rows, "| [$number]($file) | $title | $status |";
    }

    my @gaps =
      grep { !$seen{$_} } 1 .. ( reverse sort { $a <=> $b } keys %seen )[0];
    my $note = q{};
    if (@gaps) {
        $note =
            "\nNumbers "
          . join( q{, }, map { sprintf '%04d', $_ } @gaps )
          . " were never assigned. They are left unused rather than\n"
          . "renumbered, because other documents cite ADRs by number.\n";
    }

    return join "\n",
      '| ADR | Decision | Status |',
      '| --- | --- | --- |',
      @rows, q{},
      'Generated by `script/adr-index` from the files in this'
      . ' directory; `script/adr-index --check` fails when it is stale.'
      . $note;
}

sub _with_index {
    my ( $text, $table ) = @_;

    my $block = "$START\n$table\n$END";
    if ( $text =~ /\Q$START\E .*? \Q$END\E/msx ) {
        $text =~ s/\Q$START\E .*? \Q$END\E/$block/msx;
        return $text;
    }

    return $text . "\n## Index\n\n$block\n";
}

sub _say {
    my ( $handle, $line ) = @_;

    print {$handle} "$line\n" or croak "write: $ERRNO";

    return;
}

sub _slurp {
    my ($path) = @_;

    open my $handle, '<', $path or croak "open $path: $ERRNO";
    local $INPUT_RECORD_SEPARATOR = undef;
    my $text = <$handle>;
    close $handle or croak "close $path: $ERRNO";

    return $text;
}