view release on metacpan or  search on metacpan

script/cpan-audit  view on Meta::CPAN

use constant EXIT_NORMAL =>  0;
use constant EXIT_ZERO   =>  0;
use constant EXIT_USAGE  =>  2;
use constant EXIT_BASE   => 64;

my $output_table;
BEGIN {
	$output_table = {
		text    => \&format_text,
		dumper  => \&format_dump,
		json    => \&format_json,
		default => \&format_text,
	};
}

sub format_advisory {
    my ($advisory) = @_;
    my $s = "  __BOLD__* $advisory->{id}__RESET__\n";
       $s .= "    $advisory->{description}\n";

    if ( $advisory->{affected_versions} ) {
    	my @v = ref $advisory->{affected_versions} ? @{$advisory->{affected_versions}} : $advisory->{affected_versions};
    	my $first = shift @v;
        $s .= "    Affected range: $first\n";
        $s .= "                    $_\n" for @v;
    }

    if ( $advisory->{fixed_versions} ) {
    	my @v = ref $advisory->{fixed_versions} ? @{$advisory->{fixed_versions}} : $advisory->{fixed_versions};
    	my $first = shift @v;
    	$first //= '';
        $s .= "    Fixed range:    $first\n";
        $s .= "                    $_\n" for @v;
    }

    if ( $advisory->{cves} ) {
        $s .=  "\n    CVEs: ";
        $s .=  join ', ', @{ $advisory->{cves} };
        $s .=  "\n";
    }

    if ( $advisory->{references} ) {
        $s .=  "\n    References:\n";
        foreach my $reference ( @{ $advisory->{references} || [] } ) {
            $s .=  "    $reference\n";
        }
    }

    $s .=  "\n";
    return $s;
}

use Data::Dumper;
sub dumper { Data::Dumper->new([@_])->Indent(1)->Sortkeys(1)->Terse(1)->Useqq(1)->Dump }
sub format_dump {
	my( $result ) = @_;
	return dumper($result);
}

sub format_json {
	state $rc = require JSON;
	my( $result ) = @_;
	return JSON::encode_json($result);
}

sub format_text {
	my( $result, $opts ) = @_;
	my $s = '';

	foreach my $distname ( keys %{ $result->{dists} } ) {
		my $advisories = $result->{dists}{$distname}{advisories};
		$s .= sprintf("__RED__%s (%s %s) has %d advisor%s__RESET__\n",
			$distname,
			($result->{meta}{command} eq 'installed' ? 'have' : 'requires'),
			$result->{dists}{$distname}{version},
			scalar(@$advisories),
			(scalar(@$advisories) == 1 ? 'y' : 'ies'),
		);

		foreach my $advisory ( @$advisories ) {
			$s .= format_advisory( $advisory );
		}
	}

	$s .= "\n" if length $s;

    if ( $opts->{'no-color'} or $opts->{'ascii'} ) {
        $s =~ s{__BOLD__}{}g;
        $s =~ s{__GREEN__}{}g;
        $s =~ s{__RED__}{}g;
        $s =~ s{__RESET__}{}g;
    }
    else {
        $s =~ s{__BOLD__}{\e[39;1m}g;
        $s =~ s{__GREEN__}{\e[32m}g;
        $s =~ s{__RED__}{\e[31m}g;
        $s =~ s{__RESET__}{\e[0m}g;

        $s .= "\e[0m" if length $s;
    }

	return $s;
}

sub output_version {
	my( $class, $exit_code ) = @_;

	print <<"HERE";
$0 version $VERSION using:
\tCPAN::Audit      @{[ CPAN::Audit->VERSION ]}
\tCPAN::Audit::DB  @{[ CPAN::Audit::DB->VERSION // '<not installed>' ]} (deprecated)
\tCPANSA::DB       @{[ ( eval { require CPANSA::DB } && CPANSA::DB->VERSION) // '<not installed>' ]}

HERE

	exit($exit_code);
}

sub run {
	my( $class, @args ) = @_;