#!/usr/bin/env perl

# IMPORTANT: this gate answers a different question from script/cpan-audit-project.
# That gate asks "is the set of distributions installed in this root vulnerable?".
# This gate asks "does the declared dependency chain PERMIT a vulnerable
# resolution?" - which is what an installer actually decides. A resolver always
# takes the newest release, so an installed-only audit stays green even while
# the declared floors allow a vulnerable version, and a floor list derived from
# the modules cpanfile names never sees the transitive requirements that
# libwww-perl, Dancer2 and JSON::MaybeXS pull in on their own.

use strict;
use warnings;

use File::Basename qw(basename dirname);
use File::Spec;
use Getopt::Long qw(GetOptions);
use JSON::XS ();

use constant EXIT_CLEAN   => 0;
use constant EXIT_FINDING => 1;
use constant EXIT_UNUSABLE => 2;

# Stricter than CPAN::Audit::FreshnessCheck's own default of 30 days, deliberately.
# Upstream's threshold serves an interactive audit, where a warning on STDERR is
# read by the person who typed the command. This is a release gate, and 30 days is
# precisely the age at which this project's database silently lacked the URI
# advisory that a clean verdict was then cited to disprove (DD-790). The knob is
# upstream's own CPAN_AUDIT_FRESH_DAYS, so one name moves the warning and the
# refusal together rather than letting two thresholds disagree in silence.
#
# WHY 21 AND NOT A ROUNDER NUMBER. The limit must EXCEED THE LARGEST REAL GAP
# BETWEEN PUBLICATIONS, or the gate refuses during a normal quiet spell while no
# newer database exists to install - blocking for a reason nobody can act on, which
# is how a gate gets routed around instead of fixed. Measured from the CPAN index
# on 2026-09-06 across 40 CPANSA-DB releases spanning 223 days: median gap 4 days,
# mean 5.7, MAXIMUM 18, with 1 gap of 39 exceeding 14 days and none exceeding 30.
# 21 clears the observed maximum with three days of margin and still catches the
# 30-day staleness this card was raised for. IF A LONGER GAP EVER APPEARS UPSTREAM,
# THIS IS THE NUMBER THAT MOVES - the measurement, not the constant, is the reason.
# And 18 is the maximum of a 223-DAY WINDOW, which is one sample of the tail rather
# than the tail itself: read 21 as "chosen against the largest gap seen in 223 days",
# never as a proven ceiling.
use constant DEFAULT_MAX_DB_AGE_DAYS => 21;

exit main(@ARGV);

