diff options
Diffstat (limited to 'lib/Lintian/Output')
| -rw-r--r-- | lib/Lintian/Output/EWI.pm | 614 | ||||
| -rw-r--r-- | lib/Lintian/Output/Grammar.pm | 84 | ||||
| -rw-r--r-- | lib/Lintian/Output/HTML.pm | 331 | ||||
| -rw-r--r-- | lib/Lintian/Output/JSON.pm | 322 | ||||
| -rw-r--r-- | lib/Lintian/Output/Markdown.pm | 224 | ||||
| -rw-r--r-- | lib/Lintian/Output/Universal.pm | 151 |
6 files changed, 1726 insertions, 0 deletions
diff --git a/lib/Lintian/Output/EWI.pm b/lib/Lintian/Output/EWI.pm new file mode 100644 index 0000000..af0fac6 --- /dev/null +++ b/lib/Lintian/Output/EWI.pm @@ -0,0 +1,614 @@ +# Copyright (C) 2008 Frank Lichtenheld <frank@lichtenheld.de> +# Copyright (C) 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::EWI; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use HTML::HTML5::Entities; +use List::Compare; +use Term::ANSIColor (); +use Text::Wrap; +use Unicode::UTF8 qw(encode_utf8); + +use Lintian::Output::Markdown qw(markdown_citation); + +# for tty hyperlinks +const my $OSC_HYPERLINK => qq{\033]8;;}; +const my $OSC_DONE => qq{\033\\}; +const my $BEL => qq{\a}; + +const my $EMPTY => q{}; +const my $SPACE => q{ }; +const my $COLON => q{:}; +const my $DOT => q{.}; +const my $NEWLINE => qq{\n}; +const my $PARAGRAPH_BREAK => $NEWLINE x 2; + +const my $YES => q{yes}; +const my $NO => q{no}; + +const my $COMMENT_PREFIX => q{N:} . $SPACE; + +const my $DESCRIPTION_INDENTATION => 2; +const my $DESCRIPTION_PREFIX => $COMMENT_PREFIX + . $SPACE x $DESCRIPTION_INDENTATION; + +const my $SCREEN_INDENTATION => 4; +const my $SCREEN_PREFIX => $COMMENT_PREFIX . $SPACE x $SCREEN_INDENTATION; + +const my %COLORS => ( + 'E' => 'bright_white on_bright_red', + 'W' => 'black on_bright_yellow', + 'I' => 'bright_white on_bright_blue', + 'P' => 'bright_white on_green', + 'C' => 'bright_white on_bright_magenta', + 'X' => 'bright_white on_yellow', + 'O' => 'bright_white on_bright_black', + 'M' => 'bright_black on_bright_white', +); + +const my %CODE_PRIORITY => ( + 'E' => 30, + 'W' => 40, + 'I' => 50, + 'P' => 60, + 'X' => 70, + 'C' => 80, + 'O' => 90, + 'M' => 100, +); + +const my %TYPE_PRIORITY => ( + 'source' => 30, + 'binary' => 40, + 'udeb' => 50, + 'changes' => 60, + 'buildinfo' => 70, +); + +use Moo; +use namespace::clean; + +with 'Lintian::Output::Grammar'; + +=head1 NAME + +Lintian::Output::EWI - standard hint output + +=head1 SYNOPSIS + + use Lintian::Output::EWI; + +=head1 DESCRIPTION + +Provides standard hint output. + +=head1 INSTANCE METHODS + +=over 4 + +=item tag_count_by_processable + +=cut + +has tag_count_by_processable => (is => 'rw', default => sub { {} }); + +=item issue_hints + +=cut + +sub issue_hints { + my ($self, $profile, $groups, $option) = @_; + + my %sorter; + for my $group (@{$groups // []}) { + + for my $processable ($group->get_processables) { + + my $type = $processable->type; + my $type_priority = $TYPE_PRIORITY{$type}; + + for my $hint (@{$processable->hints}) { + + 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}; + + my %for_output; + $for_output{hint} = $hint; + $for_output{processable} = $processable; + + push( + @{ + $sorter{$override_status}{$code_priority}{$tag->name} + {$type_priority}{$processable->name}{$hint->context} + }, + \%for_output + ); + } + } + } + + 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_type_priority = %{$by_tag_name{$tag_name}}; + + for + my $type_priority (sort { $a <=> $b }keys %by_type_priority){ + + my %by_processable_name + = %{$by_type_priority{$type_priority}}; + + for my $processable_name (sort keys %by_processable_name) { + + my %by_context + = %{$by_processable_name{$processable_name}}; + + for my $context (sort keys %by_context) { + + my $for_output + = $sorter{$override_status}{$code_priority} + {$tag_name}{$type_priority}{$processable_name} + {$context}; + + for my $each (@{$for_output}) { + + my $hint = $each->{hint}; + my $processable = $each->{processable}; + + $self->print_hint($profile, $hint, + $processable,$option) + if ( !defined $hint->override + && !@{$hint->masks}) + || $option->{'show-overrides'}; + } + } + } + } + } + } + } + + return; +} + +=item C<print_hint> + +=cut + +sub print_hint { + my ($self, $profile, $hint, $processable, $option) = @_; + + my $tag_name = $hint->tag_name; + my $tag = $profile->get_tag($tag_name); + + my @want_references = @{$option->{'display-source'} // []}; + my @have_references = @{$tag->see_also}; + + # keep only the first word + s{^ ([\w-]+) \s }{$1}x for @have_references; + + # drop anything in parentheses at the end + s{ [(] \S+ [)] $}{}x for @have_references; + + # check if hint refers to the selected references + my $reference_lc= List::Compare->new(\@have_references, \@want_references); + + my @found_references = $reference_lc->get_intersection; + + return + if @want_references + && !@found_references; + + my $information = $hint->context; + $information = $SPACE . $self->_quote_print($information) + unless $information eq $EMPTY; + + # Limit the output so people do not drown in hints. Some hints are + # insanely noisy (hi static-library-has-unneeded-section) + my $limit = $option->{'tag-display-limit'}; + if ($limit) { + + my $processable_id = $processable->identifier; + my $emitted_count + = $self->tag_count_by_processable->{$processable_id}{$tag_name}++; + + return + if $emitted_count >= $limit; + + my $msg + = ' ... use "--tag-display-limit 0" to see all (or pipe to a file/program)'; + $information = $self->_quote_print($msg) + if $emitted_count >= $limit-1; + } + + say encode_utf8('N:') + if $option->{info}; + + my $text = $tag_name; + + my $code = $tag->code; + $code = 'X' if $tag->experimental; + $code = 'O' if defined $hint->override; + $code = 'M' if @{$hint->masks}; + + my $tag_color = $COLORS{$code}; + + $text = Term::ANSIColor::colored($tag_name, $tag_color) + if $option->{color}; + + my $output; + if ($option->{hyperlinks} && $option->{color}) { + my $target= 'https://lintian.debian.org/tags/' . $tag_name; + $output .= $self->osc_hyperlink($text, $target); + } else { + $output .= $text; + } + + local $Text::Wrap::columns + = $option->{'output-width'} - length $COMMENT_PREFIX; + + # do not wrap long words such as urls; see #719769 + local $Text::Wrap::huge = 'overflow'; + + if ($hint->override && length $hint->override->justification) { + + my $wrapped = wrap($COMMENT_PREFIX, $COMMENT_PREFIX, + $hint->override->justification); + say encode_utf8($wrapped); + } + + for my $mask (@{$hint->masks}) { + + say encode_utf8($COMMENT_PREFIX . 'masked by screen ' . $mask->screen); + + next + unless length $mask->excuse; + + my $wrapped= wrap($COMMENT_PREFIX, $COMMENT_PREFIX, $mask->excuse); + say encode_utf8($wrapped); + } + + my $type = $EMPTY; + $type = $SPACE . $processable->type + unless $processable->type eq 'binary'; + + say encode_utf8($code + . $COLON + . $SPACE + . $processable->name + . $type + . $COLON + . $SPACE + . $output + . $information); + + if ($option->{info}) { + + # show only on first issuance + $self->describe_tag($profile->data, $tag, $option->{'output-width'}) + unless $self->issued_tag($tag->name); + } + + return; +} + +=item C<_quote_print($string)> + +Called to quote a string. By default it will replace all +non-printables with "?". Sub-classes can override it if +they allow non-ascii printables etc. + +=cut + +sub _quote_print { + my ($self, $string) = @_; + + $string =~ s/[^[:print:]]/?/g; + + return $string; +} + +=item C<osc_hyperlink> + +=cut + +sub osc_hyperlink { + my ($self, $text, $target) = @_; + + my $start = $OSC_HYPERLINK . $target . $BEL; + my $end = $OSC_HYPERLINK . $BEL; + + return $start . $text . $end; +} + +=item issuedtags + +Hash containing the names of tags which have been issued. + +=cut + +has issuedtags => (is => 'rw', default => sub { {} }); + +=item C<issued_tag($tag_name)> + +Indicate that the named tag has been issued. Returns a boolean value +indicating whether the tag had previously been issued by the object. + +=cut + +sub issued_tag { + my ($self, $tag_name) = @_; + + return $self->issuedtags->{$tag_name}++ ? 1 : 0; +} + +=item describe_tags + +=cut + +sub describe_tags { + my ($self, $data, $tags, $columns) = @_; + + for my $tag (@{$tags}) { + + my $name; + my $code; + + if (defined $tag) { + $name = $tag->name; + $code = $tag->code; + + } else { + $name = 'unknown-tag'; + $code = 'N'; + } + + say encode_utf8('N:'); + say encode_utf8("$code: $name"); + + $self->describe_tag($data, $tag, $columns); + } + + return; +} + +=item describe_tag + +=cut + +sub describe_tag { + my ($self, $data, $tag, $columns) = @_; + + local $Text::Wrap::columns = $columns; + + # do not wrap long words such as urls; see #719769 + local $Text::Wrap::huge = 'overflow'; + + my $wrapped = $COMMENT_PREFIX . $NEWLINE; + + if (defined $tag) { + + my $plain_explanation = markdown_to_plain($tag->explanation, + $columns - length $DESCRIPTION_PREFIX); + + $wrapped .= $DESCRIPTION_PREFIX . $_ . $NEWLINE + for split(/\n/, $plain_explanation); + + if (@{$tag->see_also}) { + + $wrapped .= $COMMENT_PREFIX . $NEWLINE; + + my @see_also_markdown + = map { markdown_citation($data, $_) } @{$tag->see_also}; + my $markdown + = 'Please refer to ' + . $self->oxford_enumeration('and', @see_also_markdown) + . ' for details.' + . $NEWLINE; + my $plain = markdown_to_plain($markdown, + $columns - length $DESCRIPTION_PREFIX); + + $wrapped .= $DESCRIPTION_PREFIX . $_ . $NEWLINE + for split(/\n/, $plain); + } + + $wrapped .= $COMMENT_PREFIX . $NEWLINE; + + my $visibility_prefix = 'Visibility: '; + $wrapped.= wrap( + $DESCRIPTION_PREFIX . $visibility_prefix, + $DESCRIPTION_PREFIX . $SPACE x length $visibility_prefix, + $tag->visibility . $NEWLINE + ); + + $wrapped .= wrap($DESCRIPTION_PREFIX, $DESCRIPTION_PREFIX, + 'Show-Always: '. ($tag->show_always ? $YES : $NO) . $NEWLINE); + + my $check_prefix = 'Check: '; + $wrapped .= wrap( + $DESCRIPTION_PREFIX . $check_prefix, + $DESCRIPTION_PREFIX . $SPACE x length $check_prefix, + $tag->check . $NEWLINE + ); + + if (@{$tag->renamed_from}) { + + $wrapped .= wrap($DESCRIPTION_PREFIX, $DESCRIPTION_PREFIX, + 'Renamed from: ' + . join($SPACE, @{$tag->renamed_from}) + . $NEWLINE); + } + + $wrapped + .= wrap($DESCRIPTION_PREFIX, $DESCRIPTION_PREFIX, + 'This tag is experimental.' . $NEWLINE) + if $tag->experimental; + + $wrapped .= wrap($DESCRIPTION_PREFIX, $DESCRIPTION_PREFIX, + 'This tag is a classification. There is no issue in your package.' + . $NEWLINE) + if $tag->visibility eq 'classification'; + + for my $screen (@{$tag->screens}) { + + $wrapped .= $COMMENT_PREFIX . $NEWLINE; + + $wrapped + .= wrap($DESCRIPTION_PREFIX, $DESCRIPTION_PREFIX, + 'Screen: ' . $screen->name . $NEWLINE); + + $wrapped .= wrap($SCREEN_PREFIX, $SCREEN_PREFIX, + 'Advocates: '. join(', ', @{$screen->advocates}). $NEWLINE); + + my $combined = $screen->reason . $NEWLINE; + if (@{$screen->see_also}) { + + $combined .= $NEWLINE; + + my @see_also_markdown + = map { markdown_citation($data, $_) } @{$screen->see_also}; + $combined + .= 'Read more in ' + . $self->oxford_enumeration('and', @see_also_markdown) + . $DOT + . $NEWLINE; + } + + my $reason_prefix = 'Reason: '; + my $plain = markdown_to_plain($combined, + $columns - length($SCREEN_PREFIX . $reason_prefix)); + + my @lines = split(/\n/, $plain); + $wrapped + .= $SCREEN_PREFIX . $reason_prefix . (shift @lines) . $NEWLINE; + $wrapped + .= $SCREEN_PREFIX + . $SPACE x (length $reason_prefix) + . $_ + . $NEWLINE + for @lines; + } + + } else { + $wrapped + .= wrap($DESCRIPTION_PREFIX, $DESCRIPTION_PREFIX, 'Unknown tag.'); + } + + $wrapped .= $COMMENT_PREFIX . $NEWLINE; + + print encode_utf8($wrapped); + + return; +} + +=item markdown_to_plain + +=cut + +sub markdown_to_plain { + my ($markdown, $columns) = @_; + + # use angular brackets for emphasis + $markdown =~ s{<i>|<em>}{<}g; + $markdown =~ s{</i>|</em>}{>}g; + + # drop Markdown hyperlinks + $markdown =~ s{\[([^\]]+)\]\([^\)]+\)}{$1}g; + + # drop all HTML tags except Markdown shorthand <$url> + $markdown =~ s{<(?![a-z]+://)[^>]+>}{}g; + + # drop brackets around Markdown shorthand <$url> + $markdown =~ s{<([a-z]+://[^>]+)>}{$1}g; + + # substitute HTML entities + my $plain = decode_entities($markdown); + + local $Text::Wrap::columns = $columns + if defined $columns; + + # do not wrap long words such as urls; see #719769 + local $Text::Wrap::huge = 'overflow'; + + my @paragraphs = split(/\n{2,}/, $plain); + + my @lines; + for my $paragraph (@paragraphs) { + + # do not wrap preformatted paragraphs + unless ($paragraph =~ /^\s/) { + + # reduce whitespace throughout, including newlines + $paragraph =~ s/\s+/ /g; + + # trim beginning and end of each line + $paragraph =~ s/^\s+|\s+$//mg; + + $paragraph = wrap($EMPTY, $EMPTY, $paragraph); + } + + push(@lines, $EMPTY); + push(@lines, split(/\n/, $paragraph)); + } + + # drop leading blank line + shift @lines; + + my $wrapped; + $wrapped .= $_ . $NEWLINE for @lines; + + return $wrapped; +} + +=back + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Output/Grammar.pm b/lib/Lintian/Output/Grammar.pm new file mode 100644 index 0000000..e9d62bd --- /dev/null +++ b/lib/Lintian/Output/Grammar.pm @@ -0,0 +1,84 @@ +# Copyright (C) 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::Grammar; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; + +use Moo::Role; +use namespace::clean; + +const my $EMPTY => q{}; +const my $SPACE => q{ }; +const my $COMMA => q{,}; + +=head1 NAME + +Lintian::Output::Grammar - sentence helpers + +=head1 SYNOPSIS + + use Lintian::Output::Grammar; + +=head1 DESCRIPTION + +Helps with human readable output. + +=head1 INSTANCE METHODS + +=over 4 + +=item oxford_enumeration + +=cut + +sub oxford_enumeration { + my ($self, $conjunctive, @alternatives) = @_; + + return $EMPTY + unless @alternatives; + + # remove and save last element + my $final = pop @alternatives; + + my $maybe_comma = (@alternatives > 1 ? $COMMA : $EMPTY); + + my $text = $EMPTY; + $text = join($COMMA . $SPACE, @alternatives) . "$maybe_comma $conjunctive " + if @alternatives; + + $text .= $final; + + return $text; +} + +=back + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Output/HTML.pm b/lib/Lintian/Output/HTML.pm new file mode 100644 index 0000000..8fd1126 --- /dev/null +++ b/lib/Lintian/Output/HTML.pm @@ -0,0 +1,331 @@ +# 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 diff --git a/lib/Lintian/Output/JSON.pm b/lib/Lintian/Output/JSON.pm new file mode 100644 index 0000000..08996e2 --- /dev/null +++ b/lib/Lintian/Output/JSON.pm @@ -0,0 +1,322 @@ +# 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::JSON; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Time::Piece; +use JSON::MaybeXS; + +use Lintian::Output::Markdown qw(markdown_citation); + +const my $EMPTY => q{}; + +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; + +=head1 NAME + +Lintian::Output::JSON - JSON hint output + +=head1 SYNOPSIS + + use Lintian::Output::JSON; + +=head1 DESCRIPTION + +Provides JSON 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; + + $output{lintian_version} = $ENV{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{source_name} = $group->source_name; + $group_output{source_version} = $group->source_version; + + 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{path} = $processable->path; + $file_output{hints} + = $self->hintlist($profile, $processable->hints); + + push(@allfiles_output, \%file_output); + } + } + + # convert to UTF-8 prior to encoding in JSON + my $encoder = JSON->new; + $encoder->canonical; + $encoder->utf8; + $encoder->pretty; + + my $json = $encoder->encode(\%output); + + # output encoded JSON; is already in UTF-8 + print $json; + + 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 @hint_dictionaries; + for my $hint (@sorted) { + + my $tag = $profile->get_tag($hint->tag_name); + + my %hint_dictionary; + push(@hint_dictionaries, \%hint_dictionary); + + $hint_dictionary{tag} = $tag->name; + $hint_dictionary{note} = $hint->note; + + if ($hint->can('pointer')) { + my $pointer = $hint->pointer; + + my %pointer_dictionary; + + if ($pointer->can('item')) { + my $item = $pointer->item; + + my %item_dictionary; + $item_dictionary{name} = $item->name; + $item_dictionary{index} = $item->index->identifier; + + $pointer_dictionary{item} = \%item_dictionary; + + # numerify to force JSON integer + # https://metacpan.org/pod/JSON::XS#simple-scalars + $pointer_dictionary{line_position} = $pointer->position + 0; + } + + $hint_dictionary{pointer} = \%pointer_dictionary; + } + + $hint_dictionary{visibility} = $tag->visibility; + $hint_dictionary{experimental} + = ($tag->experimental ? JSON()->true : JSON()->false); + + for my $mask (@{ $hint->masks }) { + + my %mask_dictionary; + $mask_dictionary{screen} = $mask->screen; + $mask_dictionary{excuse} = $mask->excuse; + + push(@{$hint_dictionary{masks}}, \%mask_dictionary); + } + + if ($hint->override) { + + my %override_dictionary; + $override_dictionary{justification} + = $hint->override->justification; + + $hint_dictionary{override} = \%override_dictionary; + } + } + + return \@hint_dictionaries; +} + +=item describe_tags + +=cut + +sub describe_tags { + my ($self, $data, $tags) = @_; + + my @tag_dictionaries; + + for my $tag (@{$tags}) { + + my %tag_dictionary; + push(@tag_dictionaries, \%tag_dictionary); + + $tag_dictionary{name} = $tag->name; + $tag_dictionary{name_spaced} + = ($tag->name_spaced ? JSON()->true : JSON()->false); + $tag_dictionary{show_always} + = ($tag->show_always ? JSON()->true : JSON()->false); + + $tag_dictionary{explanation} = $tag->explanation; + + my @tag_see_also_markdown + = map { markdown_citation($data, $_) } @{$tag->see_also}; + $tag_dictionary{see_also} = \@tag_see_also_markdown; + + $tag_dictionary{check} = $tag->check; + $tag_dictionary{visibility} = $tag->visibility; + $tag_dictionary{experimental} + = ($tag->experimental ? JSON()->true : JSON()->false); + + $tag_dictionary{renamed_from} = $tag->renamed_from; + + my @screen_dictionaries; + + for my $screen (@{$tag->screens}) { + + my %screen_dictionary; + push(@screen_dictionaries, \%screen_dictionary); + + $screen_dictionary{name} = $screen->name; + + my @advocate_emails = map { $_->format } @{$screen->advocates}; + $screen_dictionary{advocates} = \@advocate_emails; + + $screen_dictionary{reason} = $screen->reason; + + my @screen_see_also_markdown + = map { markdown_citation($data, $_) } @{$screen->see_also}; + $screen_dictionary{see_also} = \@screen_see_also_markdown; + } + + $tag_dictionary{screens} = \@screen_dictionaries; + + $tag_dictionary{lintian_version} = $ENV{LINTIAN_VERSION}; + } + + # convert to UTF-8 prior to encoding in JSON + my $encoder = JSON->new; + $encoder->canonical; + $encoder->utf8; + $encoder->pretty; + + # encode single tags without array bracketing + my $object = \@tag_dictionaries; + $object = shift @tag_dictionaries + if @tag_dictionaries == 1; + + my $json = $encoder->encode($object); + + # output encoded JSON; is already in UTF-8 + print $json; + + return; +} + +=back + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Output/Markdown.pm b/lib/Lintian/Output/Markdown.pm new file mode 100644 index 0000000..5786612 --- /dev/null +++ b/lib/Lintian/Output/Markdown.pm @@ -0,0 +1,224 @@ +# -*- perl -*- +# +# Copyright (C) 1998 Christian Schwarz and Richard Braakman +# Copyright (C) 2009 Russ Allbery +# 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, see <http://www.gnu.org/licenses/>. + +package Lintian::Output::Markdown; + +use v5.20; +use warnings; +use utf8; + +use Exporter qw(import); + +our @EXPORT_OK = qw( + markdown_citation + markdown_authority + markdown_bug + markdown_manual_page + markdown_uri + markdown_hyperlink +); + +use Const::Fast; + +const my $EMPTY => q{}; +const my $SPACE => q{ }; + +=head1 NAME + +Lintian::Output::Markdown - Lintian interface for markdown output + +=head1 SYNOPSIS + + use Lintian::Output::Markdown; + +=head1 DESCRIPTION + +Lintian::Output::Markdown provides functions for Markdown output. + +=head1 FUNCTIONS + +=over 4 + +=item markdown_citation + +=cut + +sub markdown_citation { + my ($data, $citation) = @_; + + if ($citation =~ m{^ ([\w-]+) \s+ (.+) $}x) { + + my $volume = $1; + my $section = $2; + + my $markdown = $data->markdown_authority_reference($volume, $section); + + $markdown ||= $citation; + + return $markdown; + } + + if ($citation =~ m{^ ([\w.-]+) [(] (\d\w*) [)] $}x) { + + my $name = $1; + my $section = $2; + + return markdown_manual_page($name, $section); + } + + if ($citation =~ m{^(?:Bug)?#(\d+)$}) { + + my $number = $1; + return markdown_bug($number); + } + + # turn bare file into file uris + $citation =~ s{^ / }{file://}x; + + # strip scheme from uri + if ($citation =~ s{^ (\w+) : // }{}x) { + + my $scheme = $1; + + return markdown_uri($scheme, $citation); + } + + return $citation; +} + +=item markdown_authority + +=cut + +sub markdown_authority { + my ($volume_title, $volume_url, $section_key, $section_title,$section_url) + = @_; + + my $directed_link; + $directed_link = markdown_hyperlink($section_title, $section_url) + if length $section_title + && length $section_url; + + my $pointer; + if (length $section_key) { + + if ($section_key =~ /^[A-Z]+$/ || $section_key =~ /^appendix-/) { + $pointer = "Appendix $section_key"; + + } elsif ($section_key =~ /^\d+$/) { + $pointer = "Chapter $section_key"; + + } else { + $pointer = "Section $section_key"; + } + } + + # overall manual. + my $volume_link = markdown_hyperlink($volume_title, $volume_url); + + if (length $directed_link) { + + return "$directed_link ($pointer) in the $volume_title" + if length $pointer; + + return "$directed_link in the $volume_title"; + } + + return "$pointer of the $volume_link" + if length $pointer; + + return "the $volume_link"; +} + +=item markdown_bug + +=cut + +sub markdown_bug { + my ($number) = @_; + + return markdown_hyperlink("Bug#$number","https://bugs.debian.org/$number"); +} + +=item markdown_manual_page + +=cut + +sub markdown_manual_page { + my ($name, $section) = @_; + + my $url + ="https://manpages.debian.org/cgi-bin/man.cgi?query=$name&sektion=$section"; + my $hyperlink = markdown_hyperlink("$name($section)", $url); + + return "the $hyperlink manual page"; +} + +=item markdown_uri + +=cut + +sub markdown_uri { + my ($scheme, $locator) = @_; + + my $url = "$scheme://$locator"; + + # use plain path as label for files + return markdown_hyperlink($locator, $url) + if $scheme eq 'file'; + + # or nothing for everything else + return markdown_hyperlink($EMPTY, $url); +} + +=item markdown_hyperlink + +=cut + +sub markdown_hyperlink { + my ($text, $url) = @_; + + return $text + unless length $url; + + return "<$url>" + unless length $text; + + return "[$text]($url)"; +} + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et diff --git a/lib/Lintian/Output/Universal.pm b/lib/Lintian/Output/Universal.pm new file mode 100644 index 0000000..a16da49 --- /dev/null +++ b/lib/Lintian/Output/Universal.pm @@ -0,0 +1,151 @@ +# Copyright (C) 2019-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::Universal; + +use v5.20; +use warnings; +use utf8; + +use Carp; +use Const::Fast; +use List::SomeUtils qw(all); +use Unicode::UTF8 qw(encode_utf8); + +const my $SPACE => q{ }; +const my $COLON => q{:}; +const my $LEFT_PARENTHESIS => q{(}; +const my $RIGHT_PARENTHESIS => q{)}; + +use Moo; +use namespace::clean; + +=head1 NAME + +Lintian::Output::Universal -- Facilities for printing universal hints + +=head1 SYNOPSIS + + use Lintian::Output::Universal; + +=head1 DESCRIPTION + +A class for printing hints using the 'universal' format. + +=head1 INSTANCE METHODS + +=over 4 + +=item issue_hints + +Passing all groups with all processables in case no hints were found. + +=cut + +sub issue_hints { + my ($self, $profile, $groups) = @_; + + for my $group (@{$groups // []}) { + + my @by_group; + for my $processable ($group->get_processables) { + + for my $hint (@{$processable->hints}) { + + my $line + = $processable->name + . $SPACE + . $LEFT_PARENTHESIS + . $processable->type + . $RIGHT_PARENTHESIS + . $COLON + . $SPACE + . $hint->tag_name; + + $line .= $SPACE . $hint->context + if length $hint->context; + + push(@by_group, $line); + } + } + + my @sorted + = reverse sort { order($a) cmp order($b) } @by_group; + + say encode_utf8($_) for @sorted; + } + + return; +} + +=item order + +=cut + +sub order { + my ($line) = @_; + + return package_type($line) . $line; +} + +=item package_type + +=cut + +sub package_type { + my ($line) = @_; + + my (undef, $type, undef, undef) = parse_line($line); + return $type; +} + +=item parse_line + +=cut + +sub parse_line { + my ($line) = @_; + + my ($package, $type, $name, $details) + = $line =~ qr/^(\S+)\s+\(([^)]+)\):\s+(\S+)(?:\s+(.*))?$/; + + croak encode_utf8("Cannot parse line $line") + unless all { length } ($package, $type, $name); + + return ($package, $type, $name, $details); +} + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et |