diff options
Diffstat (limited to '')
-rw-r--r-- | lib/Lintian/Check/Menus.pm | 818 |
1 files changed, 818 insertions, 0 deletions
diff --git a/lib/Lintian/Check/Menus.pm b/lib/Lintian/Check/Menus.pm new file mode 100644 index 0000000..2e8f3d1 --- /dev/null +++ b/lib/Lintian/Check/Menus.pm @@ -0,0 +1,818 @@ +# menus -- lintian check script -*- perl -*- + +# somewhat of a misnomer -- it doesn't only check menus + +# Copyright (C) 1998 Christian Schwarz +# Copyright (C) 2018 Chris Lamb <lamby@debian.org> +# 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::Check::Menus; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Path::Tiny; +use Unicode::UTF8 qw(encode_utf8); + +use Lintian::Spelling qw(check_spelling check_spelling_picky); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; +const my $SPACE => q{ }; +const my $SLASH => q{/}; +const my $DOT => q{.}; +const my $QUESTION_MARK => q{?}; + +# Supported documentation formats for doc-base files. +my %known_doc_base_formats + = map { $_ => 1 }qw(html text pdf postscript info dvi debiandoc-sgml); + +# Known fields for doc-base files. The value is 1 for required fields and 0 +# for optional fields. +my %KNOWN_DOCBASE_MAIN_FIELDS = ( + 'Document' => 1, + 'Title' => 1, + 'Section' => 1, + 'Abstract' => 0, + 'Author' => 0 +); + +my %KNOWN_DOCBASE_FORMAT_FIELDS = ( + 'Format' => 1, + 'Files' => 1, + 'Index' => 0 +); + +has menu_item => (is => 'rw'); +has menumethod_item => (is => 'rw'); +has documentation => (is => 'rw', default => 0); + +sub spelling_tag_emitter { + my ($self, @orig_args) = @_; + + return sub { + return $self->pointed_hint(@orig_args, @_); + }; +} + +sub visit_installed_files { + my ($self, $item) = @_; + + if ($item->is_file) { # file checks + # menu file? + if ($item->name =~ m{^usr/(lib|share)/menu/\S}){ # correct permissions? + + $self->pointed_hint('executable-menu-file', $item->pointer, + $item->octal_permissions) + if $item->is_executable; + + return + if $item->name =~ m{^usr/(?:lib|share)/menu/README$}; + + if ($item->name =~ m{^usr/lib/}) { + $self->pointed_hint('menu-file-in-usr-lib', $item->pointer); + } + + $self->menu_item($item); + + $self->pointed_hint('bad-menu-file-name', $item->pointer) + if $item->name =~ m{^usr/(?:lib|share)/menu/menu$} + && $self->processable->name ne 'menu'; + } + #menu-methods file? + elsif ($item->name =~ m{^etc/menu-methods/\S}) { + #TODO: we should test if the menu-methods file + # is made executable in the postinst as recommended by + # the menu manual + + my $menumethod_includes_menu_h = 0; + $self->menumethod_item($item); + + if ($item->is_open_ok) { + open(my $fd, '<', $item->unpacked_path) + or die encode_utf8('Cannot open ' . $item->unpacked_path); + + while (my $line = <$fd>) { + chomp $line; + if ($line =~ /^!include menu.h/) { + $menumethod_includes_menu_h = 1; + last; + } + } + close($fd); + } + + $self->pointed_hint('menu-method-lacks-include', $item->pointer) + unless $menumethod_includes_menu_h + or $self->processable->name eq 'menu'; + } + # package doc dir? + elsif ( + $item->name =~ m{ \A usr/share/doc/(?:[^/]+/)? + (.+\.(?:html|pdf))(?:\.gz)? + \Z}xsm + ) { + my $name = $1; + unless ($name =~ m/^changelog\.html$/ + or $name =~ m/^README[.-]/ + or $name =~ m/examples/) { + $self->documentation(1); + } + } + } + + return; +} + +sub installable { + my ($self) = @_; + + my $pkg = $self->processable->name; + my $processable = $self->processable; + my $group = $self->group; + + my (%all_files, %all_links); + + my %preinst; + my %postinst; + my %prerm; + my %postrm; + + $self->check_script($processable->control->lookup('preinst'),\%preinst); + $self->check_script($processable->control->lookup('postinst'),\%postinst); + $self->check_script($processable->control->lookup('prerm'),\%prerm); + $self->check_script($processable->control->lookup('postrm'),\%postrm); + + # Populate all_{files,links} from current package and its dependencies + for my $installable ($group->get_installables) { + next + unless $processable->name eq $installable->name + || $processable->relation('strong')->satisfies($installable->name); + + for my $item (@{$installable->installed->sorted_list}) { + add_file_link_info($installable, $item->name, \%all_files, + \%all_links); + } + } + + # prerm scripts should not call update-menus + $self->pointed_hint('prerm-calls-updatemenus',$prerm{'calls-updatemenus'}) + if defined $prerm{'calls-updatemenus'}; + + # postrm scripts should not call install-docs + $self->pointed_hint('postrm-calls-installdocs', + $postrm{'calls-installdocs'}) + if defined $postrm{'calls-installdocs'}; + $self->pointed_hint('postrm-calls-installdocs', + $postrm{'calls-installdocs-r'}) + if defined $postrm{'calls-installdocs-r'}; + + # preinst scripts should not call either update-menus nor installdocs + $self->pointed_hint('preinst-calls-updatemenus', + $preinst{'calls-updatemenus'}) + if defined $preinst{'calls-updatemenus'}; + + $self->pointed_hint('preinst-calls-installdocs', + $preinst{'calls-installdocs'}) + if defined $preinst{'calls-installdocs'}; + + my $anymenu_item = $self->menu_item || $self->menumethod_item; + + # No one needs to call install-docs any more; triggers now handles that. + $self->pointed_hint('postinst-has-useless-call-to-install-docs', + $postinst{'calls-installdocs'}) + if defined $postinst{'calls-installdocs'}; + $self->pointed_hint('postinst-has-useless-call-to-install-docs', + $postinst{'calls-installdocs-r'}) + if defined $postinst{'calls-installdocs-r'}; + + $self->pointed_hint('prerm-has-useless-call-to-install-docs', + $prerm{'calls-installdocs'}) + if defined $prerm{'calls-installdocs'}; + $self->pointed_hint('prerm-has-useless-call-to-install-docs', + $prerm{'calls-installdocs-r'}) + if defined $prerm{'calls-installdocs-r'}; + + # check consistency + # docbase file? + if (my $db_dir + = $processable->installed->resolve_path('usr/share/doc-base/')){ + for my $item ($db_dir->children) { + next + if !$item->is_open_ok; + + if ($item->resolve_path->is_executable) { + + $self->pointed_hint('executable-in-usr-share-docbase', + $item->pointer, $item->octal_permissions); + next; + } + + $self->check_doc_base_file($item, \%all_files,\%all_links); + } + } elsif ($self->documentation) { + if ($pkg =~ /^libghc6?-.*-doc$/) { + # This is the library documentation for a haskell library. Haskell + # libraries register their documentation via the ghc compiler's + # documentation registration mechanism. See bug #586877. + } else { + $self->hint('possible-documentation-but-no-doc-base-registration'); + } + } + + if ($anymenu_item) { + # postinst and postrm should not need to call update-menus + # unless there is a menu-method file. However, update-menus + # currently won't enable packages that have outstanding + # triggers, leading to an update-menus call being required for + # at least some packages right now. Until this bug is fixed, + # we still require it. See #518919 for more information. + # + # That bug does not require calling update-menus from postrm, + # but debhelper apparently currently still adds that to the + # maintainer script, so don't warn if it's done. + $self->pointed_hint('postinst-does-not-call-updatemenus', + $anymenu_item->pointer) + if !defined $postinst{'calls-updatemenus'}; + + $self->pointed_hint( + 'postrm-does-not-call-updatemenus', + $self->menumethod_item->pointer + ) + if defined $self->menumethod_item + && !defined $postrm{'calls-updatemenus'} + && $pkg ne 'menu'; + + } else { + $self->pointed_hint('postinst-has-useless-call-to-update-menus', + $postinst{'calls-updatemenus'}) + if defined $postinst{'calls-updatemenus'}; + + $self->pointed_hint('postrm-has-useless-call-to-update-menus', + $postrm{'calls-updatemenus'}) + if defined $postrm{'calls-updatemenus'}; + } + + return; +} + +# ----------------------------------- + +sub check_doc_base_file { + my ($self, $item, $all_files, $all_links) = @_; + + my $pkg = $self->processable->name; + my $group = $self->group; + + # another check complains about invalid encoding + return + unless ($item->is_valid_utf8); + + my $contents = $item->decoded_utf8; + my @lines = split(/\n/, $contents); + + my $knownfields = \%KNOWN_DOCBASE_MAIN_FIELDS; + my ($field, @vals); + my %sawfields; # local for each section of control file + my %sawformats; # global for control file + my $line = 0; # global + + my $position = 1; + while (defined(my $string = shift @lines)) { + chomp $string; + + # New field. check previous field, if we have any. + if ($string =~ /^(\S+)\s*:\s*(.*)$/) { + my (@new) = ($1, $2); + if ($field) { + $self->check_doc_base_field( + $item, $line, $field, + \@vals,\%sawfields, \%sawformats, + $knownfields,$all_files, $all_links + ); + } + + $field = $new[0]; + + @vals = ($new[1]); + $line = $position; + + # Continuation of previously defined field. + } elsif ($field && $string =~ /^\s+\S/) { + push(@vals, $string); + + # All tags will be reported on the last continuation line of the + # doc-base field. + $line = $position; + + # Sections' separator. + } elsif ($string =~ /^(\s*)$/) { + $self->pointed_hint('doc-base-file-separator-extra-whitespace', + $item->pointer($position)) + if $1; + next unless $field; # skip successive empty lines + + # Check previously defined field and section. + $self->check_doc_base_field( + $item, $line, $field, + \@vals,\%sawfields, \%sawformats, + $knownfields,$all_files, $all_links + ); + $self->check_doc_base_file_section($item, $line + 1,\%sawfields, + \%sawformats, $knownfields); + + # Initialize variables for new section. + undef $field; + undef $line; + @vals = (); + %sawfields = (); + + # Each section except the first one is format section. + $knownfields = \%KNOWN_DOCBASE_FORMAT_FIELDS; + + # Everything else is a syntax error. + } else { + $self->pointed_hint('doc-base-file-syntax-error', + $item->pointer($position)); + } + + } continue { + ++$position; + } + + # Check the last field/section of the control file. + if ($field) { + $self->check_doc_base_field( + $item, $line, $field, + \@vals, \%sawfields,\%sawformats, + $knownfields,$all_files,$all_links + ); + $self->check_doc_base_file_section($item, $line, \%sawfields, + \%sawformats,$knownfields); + } + + # Make sure we saw at least one format. + $self->pointed_hint('doc-base-file-no-format-section', $item->pointer) + unless %sawformats; + + return; +} + +# Checks one field of a doc-base control file. $vals is array ref containing +# all lines of the field. Modifies $sawfields and $sawformats. +sub check_doc_base_field { + my ( + $self, $item, $position, $field,$vals, + $sawfields, $sawformats,$knownfields,$all_files, $all_links + ) = @_; + + my $pkg = $self->processable->name; + my $group = $self->group; + + my $SECTIONS = $self->data->load('doc-base/sections'); + + $self->pointed_hint('doc-base-file-unknown-field', + $item->pointer($position), $field) + unless defined $knownfields->{$field}; + $self->pointed_hint('duplicate-field-in-doc-base', + $item->pointer($position), $field) + if $sawfields->{$field}; + $sawfields->{$field} = 1; + + # Index/Files field. + # + # Check if files referenced by doc-base are included in the package. The + # Index field should refer to only one file without wildcards. The Files + # field is a whitespace-separated list of files and may contain wildcards. + # We skip without validating wildcard patterns containing character + # classes since otherwise we'd need to deal with wildcards inside + # character classes and aren't there yet. + if ($field eq 'Index' or $field eq 'Files') { + my @files = map { split($SPACE) } @{$vals}; + + if ($field eq 'Index' && @files > 1) { + $self->pointed_hint('doc-base-index-references-multiple-files', + $item->pointer($position)); + } + for my $file (@files) { + next if $file =~ m{^/usr/share/doc/}; + next if $file =~ m{^/usr/share/info/}; + + $self->pointed_hint('doc-base-file-references-wrong-path', + $item->pointer($position), $file); + } + for my $file (@files) { + my $realfile = delink($file, $all_links); + # openoffice.org-dev-doc has thousands of files listed so try to + # use the hash if possible. + my $found; + if ($realfile =~ /[*?]/) { + my $regex = quotemeta($realfile); + unless ($field eq 'Index') { + next if $regex =~ /\[/; + $regex =~ s{\\\*}{[^/]*}g; + $regex =~ s{\\\?}{[^/]}g; + $regex .= $SLASH . $QUESTION_MARK; + } + $found = grep { /^$regex\z/ } keys %{$all_files}; + } else { + $found = $all_files->{$realfile} || $all_files->{"$realfile/"}; + } + unless ($found) { + $self->pointed_hint('doc-base-file-references-missing-file', + $item->pointer($position),$file); + } + } + undef @files; + + # Format field. + } elsif ($field eq 'Format') { + my $format = join($SPACE, @{$vals}); + + # trim both ends + $format =~ s/^\s+|\s+$//g; + + $format = lc $format; + $self->pointed_hint('doc-base-file-unknown-format', + $item->pointer($position), $format) + unless $known_doc_base_formats{$format}; + $self->pointed_hint('duplicate-format-in-doc-base', + $item->pointer($position), $format) + if $sawformats->{$format}; + $sawformats->{$format} = 1; + + # Save the current format for the later section check. + $sawformats->{' *current* '} = $format; + + # Document field. + } elsif ($field eq 'Document') { + $_ = join($SPACE, @{$vals}); + + $self->pointed_hint('doc-base-invalid-document-field', + $item->pointer($position), $_) + unless /^[a-z0-9+.-]+$/; + $self->pointed_hint('doc-base-document-field-ends-in-whitespace', + $item->pointer($position)) + if /[ \t]$/; + $self->pointed_hint('doc-base-document-field-not-in-first-line', + $item->pointer($position)) + unless $position == 1; + + # Title field. + } elsif ($field eq 'Title') { + if (@{$vals}) { + my $stag_emitter + = $self->spelling_tag_emitter( + 'spelling-error-in-doc-base-title-field', + $item->pointer($position)); + check_spelling( + $self->data, + join($SPACE, @{$vals}), + $group->spelling_exceptions, + $stag_emitter + ); + check_spelling_picky($self->data, join($SPACE, @{$vals}), + $stag_emitter); + } + + # Section field. + } elsif ($field eq 'Section') { + $_ = join($SPACE, @{$vals}); + unless ($SECTIONS->recognizes($_)) { + if (m{^App(?:lication)?s/(.+)$} && $SECTIONS->recognizes($1)) { + $self->pointed_hint('doc-base-uses-applications-section', + $item->pointer($position), $_); + } elsif (m{^(.+)/(?:[^/]+)$} && $SECTIONS->recognizes($1)) { + # allows creating a new subsection to a known section + } else { + $self->pointed_hint('doc-base-unknown-section', + $item->pointer($position), $_); + } + } + + # Abstract field. + } elsif ($field eq 'Abstract') { + # The three following variables are used for checking if the field is + # correctly phrased. We detect if each line (except for the first + # line and lines containing single dot) of the field starts with the + # same number of spaces, not followed by the same non-space character, + # and the number of spaces is > 1. + # + # We try to match fields like this: + # ||Abstract: The Boost web site provides free peer-reviewed portable + # || C++ source libraries. The emphasis is on libraries which work + # || well with the C++ Standard Library. One goal is to establish + # + # but not like this: + # ||Abstract: This is "Ding" + # || * a dictionary lookup program for Unix, + # || * DIctionary Nice Grep, + my $leadsp; # string with leading spaces from second line + my $charafter; # first non-whitespace char of second line + my $leadsp_ok = 1; # are spaces OK? + + # Intentionally skipping the first line. + for my $idx (1 .. $#{$vals}) { + $_ = $vals->[$idx]; + + if (/manage\s+online\s+manuals\s.*Debian/) { + $self->pointed_hint('doc-base-abstract-field-is-template', + $item->pointer($position)) + unless $pkg eq 'doc-base'; + + } elsif (/^(\s+)\.(\s*)$/ and ($1 ne $SPACE or $2)) { + $self->pointed_hint( + 'doc-base-abstract-field-separator-extra-whitespace', + $item->pointer($position - $#{$vals} + $idx) + ); + + } elsif (!$leadsp && /^(\s+)(\S)/) { + # The regexp should always match. + ($leadsp, $charafter) = ($1, $2); + $leadsp_ok = $leadsp eq $SPACE; + + } elsif (!$leadsp_ok && /^(\s+)(\S)/) { + # The regexp should always match. + undef $charafter if $charafter && $charafter ne $2; + $leadsp_ok = 1 + if ($1 ne $leadsp) || ($1 eq $leadsp && $charafter); + } + } + + unless ($leadsp_ok) { + $self->pointed_hint( + 'doc-base-abstract-might-contain-extra-leading-whitespace', + $item->pointer($position)); + } + + # Check spelling. + if (@{$vals}) { + my $stag_emitter + = $self->spelling_tag_emitter( + 'spelling-error-in-doc-base-abstract-field', + $item->pointer($position)); + check_spelling( + $self->data, + join($SPACE, @{$vals}), + $group->spelling_exceptions, + $stag_emitter + ); + check_spelling_picky($self->data, join($SPACE, @{$vals}), + $stag_emitter); + } + } + + return; +} + +# Checks the section of the doc-base control file. Tries to find required +# fields missing in the section. +sub check_doc_base_file_section { + my ($self, $item, $position, $sawfields, $sawformats, $knownfields) = @_; + + $self->pointed_hint('doc-base-file-no-format', $item->pointer($position)) + if ((defined $sawfields->{'Files'} || defined $sawfields->{'Index'}) + && !(defined $sawfields->{'Format'})); + + # The current format is set by check_doc_base_field. + if ($sawfields->{'Format'}) { + my $format = $sawformats->{' *current* '}; + $self->pointed_hint('doc-base-file-no-index',$item->pointer($position)) + if ( $format + && ($format eq 'html' || $format eq 'info') + && !$sawfields->{'Index'}); + } + for my $field (sort keys %{$knownfields}) { + $self->pointed_hint('doc-base-file-lacks-required-field', + $item->pointer($position), $field) + if ($knownfields->{$field} == 1 && !$sawfields->{$field}); + } + + return; +} + +# Add file and link to $all_files and $all_links. Note that both files and +# links have to include a leading /. +sub add_file_link_info { + my ($processable, $file, $all_files, $all_links) = @_; + + my $link = $processable->installed->lookup($file)->link; + my $ishard = $processable->installed->lookup($file)->is_hardlink; + + # make name absolute + $file = $SLASH . $file + unless $file =~ m{^/}; + + $file =~ s{/+}{/}g; # remove duplicated `/' + $all_files->{$file} = 1; + + if (length $link) { + + $link = $DOT . $SLASH . $link + if $link !~ m{^/}; + + if ($ishard) { + $link =~ s{^\./}{/}; + } elsif ($link !~ m{^/}) { # not absolute link + $link + = $SLASH + . $link; # make sure link starts with '/' + $link =~ s{/+\./+}{/}g; # remove all /./ parts + my $dcount = 1; + while ($link =~ s{^/+\.\./+}{/}) { #\ count & remove + $dcount++; #/ any leading /../ parts + } + my $f = $file; + while ($dcount--) { #\ remove last $dcount + $f=~ s{/[^/]*$}{}; #/ path components from $file + } + $link + = $f. $link; # now we should have absolute link + } + $all_links->{$file} = $link unless ($link eq $file); + } + + return; +} + +# Dereference all symlinks in file. +sub delink { + my ($file, $all_links) = @_; + + $file =~ s{/+}{/}g; # remove duplicated '/' + return $file + unless %{$all_links}; # package doesn't symlinks + + my $p1 = $EMPTY; + my $p2 = $file; + my %used_links; + + # In the loop below we split $file into two parts on each '/' until + # there's no remaining slashes. We try substituting the first part with + # corresponding symlink and if it succeeds, we start the procedure from + # beginning. + # + # Example: + # Let $all_links{"/a/b"} == "/d", and $file == "/a/b/c" + # Then 0) $p1 == "", $p2 == "/a/b/c" + # 1) $p1 == "/a", $p2 == "/b/c" + # 2) $p1 == "/a/b", $p2 == "/c" ; substitute "/d" for "/a/b" + # 3) $p1 == "", $p2 == "/d/c" + # 4) $p1 == "/d", $p2 == "/c" + # 5) $p1 == "/d/c", $p2 == "" + # + # Note that the algorithm supposes, that + # i) $all_links{$X} != $X for each $X + # ii) both keys and values of %all_links start with '/' + + while (($p2 =~ s{^(/[^/]*)}{}g) > 0) { + $p1 .= $1; + if (defined $all_links->{$p1}) { + return '!!! SYMLINK LOOP !!!' if defined $used_links{$p1}; + $p2 = $all_links->{$p1} . $p2; + $p1 = $EMPTY; + $used_links{$p1} = 1; + } + } + + # After the loop $p2 should be empty and $p1 should contain the target + # file. In some rare cases when $file contains no slashes, $p1 will be + # empty and $p2 will contain the result (which will be equal to $file). + return $p1 ne $EMPTY ? $p1 : $p2; +} + +sub check_script { + my ($self, $item, $pres) = @_; + + my $pkg = $self->processable->name; + + my ($no_check_menu, $no_check_installdocs); + + # control files are regular files and not symlinks, pipes etc. + return + unless defined $item; + + return + if $item->is_symlink; + + return + unless $item->is_open_ok; + + # nothing to do for ELF + return + if $item->is_elf; + + my $interpreter = $item->interpreter || 'unknown'; + + if ($item->is_shell_script) { + $interpreter = 'sh'; + + } elsif ($interpreter =~ m{^/usr/bin/perl}) { + $interpreter = 'perl'; + } + + open(my $fd, '<', $item->unpacked_path) + or die encode_utf8('Cannot open ' . $item->unpacked_path); + + my $position = 1; + while (my $line = <$fd>) { + # skip comments + $line =~ s/\#.*$//; + + ## + # update-menus will satisfy the checks that the menu file + # installed is properly used + ## + + # does the script check whether update-menus exists? + $pres->{'checks-for-updatemenus'} = $item->pointer($position) + if $line =~ /-x\s+\S*update-menus/ + || $line =~ /(?:which|type)\s+update-menus/ + || $line =~ /command\s+.*?update-menus/; + + # does the script call update-menus? + # TODO this regex-magic should be moved to some lib for checking + # whether a certain word is likely called as command... --Jeroen + if ( + $line =~m{ (?:^\s*|[;&|]\s*|(?:then|do|exec)\s+) + (?:\/usr\/bin\/)?update-menus + (?:\s|[;&|<>]|\Z)}xsm + ) { + # yes, it does. + $pres->{'calls-updatemenus'} = $item->pointer($position); + + # checked first? + if (not $pres->{'checks-for-updatemenus'} and $pkg ne 'menu') { + $self->pointed_hint( +'maintainer-script-does-not-check-for-existence-of-updatemenus', + $item->pointer($position) + ) unless $no_check_menu++; + } + } + + # does the script check whether install-docs exists? + $pres->{'checks-for-installdocs'} = $item->pointer($position) + if $line =~ s/-x\s+\S*install-docs// + || $line =~/(?:which|type)\s+install-docs/ + || $line =~ s/command\s+.*?install-docs//; + + # does the script call install-docs? + if ( + $line =~ m{ (?:^\s*|[;&|]\s*|(?:then|do)\s+) + (?:\/usr\/sbin\/)?install-docs + (?:\s|[;&|<>]|\Z) }xsm + ) { + # yes, it does. Does it remove or add a doc? + if ($line =~ /install-docs\s+(?:-r|--remove)\s/) { + $pres->{'calls-installdocs-r'} = $item->pointer($position); + } else { + $pres->{'calls-installdocs'} = $item->pointer($position); + } + + # checked first? + if (not $pres->{'checks-for-installdocs'}) { + $self->pointed_hint( +'maintainer-script-does-not-check-for-existence-of-installdocs', + $item->pointer($position) + ) unless $no_check_installdocs++; + } + } + + } continue { + ++$position; + } + + close($fd); + + return; +} + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et |