# Purpose: run the declared-chain advisory gate end to end.
# Input: the raw @ARGV list (one positional Perl library root, plus the
#        optional --cpanfile and --exclude-file overrides).
# Output: an exit code - 0 clean, 1 at least one permitted vulnerable
#         resolution, 2 the gate could not audit anything and refuses to
#         report a clean result it did not establish.
sub main {
    my @argv = @_;

    my $repo_root = File::Spec->rel2abs( File::Spec->catdir( dirname(__FILE__), File::Spec->updir ) );
    my $cpanfile  = File::Spec->catfile( $repo_root, 'cpanfile' );
    my $exclusions = File::Spec->catfile( $repo_root, 'cpan-audit-exclusions.txt' );

    local @ARGV = @argv;
    GetOptions(
        'cpanfile=s'     => \$cpanfile,
        'exclude-file=s' => \$exclusions,
    ) or return _usage('unrecognized option');
    my @positional = @ARGV;

    return _usage('exactly one Perl library root is required')
        if @positional != 1;
    my $perl5_root = $positional[0];
    return _usage("not a directory: $perl5_root") if !-d $perl5_root;
    return _usage("cpanfile not readable: $cpanfile") if !-f $cpanfile;

    my $version_class = _load_audit_modules();
    return _unusable('CPAN::Audit::DB and CPAN::Audit::Version must be loadable; install CPAN::Audit and put it on PERL5LIB')
        if !$version_class;

    # The corpus is established BEFORE the subject is walked, because a database
    # too old to answer with makes every later step moot - and reporting it only
    # on the failure path would name the database exactly when nobody needs it.
    my $corpus = _corpus_report($perl5_root);
    # Flushed, because the refusal below goes to STDERR while this goes to STDOUT.
    # Block-buffered, the corpus line lands AFTER the refusal in any combined log -
    # so the reader meets "refused because the database is old" before being told
    # which database, which is the wrong way round for the only line that explains it.
    local $| = 1;
    print $corpus->{line};
    return _unusable( $corpus->{refusal} ) if defined $corpus->{refusal};

    my $declared = _parse_cpanfile($cpanfile);
    return _unusable("no runtime requirements declared in $cpanfile")
        if !%{$declared};

    my $metadata = _index_metadata($perl5_root);
    return _unusable(
        sprintf 'the closure would be incomplete - %d distribution metadata file(s) could not be read: %s',
        scalar @{ $metadata->{unusable} },
        join( '; ', @{ $metadata->{unusable} } )
    ) if @{ $metadata->{unusable} };
    return _unusable("no distribution metadata (.meta) found under $perl5_root; the declared chain cannot be walked")
        if !%{ $metadata->{module_to_dist} };

    my $demand = _closure( $declared, $metadata );
    my $floors = _distribution_floors( $demand, $metadata );
    my $excluded = _read_exclusions($exclusions);

    my @findings = _findings( $floors, $excluded, $version_class );

    printf "declared-chain closure: %d modules across %d distributions under %s\n",
        scalar( keys %{$demand} ), scalar( keys %{$floors} ), $perl5_root;

    if ( !@findings ) {
        print "No distribution in the declared runtime closure permits a version inside an advisory range.\n";
        return EXIT_CLEAN;
    }

    for my $finding ( @findings ) {
        printf "%s permits %s which has advisory %s\n",
            $finding->{distribution}, $finding->{permitted}, $finding->{advisory};
        printf "    affected range: %s\n", $finding->{affected};
        printf "    fixed range:    %s\n", ( $finding->{fixed} eq '' ? '(no fixed release)' : $finding->{fixed} );
        printf "    floor demanded: %s (%s)\n", $finding->{floor}, $finding->{because};
        printf "    remedy:         declare a floor for %s at or above the fixed range in cpanfile, Makefile.PL and dist.ini, or record a reviewed disposition for %s\n",
            $finding->{main_module}, $finding->{advisory};
    }
    printf "%d permitted vulnerable resolution(s) in the declared chain\n", scalar(@findings);

    return EXIT_FINDING;
}

# Purpose: print the usage diagnostic for a caller error.
# Input: a one-line reason string.
# Output: the EXIT_UNUSABLE exit code (the message goes to STDERR).
sub _usage {
    my ($reason) = @_;
    my $name = basename(__FILE__);
    printf {*STDERR} "%s\n", $reason;
    printf {*STDERR} "Usage: %s [--cpanfile PATH] [--exclude-file PATH] <perl5-library-root>\n", $name;
    return EXIT_UNUSABLE;
}

# Purpose: refuse to report a clean chain the gate could not actually audit.
# Input: a one-line reason string.
# Output: the EXIT_UNUSABLE exit code (the message goes to STDERR).
sub _unusable {
    my ($reason) = @_;
    printf {*STDERR} "cannot audit the declared chain: %s\n", $reason;
    return EXIT_UNUSABLE;
}

# Purpose: days elapsed since 1970-01-01 for a civil year/month/day, by pure
#          integer arithmetic.
# Input: $y (full year), $m (1-12), $d (1-31).
# Output: an integer day number, negative before 1970.
#
# Deliberately not Time::Local: its two-digit-year heuristics and the epoch
# rollover in timegm have surprised callers, and a date comparison that can be
# moved by a timezone or an interpretation rule is exactly the kind of quiet
# wrongness this gate exists to refuse. This is Howard Hinnant's days_from_civil,
# which is total and has no configuration.
sub _days_from_civil {
    my ( $y, $m, $d ) = @_;
    $y -= ( $m <= 2 ? 1 : 0 );
    my $era = int( ( $y >= 0 ? $y : $y - 399 ) / 400 );
    my $yoe = $y - $era * 400;
    my $doy = int( ( 153 * ( $m + ( $m > 2 ? -3 : 9 ) ) + 2 ) / 5 ) + $d - 1;
    my $doe = $yoe * 365 + int( $yoe / 4 ) - int( $yoe / 100 ) + $doy;
    return $era * 146_097 + $doe - 719_468;
}

