lintian/lib/Lintian/Output/HTML.pm

332 lines
8.1 KiB
Perl

# Copyright (C) 2020-2021 Felix Lechner
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, you can find it on the World Wide
# Web at https://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
package Lintian::Output::HTML;
use v5.20;
use warnings;
use utf8;
use Const::Fast;
use Path::Tiny;
use Text::Markdown::Discount qw(markdown);
use Text::Xslate qw(mark_raw);
use Time::Duration;
use Time::Moment;
use Unicode::UTF8 qw(encode_utf8);
use Lintian::Output::Markdown qw(markdown_citation);
const my $EMPTY => q{};
const my $SPACE => q{ };
const my $NEWLINE => qq{\n};
const my $PARAGRAPH_BREAK => $NEWLINE x 2;
const my %CODE_PRIORITY => (
'E' => 30,
'W' => 40,
'I' => 50,
'P' => 60,
'X' => 70,
'C' => 80,
'O' => 90,
'M' => 100,
);
use Moo;
use namespace::clean;
with 'Lintian::Output::Grammar';
=head1 NAME
Lintian::Output::HTML - standalone HTML hint output
=head1 SYNOPSIS
use Lintian::Output::HTML;
=head1 DESCRIPTION
Provides standalone HTML hint output.
=head1 INSTANCE METHODS
=over 4
=item issue_hints
Print all hints passed in array. A separate arguments with processables
is necessary to report in case no hints were found.
=cut
sub issue_hints {
my ($self, $profile, $groups) = @_;
$groups //= [];
my %output;
my $lintian_version = $ENV{LINTIAN_VERSION};
$output{'lintian-version'} = $lintian_version;
my @allgroups_output;
$output{groups} = \@allgroups_output;
for my $group (sort { $a->name cmp $b->name } @{$groups}) {
my %group_output;
$group_output{'group-id'} = $group->name;
$group_output{name} = $group->source_name;
$group_output{version} = $group->source_version;
my $start = Time::Moment->from_string($group->processing_start);
my $end = Time::Moment->from_string($group->processing_end);
$group_output{start} = $start->strftime('%c');
$group_output{end} = $end->strftime('%c');
$group_output{duration} = duration($start->delta_seconds($end));
my @processables = $group->get_processables;
my $any_processable = shift @processables;
$group_output{'maintainer'}
= $any_processable->fields->value('Maintainer');
push(@allgroups_output, \%group_output);
my @allfiles_output;
$group_output{'input-files'} = \@allfiles_output;
for my $processable (sort {$a->path cmp $b->path}
$group->get_processables) {
my %file_output;
$file_output{filename} = path($processable->path)->basename;
$file_output{hints}
= $self->hintlist($profile, $processable->hints);
push(@allfiles_output, \%file_output);
}
}
my $style_sheet = $profile->data->style_sheet->css;
my $templatedir = "$ENV{LINTIAN_BASE}/templates";
my $tx = Text::Xslate->new(path => [$templatedir]);
my $page = $tx->render(
'standalone-html.tx',
{
title => 'Lintian Tags',
style_sheet => mark_raw($style_sheet),
output => \%output,
}
);
print encode_utf8($page);
return;
}
=item C<hintlist>
=cut
sub hintlist {
my ($self, $profile, $arrayref) = @_;
my %sorter;
for my $hint (@{$arrayref // []}) {
my $tag = $profile->get_tag($hint->tag_name);
my $override_status = 0;
$override_status = 1
if defined $hint->override || @{$hint->masks};
my $ranking_code = $tag->code;
$ranking_code = 'X'
if $tag->experimental;
$ranking_code = 'O'
if defined $hint->override;
$ranking_code = 'M'
if @{$hint->masks};
my $code_priority = $CODE_PRIORITY{$ranking_code};
push(
@{
$sorter{$override_status}{$code_priority}{$tag->name}
{$hint->context}
},
$hint
);
}
my @sorted;
for my $override_status (sort keys %sorter) {
my %by_code_priority = %{$sorter{$override_status}};
for my $code_priority (sort { $a <=> $b } keys %by_code_priority) {
my %by_tag_name = %{$by_code_priority{$code_priority}};
for my $tag_name (sort keys %by_tag_name) {
my %by_context = %{$by_tag_name{$tag_name}};
for my $context (sort keys %by_context) {
my $hints
= $sorter{$override_status}{$code_priority}{$tag_name}
{$context};
push(@sorted, $_)for @{$hints};
}
}
}
}
my @html_hints;
for my $hint (@sorted) {
my $tag = $profile->get_tag($hint->tag_name);
my %html_hint;
push(@html_hints, \%html_hint);
$html_hint{tag_name} = $hint->tag_name;
$html_hint{url} = 'https://lintian.debian.org/tags/' . $hint->tag_name;
$html_hint{context} = $hint->context
if length $hint->context;
$html_hint{visibility} = $tag->visibility;
$html_hint{visibility} = 'experimental'
if $tag->experimental;
my @comments;
if ($hint->override) {
$html_hint{visibility} = 'override';
push(@comments, $hint->override->justification)
if length $hint->override->justification;
}
# order matters
$html_hint{visibility} = 'mask'
if @{ $hint->masks };
for my $mask (@{$hint->masks}) {
push(@comments, 'masked by screen ' . $mask->screen);
push(@comments, $mask->excuse)
if length $mask->excuse;
}
$html_hint{comments} = \@comments
if @comments;
}
return \@html_hints;
}
=item describe_tags
=cut
sub describe_tags {
my ($self, $data, $tags) = @_;
for my $tag (@{$tags}) {
say encode_utf8('<p>Name: ' . $tag->name . '</p>');
say encode_utf8($EMPTY);
print encode_utf8(markdown($self->markdown_description($data, $tag)));
}
return;
}
=item markdown_description
=cut
sub markdown_description {
my ($self, $data, $tag) = @_;
my $description = $tag->explanation;
my @extras;
if (@{$tag->see_also}) {
my @markdown
= map { markdown_citation($data, $_) } @{$tag->see_also};
my $references
= 'Please refer to '
. $self->oxford_enumeration('and', @markdown)
. ' for details.';
push(@extras, $references);
}
push(@extras, 'Visibility: '. $tag->visibility);
push(@extras, 'Check: ' . $tag->check)
if length $tag->check;
push(@extras, 'Renamed from: ' . join($SPACE, @{$tag->renamed_from}))
if @{$tag->renamed_from};
push(@extras, 'This tag is experimental.')
if $tag->experimental;
push(@extras,
'This tag is a classification. There is no issue in your package.')
if $tag->visibility eq 'classification';
for my $screen (@{$tag->screens}) {
my $screen_description = 'Screen: ' . $screen->name . $NEWLINE;
$screen_description
.= 'Advocates: ' . join(', ', @{$screen->advocates}) . $NEWLINE;
$screen_description .= 'Reason: ' . $screen->reason . $NEWLINE;
$screen_description .= 'See-Also: ' . $NEWLINE;
push(@extras, $screen_description);
}
$description .= $PARAGRAPH_BREAK . $_ for @extras;
return $description;
}
=back
=cut
1;
# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
# End:
# vim: syntax=perl sw=4 sts=4 sr et