diff options
Diffstat (limited to 'lib/Lintian/Check/Fields/Description.pm')
| -rw-r--r-- | lib/Lintian/Check/Fields/Description.pm | 323 |
1 files changed, 323 insertions, 0 deletions
diff --git a/lib/Lintian/Check/Fields/Description.pm b/lib/Lintian/Check/Fields/Description.pm new file mode 100644 index 0000000..9bfd5bc --- /dev/null +++ b/lib/Lintian/Check/Fields/Description.pm @@ -0,0 +1,323 @@ +# fields/description -- lintian check script -*- perl -*- + +# Copyright (C) 1998 Christian Schwarz +# +# 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::Check::Fields::Description; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; + +use Lintian::Spelling qw(check_spelling check_spelling_picky); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +# Compared to a lower-case string, so it must be all lower-case +const my $DH_MAKE_PERL_TEMPLATE => +'this description was automagically extracted from the module by dh-make-perl'; + +const my $EMPTY => q{}; +const my $SLASH => q{/}; +const my $DOUBLE_COLON => q{::}; + +const my $MAXIMUM_WIDTH => 80; + +sub spelling_tag_emitter { + my ($self, @orig_args) = @_; + return sub { + return $self->hint(@orig_args, @_); + }; +} + +sub installable { + my ($self) = @_; + + my $pkg = $self->processable->name; + my $type = $self->processable->type; + my $processable = $self->processable; + my $group = $self->group; + + my $tabs = 0; + my $template = 0; + my $unindented_list = 0; + + return + unless $processable->fields->declares('Description'); + + my $full_description= $processable->fields->untrimmed_value('Description'); + + $full_description =~ m/^([^\n]*)\n(.*)$/s; + my ($synopsis, $extended) = ($1, $2); + unless (defined $synopsis) { + # The first line will always be completely stripped but + # continuations may have leading whitespace. Therefore we + # have to strip $full_description to restore this property, + # when we use it as a fall-back value of the synopsis. + $synopsis = $full_description; + + # trim both ends + $synopsis =~ s/^\s+|\s+$//g; + + $extended = $EMPTY; + } + + $extended //= $EMPTY; + + if ($synopsis =~ m/^\s*$/) { + $self->hint('description-synopsis-is-empty'); + } else { + if ($synopsis =~ m/^\Q$pkg\E\b/i) { + $self->hint('description-starts-with-package-name'); + } + if ($synopsis =~ m/^(an?|the)\s/i) { + $self->hint('description-synopsis-starts-with-article'); + } + if ($synopsis =~ m/(.*\.)(?:\s*$|\s+\S+)/i) { + $self->hint('synopsis-is-a-sentence',"\"$synopsis\"") + unless $1 =~ m/\s+etc\.$/ + or $1 =~ m/\s+e\.?g\.$/ + or $1 =~ m/(?<!\.)\.\.\.$/; + } + if ($synopsis =~ m/\t/) { + $self->hint('description-contains-tabs') unless $tabs++; + } + + $self->hint('odd-mark-in-description', + 'comma not followed by whitespace (synopsis)') + if $synopsis =~ /,[^\s\d]/; + + if ($synopsis =~ m/^missing\s*$/i) { + $self->hint('description-is-debmake-template') unless $template++; + } elsif ($synopsis =~ m/<insert up to 60 chars description>/) { + $self->hint('description-is-dh_make-template') unless $template++; + } + if ($synopsis !~ m/\s/) { + $self->hint('description-too-short', $synopsis); + } + my $pkg_fmt = lc $pkg; + my $synopsis_fmt = lc $synopsis; + # made a fuzzy match + $pkg_fmt =~ s/[-_]/ /g; + $synopsis_fmt =~ s{[-_/\\]}{ }g; + $synopsis_fmt =~ s/\s+/ /g; + if ($pkg_fmt eq $synopsis_fmt) { + $self->hint('description-is-pkg-name', $synopsis); + } + + $self->hint('synopsis-too-long') + if length $synopsis > $MAXIMUM_WIDTH; + } + + my $PLANNED_FEATURES= $self->data->load('description/planned-features'); + + my $flagged_homepage; + my @lines = split(/\n/, $extended); + + # count starts for extended description + my $position = 1; + for my $line (@lines) { + next + if $line =~ /^ \.\s*$/; + + if ($position == 1) { + my $firstline = lc $line; + my $lsyn = lc $synopsis; + if ($firstline =~ /^\Q$lsyn\E$/) { + $self->hint('description-synopsis-is-duplicated', + "line $position"); + } else { + $firstline =~ s/[^a-zA-Z0-9]+//g; + $lsyn =~ s/[^a-zA-Z0-9]+//g; + if ($firstline eq $lsyn) { + $self->hint('description-synopsis-is-duplicated', + "line $position"); + } + } + } + + if ($line =~ /^ \.\s*\S/ || $line =~ /^ \s+\.\s*$/) { + $self->hint('description-contains-invalid-control-statement', + "line $position"); + } elsif ($line =~ /^ [\-\*]/) { + # Print it only the second time. Just one is not enough to be sure that + # it's a list, and after the second there's no need to repeat it. + $self->hint('possible-unindented-list-in-extended-description', + "line $position") + if $unindented_list++ == 2; + } + + if ($line =~ /\t/) { + $self->hint('description-contains-tabs', "line $position") + unless $tabs++; + } + + if ($line =~ m{^\s*Homepage: <?https?://}i) { + $self->hint('description-contains-homepage', "line $position"); + $flagged_homepage = 1; + } + + if ($PLANNED_FEATURES->matches_any($line, 'i')) { + $self->hint('description-mentions-planned-features', + "(line $position)"); + } + + $self->hint('odd-mark-in-description', + "comma not followed by whitespace (line $position)") + if $line =~ /,[^\s\d]/; + + $self->hint('description-contains-dh-make-perl-template', + "line $position") + if lc($line) =~ / \Q$DH_MAKE_PERL_TEMPLATE\E /msx; + + my $first_person = $line; + my %seen; + while ($first_person + =~ m/(?:^|\s)(I|[Mm]y|[Oo]urs?|mine|myself|me|us|[Ww]e)(?:$|\s)/) { + my $word = $1; + $first_person =~ s/\Q$word//; + $self->hint('using-first-person-in-description', + "line $position: $word") + unless $seen{$word}++; + } + + if ($position == 1) { + # checks for the first line of the extended description: + if ($line =~ /^ \s/) { + $self->hint('description-starts-with-leading-spaces', + "line $position"); + } + if ($line =~ /^\s*missing\s*$/i) { + $self->hint('description-is-debmake-template',"line $position") + unless $template++; + } elsif ( + $line =~ /<insert long description, indented with spaces>/) { + $self->hint('description-is-dh_make-template',"line $position") + unless $template++; + } + } + + $self->hint('extended-description-line-too-long', "line $position") + if length $line > $MAXIMUM_WIDTH; + + } continue { + ++$position; + } + + if ($type ne 'udeb') { + if (@lines == 0) { + # Ignore debug packages with empty "extended" description + # "debug symbols for pkg foo" is generally descriptive + # enough. + $self->hint('extended-description-is-empty') + unless $processable->is_debug_package; + + } elsif (@lines < 2 && $synopsis !~ /(?:dummy|transition)/i) { + $self->hint('extended-description-is-probably-too-short') + unless $processable->is_transitional + || $processable->is_meta_package + || $pkg =~ m{-dbg\Z}xsm; + + } elsif ($extended =~ /^ \.\s*\n|\n \.\s*\n \.\s*\n|\n \.\s*\n?$/) { + $self->hint('extended-description-contains-empty-paragraph'); + } + } + + # Check for a package homepage in the description and no Homepage + # field. This is less accurate and more of a guess than looking + # for the old Homepage: convention in the body. + unless ($processable->fields->declares('Homepage') or $flagged_homepage) { + if ( + $extended =~ m{homepage|webpage|website|url|upstream|web\s+site + |home\s+page|further\s+information|more\s+info + |official\s+site|project\s+home}xi + && $extended =~ m{\b(https?://[a-z0-9][^>\s]+)}i + ) { + $self->hint('description-possibly-contains-homepage', $1); + } elsif ($extended =~ m{\b(https?://[a-z0-9][^>\s]+)>?\.?\s*\z}i) { + $self->hint('description-possibly-contains-homepage', $1); + } + } + + if ($synopsis) { + check_spelling( + $self->data, + $synopsis, + $group->spelling_exceptions, + $self->spelling_tag_emitter( + 'spelling-error-in-description-synopsis') + ); + # Auto-generated dbgsym packages will use the package name in + # their synopsis. Unfortunately, some package names trigger a + # capitalization error, such as "dbus" -> "D-Bus". Therefore, + # we exempt auto-generated packages from this check. + check_spelling_picky( + $self->data, + $synopsis, + $self->spelling_tag_emitter( + 'capitalization-error-in-description-synopsis') + ) unless $processable->is_auto_generated; + } + + if ($extended) { + check_spelling( + $self->data,$extended, + $group->spelling_exceptions, + $self->spelling_tag_emitter('spelling-error-in-description') + ); + check_spelling_picky($self->data, $extended, + $self->spelling_tag_emitter('capitalization-error-in-description') + ); + } + + if ($pkg =~ /^lib(.+)-perl$/) { + my $mod = $1; + my @mod_path_elements = split(/-/, $mod); + $mod = join($DOUBLE_COLON, map {ucfirst} @mod_path_elements); + my $mod_lc = lc($mod); + + my $pm_found = 0; + my $pmpath = join($SLASH, @mod_path_elements).'.pm'; + my $pm = $mod_path_elements[-1].'.pm'; + + for my $filepath (@{$processable->installed->sorted_list}) { + if ($filepath =~ m{\Q$pmpath\E\z|/\Q$pm\E\z}i) { + $pm_found = 1; + last; + } + } + + $self->hint('perl-module-name-not-mentioned-in-description', $mod) + if (index(lc($extended), $mod_lc) < 0 and $pm_found); + } + + return; +} + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et |