# Purpose: the age in days of a CPANSA database stamp.
# Input: $stamp - a version in CPANSA's YYYYMMDD.NNN form.
# Output: the age in days, or undef when the stamp is not that shape.
#
# undef means "this cannot be judged", never "this is fine". The caller turns it
# into a refusal, because a stamp we cannot read is a corpus we cannot vouch for.
sub _database_age_days {
    my ($stamp) = @_;
    return undef if !defined $stamp;
    return undef if $stamp !~ /^([0-9]{4})([0-9]{2})([0-9]{2})(?:[.]|\z)/;
    my ( $y, $m, $d ) = ( $1, $2, $3 );
    return undef if $m < 1 || $m > 12 || $d < 1 || $d > 31;
    my @now = gmtime(time);
    return _days_from_civil( $now[5] + 1900, $now[4] + 1, $now[3] )
      - _days_from_civil( $y, $m, $d );
}

# Purpose: the configured maximum advisory-database age.
# Input: none (reads CPAN_AUDIT_FRESH_DAYS).
# Output: ( $days, undef ) or ( undef, $complaint ) when the variable is unusable.
#
# A malformed value is refused rather than ignored. Silently falling back to the
# default would mean an operator who set the knob and mistyped it gets the
# default's behaviour while believing they set their own - the silent-drop failure
# this project has met repeatedly in option handling.
sub _max_database_age_days {
    my $configured = $ENV{CPAN_AUDIT_FRESH_DAYS};
    return ( DEFAULT_MAX_DB_AGE_DAYS, undef ) if !defined $configured || $configured eq '';
    return ( undef, "CPAN_AUDIT_FRESH_DAYS is set to '$configured', which is not a whole number of days" )
      if $configured !~ /^[0-9]+$/;
    return ( $configured + 0, undef );
}

# Purpose: name the advisory database behind this run, and decide whether it is
#          fit to answer with.
# Input: none.
# Output: a hash reference - {line} always, {refusal} when the gate must not
#         report a verdict.
#
# WHY THE LINE IS UNCONDITIONAL. A verdict is only meaningful alongside the corpus
# it was reached from, and the clean path is the one readers believe. Two clean runs
# of this gate were cited as evidence on 2026-09-06 while the database predated the
# advisory in question by three weeks; nothing in that output could have revealed it.
# Printing the corpus only when refusing would reproduce the defect on the exact
# path that caused it.
sub _corpus_report {
    my ($audited_root) = @_;
    my $stamp = eval { CPAN::Audit::DB->VERSION };
    my $shown = defined $stamp && $stamp ne '' ? $stamp : 'unknown';
    my $age   = _database_age_days($stamp);
    my ( $limit, $complaint ) = _max_database_age_days();

    my $line = sprintf "advisory database: CPAN::Audit::DB %s%s\n", $shown,
      defined $age ? sprintf( ' (%d day%s old)', $age, $age == 1 ? '' : 's' ) : ' (age unknown)';

    return { line => $line, refusal => $complaint } if defined $complaint;
    return {
        line    => $line,
        refusal => "the advisory database version '$shown' is not in CPANSA's YYYYMMDD.NNN form, so its age cannot be established"
    } if !defined $age;
    return {
        line    => $line,
        refusal => sprintf(
            "the advisory database is %d days old (%s) and the limit is %d. Refresh it WITHOUT disturbing a shared CPAN tree:\n"
              . "    DIR=\$(mktemp -d)\n"
              . "    cpanm --local-lib-contained \"\$DIR\" CPANSA::DB\n"
              . "    PERL5LIB=\"\$DIR/lib/perl5:\$PERL5LIB\" %s %s\n"
              . "Or set CPAN_AUDIT_FRESH_DAYS if you accept auditing against a corpus that old.",
            $age, $shown, $limit, $0, ( defined $audited_root ? $audited_root : '<root>' )
        )
    } if $age > $limit;
    return { line => $line, refusal => undef };
}

# Purpose: load the CPAN::Audit advisory database and version-range comparator
#          without dying when the audit tool is absent from this runtime.
# Input: none.
# Output: a CPAN::Audit::Version instance, or undef when either module is
#         unavailable.
sub _load_audit_modules {
    my $loaded = eval {
        require CPAN::Audit::DB;
        require CPAN::Audit::Version;
        1;
    };
    return undef if !$loaded;    ## no critic
    return CPAN::Audit::Version->new;
}

