script/perlcritic

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

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

set -eu

root=$(CDPATH= cd -- "$(dirname "$0")/.." && pwd)

runner="perl -Iscript/lib -MGPForum::Quality::AsyncSyntax -S perlcritic"

# Route through the project wrapper, the way script/perltidy-check already
# does. Requiring `carton` on PATH meant that on a host where the dependencies
# are vendored in local/ but Carton itself is not installed -- the documented
# setup for this project -- the runner stayed the bare name, xargs failed with
# "perlcritic: No such file or directory", the violation list came back empty,
# and the gate reported status=ok with new_violations=0. It passed by not
# running.
if [ -d "$root/local" ]; then
    runner="$root/script/gpforum-carton exec perl -I$root/script/lib -MGPForum::Quality::AsyncSyntax -S perlcritic"
fi

has_target=0
for argument in "$@"; do
    if [ -e "$argument" ]; then
        has_target=1
    fi
done

if [ "$has_target" -eq 1 ]; then
    exec $runner --profile .perlcriticrc "$@"
fi

tmp_file="${TMPDIR:-/tmp}/gpforum-perlcritic-files.$$"
tmp_dir="${TMPDIR:-/tmp}/gpforum-perlcritic.$$"
baseline_file="etc/perlcritic-baseline.txt"
mkdir -p "$tmp_dir"
trap 'rm -rf "$tmp_dir" "$tmp_file"' EXIT HUP INT TERM

find bin lib script t \
    -type f \( -path 'bin/*' -o -name '*.pm' -o -name '*.pl' -o -name '*.t' \) -print0 \
    > "$tmp_file" 2>/dev/null || true

# script/ holds a mix of shell and Perl, and the find above matches neither: the
# Perl programs there have no extension. They were never analysed -- the
# baseline held no entry under script/ -- while script/perltidy-check claimed
# this gate already read them. Select them by shebang, as that gate does.
for candidate in script/*; do
    [ -f "$candidate" ] || continue
    if head -n 1 "$candidate" | grep -q 'perl'; then
        printf '%s\0' "$candidate" >> "$tmp_file"
    fi
done

# Nothing to analyse, as from the wrong directory, is a failure, not a pass.
if [ ! -s "$tmp_file" ]; then
    echo "perlcritic: no Perl files found; nothing was analysed" >&2
    exit 1
fi

raw_output="$tmp_dir/raw-output"
violations="$tmp_dir/violations"
canonical_violations="$tmp_dir/canonical-violations"
baseline="$tmp_dir/baseline"
canonical_baseline="$tmp_dir/canonical-baseline"
new_violations="$tmp_dir/new-violations"
resolved_violations="$tmp_dir/resolved-violations"

set +e
xargs -0 $runner --profile .perlcriticrc "$@" < "$tmp_file" > "$raw_output" 2>&1
critic_status=$?
set -e

# A gate that cannot execute its tool must fail, not pass. Without this the
# only symptom was every baseline entry reported as "not observed", which
# reads like good news.
if [ "$critic_status" -ne 0 ] && ! grep -q '^\[' "$raw_output"; then
    echo "perlcritic: the analyser did not run (exit $critic_status)" >&2
    cat "$raw_output" >&2
    exit 1
fi

grep '^\[' "$raw_output" | LC_ALL=C sort -u > "$violations" || true
sed -E 's/ line [[:digit:]]+, column [[:digit:]]+\./ line <line>, column <column>./' \
    "$violations" | LC_ALL=C sort -u > "$canonical_violations"

if [ ! -f "$baseline_file" ]; then
    cat "$raw_output"
    exit "$critic_status"
fi

# Every file clean while the baseline is not empty means the run did not
# happen, not that 694 violations were fixed at once.
if [ ! -s "$violations" ] && [ -s "$baseline_file" ]; then
    echo "perlcritic: no violations observed at all, but $baseline_file is not empty" >&2
    echo "perlcritic: refusing to report success on an analyser that produced nothing" >&2
    head -20 "$raw_output" >&2
    exit 1
fi

LC_ALL=C sort -u "$baseline_file" > "$baseline"
sed -E 's/ line [[:digit:]]+, column [[:digit:]]+\./ line <line>, column <column>./' \
    "$baseline" | LC_ALL=C sort -u > "$canonical_baseline"
LC_ALL=C comm -13 "$canonical_baseline" "$canonical_violations" > "$new_violations"
LC_ALL=C comm -23 "$canonical_baseline" "$canonical_violations" > "$resolved_violations"

new_count="$(wc -l < "$new_violations" | tr -d ' ')"
resolved_count="$(wc -l < "$resolved_violations" | tr -d ' ')"
baseline_count="$(wc -l < "$canonical_baseline" | tr -d ' ')"

if [ "$new_count" -ne 0 ]; then
    echo "perlcritic: found $new_count violation(s) outside baseline" >&2
    cat "$new_violations" >&2
    if [ "$resolved_count" -ne 0 ]; then
        echo "perlcritic: $resolved_count baseline violation(s) disappeared; update $baseline_file after review" >&2
    fi
    exit 1
fi

if [ "$resolved_count" -ne 0 ]; then
    echo "perlcritic: $resolved_count baseline violation(s) not observed in this environment; review $baseline_file before removing them" >&2
    cat "$resolved_violations" >&2
fi

echo "perlcritic status=ok baseline_violations=$baseline_count new_violations=0"