view release on metacpan or  search on metacpan

lib/App/CPANTS/Lint.pm  view on Meta::CPAN

        $report .= "Ignored metrics: " . join(', ', @{$res->{ignored}}) . "\n";
    }

    if ($res->{ok}) {
        $report .= "Congratulations for building a 'perfect' distribution!\n";
    }
    for my $type (qw/core extra experimental/) {
        if (my $fails = $res->{fails}{$type}) {
            $report .=
                "\n" .
                "Failed $type Kwalitee metrics and\n" .
                "what you can do to solve them:\n\n";
            for my $fail (@$fails) {
                $report .=
                    "Name: $fail->{name}\n" .
                    "Remedy: $fail->{remedy}\n";
                if ($fail->{error}) {
                    $report .= "Error: $fail->{error}\n";
                }
                $report .= "\n";
            }
        }
    }

    $report;
}

sub _supports_colour {
    my $self = shift;
    eval {
        require Term::ANSIColor;
        require Win32::Console::ANSI if $^O eq 'MSWin32';
        1
    }
}

sub _colour_scheme {
    my $self = shift;
    my %scheme = (
        heading => "bright_white",
        title => "blue",
        fail => "bright_red",
        pass => "bright_green",
        warn => "bright_yellow",
        error => "red",
        summary => "blue",
    );
    if ($^O eq 'MSWin32') {
        $scheme{$_} =~ s/bright_// for keys %scheme;
    }
    \%scheme;
}

sub _colour {
    my ($self) = @_;
    my $scheme = $self->_colour_scheme;
    my $icon = $^O eq 'MSWin32'
        ? {pass => 'o', fail => 'x'}
        : {pass => "\x{2713}", fail => "\x{2717}"};

    my $report = Term::ANSIColor::colored("Distribution: ", "bold $scheme->{heading}")
        . Term::ANSIColor::colored($self->result->{dist}, "bold $scheme->{title}")
        . "\n";
    
    my %failed;
    for my $arr (values %{$self->result->{fails}}) {
        for my $fail (@$arr) {
            $failed{$fail->{name}} = $fail;
        }
    }
    
    my $core_fails = 0;
    for my $type (qw/ Core Optional Experimental /) {
        $report .= Term::ANSIColor::colored("\n$type\n", "bold $scheme->{heading}");
        my @inds = $self->{mca}->mck->get_indicators(lc $type);
        my @fails;
        for my $ind (@inds) {
            if ($failed{ $ind->{name} }) {
                push @fails, $ind;
                $core_fails++ if $type eq 'Core';
                $report .= Term::ANSIColor::colored("  $icon->{fail} ", $scheme->{fail}) . $ind->{name};
                $report .= ": " . Term::ANSIColor::colored($failed{ $ind->{name} }{error}, $scheme->{error})
                    if $failed{ $ind->{name} }{error};
            } else {
                $report .= Term::ANSIColor::colored("  $icon->{pass} ", $scheme->{pass}) . $ind->{name};
            }
            $report .= "\n";
        }
        
        for my $fail (@fails) {
            $report .= "\n"
                . Term::ANSIColor::colored("Name:   ", "bold $scheme->{summary}")
                . Term::ANSIColor::colored("$fail->{name}\n", $scheme->{summary})
                . Term::ANSIColor::colored("Remedy: ", "bold $scheme->{summary}")
                . Term::ANSIColor::colored("$fail->{remedy}\n", $scheme->{summary});
        }
    }
    
    my $scorecolour = $scheme->{pass};
    $scorecolour = $scheme->{warn} if keys %failed;
    $scorecolour = $scheme->{fail} if $core_fails;
    
    $report .= "\n"
        . Term::ANSIColor::colored("Score: ", "bold $scheme->{heading}")
        . Term::ANSIColor::colored($self->result->{score}, "bold $scorecolour")
        . "\n";
    
    $report;
}

sub output_report {
    my $self = shift;
    if ($self->{opts}{save}) {
        my $file = $self->report_file;
        open my $fh, '>:utf8', $file or croak "Cannot write to $file: $!";
        print $fh $self->report;
    } else {
        binmode(STDOUT, ':utf8');
        print $self->report;
    }
}

sub report_file {
    my $self = shift;
    my $dir = $self->{opts}{dir} || '.';
    my $vname = $self->{mca}->d->{vname};
    if (!$vname) {
        require File::Basename;
        $vname = File::Basename::basename($self->{res}{dist});
    }
    my $extension =
        $self->{opts}{yaml} ? '.yml' :
        $self->{opts}{json} ? '.json' :
        $self->{opts}{dump} ? '.dmp' :
        '.txt';

    require File::Spec;
    File::Spec->catfile($dir, "$vname$extension");
}

1;

__END__

=encoding utf-8

=head1 NAME

App::CPANTS::Lint - front-end to Module::CPANTS::Analyse

=head1 SYNOPSIS

    use App::CPANTS::Lint;

    my $app = App::CPANTS::Lint->new(verbose => 1);
    $app->lint('path/to/Foo-Dist-1.42.tgz') or print $app->report;

    # if you need raw data
    $app->lint('path/to/Foo-Dist-1.42.tgz') or return $app->result;

    # if you need to look at the details of analysis
    $app->lint('path/to/Foo-Dist-1.42.tgz');
    print Data::Dumper::Dumper($app->stash);

=head1 DESCRIPTION