# Purpose: read the top-level runtime requirements the distribution declares.
# Input: the path to a cpanfile.
# Output: a hash reference of module name => declared minimum version string.
#         Phase blocks (on 'configure' => sub { ... }) and the perl floor are
#         skipped, because neither is part of the runtime closure.
sub _parse_cpanfile {
    my ($path) = @_;

    my %declared;
    open my $fh, '<', $path or die "Unable to read $path: $!";
    my $depth = 0;
    while ( my $line = <$fh> ) {
        $depth++ if $line =~ /=>\s*sub\s*\{/;
        $depth-- if $line =~ /^\s*\}\s*;/;
        next if $depth > 0;
        next if $line !~ /^\s*requires\s+['"]([^'"]+)['"]\s*(?:,\s*['"]([^'"]+)['"]\s*)?;/;
        my ( $module, $minimum ) = ( $1, $2 );
        next if $module eq 'perl';
        $declared{$module} = defined $minimum ? $minimum : '0';
    }
    close $fh or die "Unable to close $path: $!";

    return \%declared;
}

# Purpose: index every installed distribution's metadata under a Perl library
#          root so the declared chain can be walked without network access.
# Input: a Perl library root (the directory handed to cpanm's -L, plus its
#        architecture subdirectories).
# Output: a hash reference with four sub-indexes:
#           module_to_dist   module name        => distribution name
#           runtime_requires distribution name  => { module => minimum }
#           releases         distribution name  => installed version string
#           unusable         list of "path (reason)" for every metadata file
#                            that could not be read, which the caller must
#                            treat as fatal rather than walking a partial chain
sub _index_metadata {
    my ($root) = @_;

    my %module_to_dist;
    my %runtime_requires;
    my %releases;
    my @unusable;

    for my $meta_root ( _meta_roots($root) ) {
        opendir my $dh, $meta_root or next;
        my @dists = sort grep { !/^\./ } readdir $dh;
        closedir $dh or die "Unable to close $meta_root: $!";

        for my $dist_dir (@dists) {
            my $install = File::Spec->catfile( $meta_root, $dist_dir, 'install.json' );
            my $mymeta  = File::Spec->catfile( $meta_root, $dist_dir, 'MYMETA.json' );
            next if !-f $install;

            my ( $installed, $install_error ) = _decode_json_file($install);
            if ( defined $install_error ) {
                push @unusable, "$install ($install_error)";
                next;
            }
            my $name = $installed->{dist};
            next if !defined $name;
            $name =~ s/-v?[0-9][0-9._]*\z//;
            next if $name eq '';

            $releases{$name} = $installed->{version} if defined $installed->{version};
            for my $module ( keys %{ $installed->{provides} || {} } ) {
                $module_to_dist{$module} = $name if !exists $module_to_dist{$module};
            }

            next if !-f $mymeta;
            my ( $declared, $mymeta_error ) = _decode_json_file($mymeta);
            if ( defined $mymeta_error ) {
                push @unusable, "$mymeta ($mymeta_error)";
                next;
            }
            my $requires = $declared->{prereqs}{runtime}{requires} || {};
            $runtime_requires{$name} = $requires;
        }
    }

    return {
        module_to_dist   => \%module_to_dist,
        runtime_requires => \%runtime_requires,
        releases         => \%releases,
        unusable         => \@unusable,
    };
}

# Purpose: list every directory that can hold cpanm distribution metadata for a
#          library root, covering both the plain and architecture layouts.
# Input: a Perl library root.
# Output: a list of existing .meta directory paths.
sub _meta_roots {
    my ($root) = @_;

    my @candidates = ( File::Spec->catdir( $root, '.meta' ) );
    if ( opendir my $dh, $root ) {
        for my $entry ( sort grep { !/^\./ } readdir $dh ) {
            push @candidates, File::Spec->catdir( $root, $entry, '.meta' );
        }
        closedir $dh or die "Unable to close $root: $!";
    }

    return grep { -d $_ } @candidates;
}

# Purpose: decode a JSON metadata file, reporting why it was unusable instead of
#          swallowing the failure. A dropped metadata file shrinks the closure,
#          and a shrunken closure can hide exactly the finding this gate exists
#          to make, so the caller is given the reason to fail closed on rather
#          than an undef it could quietly skip.
# Input: a file path.
# Output: a two element list of the decoded hash reference and a failure reason.
#         Exactly one of the two is defined.
sub _decode_json_file {
    my ($path) = @_;

    my $handle;
    if ( !open $handle, '<', $path ) {
        return ( undef, "unreadable: $!" );    ## no critic
    }

    my $content = do { local $/; <$handle> };
    close $handle or die "Unable to close $path: $!";

    my $decoded = eval { JSON::XS->new->decode( defined $content ? $content : '' ) };
    if ( !defined $decoded || ref $decoded ne 'HASH' ) {
        my $reason = $@ || 'metadata is not a JSON object';
        chomp $reason;
        return ( undef, "unparseable: $reason" );    ## no critic
    }

    return ( $decoded, undef );    ## no critic
}

# Purpose: expand the declared requirements into the full transitive runtime
#          closure, keeping the highest floor demanded for each module.
# Input: the declared module => minimum map, and the metadata index.
# Output: a hash reference of module name => { floor, because } where "because"
#         names the requirement that produced the winning floor.
sub _closure {
    my ( $declared, $metadata ) = @_;

    my %demand;
    my @queue;
    for my $module ( sort keys %{$declared} ) {
        $demand{$module} = { floor => $declared->{$module}, because => 'declared in cpanfile' };
        push @queue, $module;
    }

    my %visited;
    while (@queue) {
        my $module = shift @queue;
        next if $visited{$module}++;

        my $dist = $metadata->{module_to_dist}{$module};
        next if !defined $dist;

        my $requires = $metadata->{runtime_requires}{$dist} || {};
        for my $required ( sort keys %{$requires} ) {
            next if $required eq 'perl';
            my $floor = defined $requires->{$required} ? $requires->{$required} : '0';
            my $because = "runtime/requires of $dist";
            if ( !exists $demand{$required} ) {
                $demand{$required} = { floor => $floor, because => $because };
            }
            elsif ( _version_cmp( $floor, $demand{$required}{floor} ) > 0 ) {
                $demand{$required} = { floor => $floor, because => $because };
            }
            push @queue, $required;
        }
    }

    return \%demand;
}

# Purpose: collapse per-module floors onto the distributions that ship them, so
#          the gate can reason about the release an installer would pick.
# Input: the closure demand map and the metadata index.
# Output: a hash reference of distribution name => { floor, because }.
sub _distribution_floors {
    my ( $demand, $metadata ) = @_;

    my %floors;
    for my $module ( sort keys %{$demand} ) {
        my $dist = $metadata->{module_to_dist}{$module};
        next if !defined $dist;

        my $floor   = $demand->{$module}{floor};
        my $because = "$module >= $floor, " . $demand->{$module}{because};
        if ( !exists $floors{$dist} || _version_cmp( $floor, $floors{$dist}{floor} ) > 0 ) {
            $floors{$dist} = { floor => $floor, because => $because };
        }
    }

    return \%floors;
}

# Purpose: read the reviewed advisory disposition list shared with the
#          installed-distribution gate.
# Input: the path to the exclusions file (missing file means no exclusions).
# Output: a hash reference of advisory id => 1.
sub _read_exclusions {
    my ($path) = @_;

    my %excluded;
    return \%excluded if !-f $path;

    open my $fh, '<', $path or die "Unable to read $path: $!";
    while ( my $line = <$fh> ) {
        chomp $line;
        $line =~ s/\s+\z//;
        next if $line =~ /\A\s*\z/ || $line =~ /\A\s*#/;
        $excluded{$line} = 1;
    }
    close $fh or die "Unable to close $path: $!";

    return \%excluded;
}

# Purpose: report every distribution whose lowest permitted release still sits
#          inside a published advisory range.
# Input: the distribution floor map, the exclusion set, and the version
#        comparator.
# Output: a list of finding hash references, sorted by distribution name.
sub _findings {
    my ( $floors, $excluded, $version_class ) = @_;

    my $db = CPAN::Audit::DB->db;
    my @findings;

    for my $dist ( sort keys %{$floors} ) {
        my $entry = $db->{dists}{$dist};
        next if !$entry;

        my $floor     = $floors->{$dist}{floor};
        my $permitted = _lowest_permitted( $entry, $floor, $version_class );

        for my $advisory ( @{ $entry->{advisories} || [] } ) {
            my $id = $advisory->{id};
            next if !defined $id || $excluded->{$id};

            my @affected = @{ $advisory->{affected_versions} || [] };
            my $hit = 0;
            for my $range (@affected) {
                $hit = 1 if _in_range( $version_class, $permitted, $range );
            }
            next if !$hit;

            push @findings, {
                distribution => $dist,
                permitted    => $permitted,
                advisory     => $id,
                affected     => join( ', ', @affected ),
                fixed        => join( ', ', @{ $advisory->{fixed_versions} || [] } ),
                floor        => $floor,
                because      => $floors->{$dist}{because},
                main_module  => $entry->{main_module} || $dist,
            };
        }
    }

    return @findings;
}

# Purpose: find the lowest released version of a distribution that the declared
#          floor still allows an installer to choose.
# Input: the advisory database entry for the distribution, the declared floor,
#        and the version comparator.
# Output: a version string - the lowest known release at or above the floor,
#         falling back to the floor itself when no release list matches.
sub _lowest_permitted {
    my ( $entry, $floor, $version_class ) = @_;

    my @permitted =
        grep { _in_range( $version_class, $_, ">=$floor" ) }
        map  { $_->{version} }
        grep { defined $_->{version} } @{ $entry->{versions} || [] };
    return $floor if !@permitted;

    my $lowest = $permitted[0];
    for my $candidate (@permitted) {
        $lowest = $candidate if _version_cmp( $candidate, $lowest ) < 0;
    }
    return $lowest;
}

# Purpose: compare a version against a CPAN::Audit range without letting an
#          unparseable version string abort the audit.
# Input: the version comparator, a version string, and a range expression.
# Output: 1 when the version falls inside the range, 0 otherwise.
sub _in_range {
    my ( $version_class, $candidate, $range ) = @_;

    my $inside = eval { $version_class->in_range( $candidate, $range ) };
    return $inside ? 1 : 0;
}

# Purpose: order two CPAN version strings without numifying them, because
#          numifying an alpha release such as 1.28_001 is lossy and emits a
#          warning, and warnings are failures in this project.
# Input: two version strings, either of which may be undef, empty, dotted
#        decimal, v-prefixed or an underscored alpha release.
# Output: -1, 0 or 1 in the usual comparison sense. Unparseable strings sort as
#         the lowest possible version rather than aborting the audit.
sub _version_cmp {
    my ( $left, $right ) = @_;

    my $left_version  = _parse_version($left);
    my $right_version = _parse_version($right);

    return $left_version <=> $right_version;
}

# Purpose: turn a CPAN version string into a comparable version object.
# Input: a version string, possibly undef, empty or unparseable.
# Output: a version object, defaulting to version 0 when parsing fails.
sub _parse_version {
    my ($raw) = @_;

    require version;
    return version->parse(0) if !defined $raw || $raw eq '';
    my $parsed = eval { version->parse($raw) };
    return defined $parsed ? $parsed : version->parse(0);
}

__END__

=head1 NAME

cpan-audit-declared-chain - audit the transitive runtime closure of the declared
dependency chain for permitted vulnerable resolutions

=head1 WHAT IT IS

A fail-closed advisory gate that reads the distribution's own declared runtime
requirements, walks every runtime requirement reachable from them using the
metadata cpanm writes next to each installed distribution, and reports any
distribution whose lowest still-permitted release falls inside a published CPAN
security advisory range.

=head1 WHAT IT IS FOR

It answers the question an installer answers, which is not the question an
installed-distribution scan answers. A scan of what happens to be installed
reports the versions a resolver already picked, and a resolver always picks the
newest release, so that scan stays green while the declared floors still permit
a vulnerable version. This gate reports the floor itself.

=head1 WHY IT EXISTS

The advisory floor list was originally derived from the modules the C<cpanfile>
names, while the real exposure comes from the transitive closure. Two modules
reached the product that way and were only caught by manual audit:

=over 4

=item * C<HTTP::Date>, required by C<libwww-perl>, where a vulnerable 6.06
satisfied every declared requirement.

=item * C<HTML::Parser>, required by C<libwww-perl> under the names
C<HTML::Entities> and C<HTML::HeadParser>, where the only floor anywhere in the
chain was 3.71 and a vulnerable 3.83 satisfied it.

=back

Neither module is named in the C<cpanfile> and neither is called by the product,
so no source-level check could ever have found them. The declared floor is the
whole mitigation, and this gate is what verifies the floor is actually there.

=head1 WHEN TO USE

Run it whenever dependency metadata changes, whenever an advisory floor is
raised, and as a continuous-integration step against the isolated dependency
root the build resolves. It is deliberately a live gate: the advisory database
moves, so a chain that was clean yesterday can legitimately fail today.

=head1 HOW TO USE

Give it the Perl library root whose distribution metadata should be walked. The
C<cpanfile> and the reviewed advisory disposition file default to the ones next
to the script, and both can be overridden. C<CPAN_AUDIT_FRESH_DAYS> overrides how
old an advisory database may be before the gate refuses to answer from it.

Exit codes are fail-closed:

=over 4

=item * C<0> - no distribution in the closure permits a version inside an
advisory range.

=item * C<1> - at least one permitted vulnerable resolution was found.

=item * C<2> - the gate could not audit the whole chain (bad usage, missing
C<CPAN::Audit>, a library root with no distribution metadata, a distribution
metadata file it could not read or parse, or an advisory database whose age
could not be established or exceeds the limit). It never reports a clean chain it
did not establish, and an unreadable metadata file is not established: dropping one
shrinks the closure, and a smaller closure is exactly what hides a finding.

=back

=head2 The advisory database is named on every run

Every run prints the advisory database behind its verdict and how old it is,
whether or not that run finds anything:

    advisory database: CPAN::Audit::DB 20260906.002 (0 days old)

This is not decoration. A verdict is only as good as the corpus it was reached
from, and on 2026-09-06 this gate reported the closure clean against a database
thirty days old that did not contain C<URI> at all - so a real advisory against
the installed C<URI> was not missed but unreportable, and the clean line looked
exactly like a clean line from a current database. Naming the corpus is what lets
a reader tell "nothing is wrong" from "nothing could have been found", and the
clean path is the one that most needs it.

=head2 Refusing a corpus too old to answer from

Past a limit the gate declines to produce a verdict at all rather than answering
from a database it cannot vouch for, and the refusal names the fix.

The threshold is C<CPAN_AUDIT_FRESH_DAYS>, which is C<CPAN::Audit>'s own variable
rather than a private one, so setting it moves upstream's freshness warning and
this refusal together instead of leaving two thresholds to disagree in silence.
The refusal names a way forward, because a refusal with no way forward gets
worked around rather than followed. That recipe creates its own directory with
C<mktemp -d> and never names a fixed path: a fixed path under world-writable
F</tmp> is predictable, C<cpanm> reuses an existing directory rather than
refusing it, and the next line of the recipe puts that directory B<first> on
C<PERL5LIB>. Recommending it would mean a security tool advising the user to
load Perl from a location they do not control (CWE-377, CWE-378). The audited
root is still echoed back at the end of the recipe so the command can be re-run
as printed - that path is the caller's own argument, not one this gate invents.

It defaults here to B<21 days> - stricter than upstream's 30, because 30 days is
precisely the age at which this project's database lacked the advisory a clean
verdict was later cited to disprove.

Twenty-one is derived rather than chosen. The limit must exceed the largest real
gap between publications, or the gate refuses during an ordinary quiet spell when
no newer database exists to install - blocking for a reason nobody can act on,
which is how a gate gets routed around instead of fixed. Measured across 40
C<CPANSA-DB> releases spanning 223 days: median gap 4 days, maximum 18. That
maximum is one sample of the tail rather than the tail, so read 21 as "above the
largest gap seen in 223 days", not as a proven ceiling; if a longer gap appears
upstream, that is the number to move.

Note that upstream already detects this and deliberately declines to act on it:
C<cpan-audit --fresh> warns through C<CPAN::Audit::FreshnessCheck> but leaves the
exit status unchanged, so no caller reading a status can see it. That is the right
choice for an interactive audit and the wrong one for a release gate. This gate
escalates a signal upstream already emits; it does not invent a policy.

=head1 WHAT USES IT

The continuous-integration dependency audit job runs it against the isolated
C<local/lib/perl5> root the build resolves, and
F<t/109-declared-chain-advisory-closure.t> exercises both its contracts and its
detection behaviour against synthetic metadata fixtures.

=head1 EXAMPLES

Example 1 - audit the isolated dependency root a build resolved:

  script/cpan-audit-declared-chain local/lib/perl5

Example 2 - audit the operator's own library root:

  script/cpan-audit-declared-chain "$HOME/perl5/lib/perl5"

Example 3 - audit a candidate cpanfile before committing it:

  script/cpan-audit-declared-chain --cpanfile /tmp/candidate-cpanfile local/lib/perl5

Example 4 - audit with an alternative reviewed disposition list:

  script/cpan-audit-declared-chain \
    --exclude-file /tmp/reviewed-advisories.txt local/lib/perl5

=head1 AUTHOR

Developer Dashboard Contributors

=cut
