From 75808db17caf8b960b351e3408e74142f4c85aac Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sun, 14 Apr 2024 15:42:30 +0200 Subject: Adding upstream version 2.117.0. Signed-off-by: Daniel Baumann --- lib/Lintian/Check/Desktop/Dbus.pm | 189 +++++++++++++++++++++++ lib/Lintian/Check/Desktop/Gnome.pm | 49 ++++++ lib/Lintian/Check/Desktop/Gnome/Gir.pm | 166 ++++++++++++++++++++ lib/Lintian/Check/Desktop/Gnome/Gir/Substvars.pm | 65 ++++++++ lib/Lintian/Check/Desktop/Icons.pm | 69 +++++++++ lib/Lintian/Check/Desktop/X11.pm | 94 +++++++++++ lib/Lintian/Check/Desktop/X11/Font/Update.pm | 159 +++++++++++++++++++ 7 files changed, 791 insertions(+) create mode 100644 lib/Lintian/Check/Desktop/Dbus.pm create mode 100644 lib/Lintian/Check/Desktop/Gnome.pm create mode 100644 lib/Lintian/Check/Desktop/Gnome/Gir.pm create mode 100644 lib/Lintian/Check/Desktop/Gnome/Gir/Substvars.pm create mode 100644 lib/Lintian/Check/Desktop/Icons.pm create mode 100644 lib/Lintian/Check/Desktop/X11.pm create mode 100644 lib/Lintian/Check/Desktop/X11/Font/Update.pm (limited to 'lib/Lintian/Check/Desktop') diff --git a/lib/Lintian/Check/Desktop/Dbus.pm b/lib/Lintian/Check/Desktop/Dbus.pm new file mode 100644 index 0000000..31d1f79 --- /dev/null +++ b/lib/Lintian/Check/Desktop/Dbus.pm @@ -0,0 +1,189 @@ +# desktop/dbus -- lintian check script, vaguely based on apache2 -*- perl -*- +# +# Copyright (C) 2012 Arno Toell +# Copyright (C) 2014 Collabora Ltd. +# 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::Desktop::Dbus; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::UtilsBy qw(uniq_by); + +const my $EMPTY => q{}; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub installable { + my ($self) = @_; + + my $index = $self->processable->installed; + + my @files; + for my $prefix (qw(etc/dbus-1 usr/share/dbus-1)) { + for my $suffix (qw(session system)) { + + my $folder = $index->resolve_path("${prefix}/${suffix}.d"); + next + unless defined $folder; + + push(@files, $folder->children); + } + } + + my @unique = uniq_by { $_->name } @files; + + $self->check_policy($_) for @unique; + + if (my $folder= $index->resolve_path('usr/share/dbus-1/services')) { + + $self->check_service($_, session => 1) for $folder->children; + } + + if (my $folder= $index->resolve_path('usr/share/dbus-1/system-services')) { + $self->check_service($_) for $folder->children; + } + + return; +} + +my $PROPERTIES = 'org.freedesktop.DBus.Properties'; + +sub check_policy { + my ($self, $item) = @_; + + $self->pointed_hint('dbus-policy-in-etc', $item->pointer) + if $item->name =~ m{^etc/}; + + my $xml = $item->decoded_utf8; + return + unless length $xml; + + # Parsing XML via regexes is evil, but good enough here... + # note that we are parsing the entire file as one big string, + # so that we catch or whatever. + + my @rules; + # a small rubbish state machine: we want to match a containing + # any or rule that is about sending + my $policy = $EMPTY; + while ($xml =~ m{(]*>)|()|(<(?:allow|deny)[^>]*>)}sg) + { + if (defined $1) { + $policy = $1; + + } elsif (defined $2) { + $policy = $EMPTY; + + } else { + push(@rules, $policy.$3); + } + } + + my $position = 1; + for my $rule (@rules) { + # normalize whitespace a bit so we can report it sensibly: + # typically it will now look like + # + $rule =~ s{\s+}{ }g; + + if ($rule =~ m{send_} && $rule !~ m{send_destination=}) { + # It is about sending but does not specify a send-destination. + # This could be bad. + + if ($rule =~ m{[^>]*user=['"]root['"].*pointed_hint('dbus-policy-without-send-destination', + $item->pointer($position), $rule); + + if ( $rule =~ m{send_interface=} + && $rule !~ m{send_interface=['"]\Q${PROPERTIES}\E['"]}) { + # That's undesirable, because it opens up communication + # with arbitrary services and can undo DoS mitigation + # efforts; but at least it's specific to an interface + # other than o.fd.DBus.Properties, so all that should + # happen is that the service sends back an error message. + # + # Properties doesn't count as an effective limitation, + # because it's a sort of meta-interface. + + } elsif ($rule =~ m{pointed_hint('dbus-policy-excessively-broad', + $item->pointer($position), $rule); + } + } + } + + $self->pointed_hint('dbus-policy-at-console', + $item->pointer($position), $rule) + if $rule =~ m{at_console=['"]true}; + + } continue { + ++$position; + } + + return; +} + +sub check_service { + my ($self, $item, %kwargs) = @_; + + my $text = $item->decoded_utf8; + return + unless length $text; + + while ($text =~ m{^Name=(.*)$}gm) { + + my $name = $1; + + next + if $item->basename eq "${name}.service"; + + if ($kwargs{session}) { + $self->pointed_hint('dbus-session-service-wrong-name', + $item->pointer,"better: ${name}.service"); + + } else { + $self->pointed_hint('dbus-system-service-wrong-name', + $item->pointer, "better: ${name}.service"); + } + } + + return; +} + +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/Check/Desktop/Gnome.pm b/lib/Lintian/Check/Desktop/Gnome.pm new file mode 100644 index 0000000..16bb0d1 --- /dev/null +++ b/lib/Lintian/Check/Desktop/Gnome.pm @@ -0,0 +1,49 @@ +# desktop/gnome -- lintian check script -*- perl -*- + +# Copyright (C) 1998 Christian Schwarz and Richard Braakman +# +# 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::Desktop::Gnome; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub visit_installed_files { + my ($self, $item) = @_; + + # /etc/gconf/schemas + $self->pointed_hint('package-installs-into-etc-gconf-schemas', + $item->pointer) + if $item->name =~ m{^etc/gconf/schemas/\S}; + + return; +} + +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/Check/Desktop/Gnome/Gir.pm b/lib/Lintian/Check/Desktop/Gnome/Gir.pm new file mode 100644 index 0000000..6f18594 --- /dev/null +++ b/lib/Lintian/Check/Desktop/Gnome/Gir.pm @@ -0,0 +1,166 @@ +# desktop/gnome/gir -- lintian check script for GObject-Introspection -*- perl -*- +# +# Copyright (C) 2012 Arno Toell +# Copyright (C) 2014 Collabora Ltd. +# Copyright (C) 2016 Simon McVittie +# +# 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::Desktop::Gnome::Gir; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; + +const my $DOLLAR => q{$}; + +const my $NONE => q{NONE}; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub source { + my ($self) = @_; + + my $debian_control = $self->processable->debian_control; + + for my $installable ($debian_control->installables) { + + $self->pointed_hint('typelib-missing-gir-depends', + $debian_control->item->pointer, $installable) + if $installable =~ m/^gir1\.2-/ + && !$self->processable->binary_relation($installable, 'strong') + ->satisfies($DOLLAR . '{gir:Depends}'); + } + + return; +} + +sub installable { + my ($self) = @_; + + my $DEB_HOST_MULTIARCH= $self->data->architectures->deb_host_multiarch; + my $triplet = $DEB_HOST_MULTIARCH->{$self->processable->architecture}; + + # Slightly contrived, but it might be Architecture: all, in which + # case this is the best we can do + $triplet = $DOLLAR . '{DEB_HOST_MULTIARCH}' + unless defined $triplet; + + my $xml_dir + = $self->processable->installed->resolve_path('usr/share/gir-1.0/'); + + my @girs; + @girs = grep { $_->name =~ m{ [.]gir $}x } $xml_dir->children + if defined $xml_dir; + + my @type_libs; + + my $old_dir + = $self->processable->installed->resolve_path( + 'usr/lib/girepository-1.0/'); + + if (defined $old_dir) { + + $self->pointed_hint('typelib-not-in-multiarch-directory', + $_->pointer,"usr/lib/$triplet/girepository-1.0") + for $old_dir->children; + + push(@type_libs, $old_dir->children); + } + + my $multiarch_dir= $self->processable->installed->resolve_path( + "usr/lib/$triplet/girepository-1.0"); + push(@type_libs, $multiarch_dir->children) + if defined $multiarch_dir; + + my $section = $self->processable->fields->value('Section'); + if ($section ne 'libdevel' && $section ne 'oldlibs') { + + $self->pointed_hint('gir-section-not-libdevel', $_->pointer, + $section || $NONE) + for @girs; + } + + if ($section ne 'introspection' && $section ne 'oldlibs') { + + $self->pointed_hint('typelib-section-not-introspection', + $_->pointer, $section || $NONE) + for @type_libs; + } + + if ($self->processable->architecture eq 'all') { + + $self->pointed_hint('gir-in-arch-all-package', $_->pointer)for @girs; + + $self->pointed_hint('typelib-in-arch-all-package', $_->pointer) + for @type_libs; + } + + GIR: for my $gir (@girs) { + + my $expected = 'gir1.2-' . lc($gir->basename); + $expected =~ s/\.gir$//; + $expected =~ tr/_/-/; + + for my $installable ($self->group->get_installables) { + next + unless $installable->name =~ m/^gir1\.2-/; + + my $name = $installable->name; + my $version = $installable->fields->value('Version'); + + next GIR + if $installable->relation('Provides')->satisfies($expected) + && $self->processable->relation('strong') + ->satisfies("$name (= $version)"); + } + + my $our_version = $self->processable->fields->value('Version'); + + $self->pointed_hint('gir-missing-typelib-dependency', + $gir->pointer, $expected) + unless $self->processable->relation('strong') + ->satisfies("$expected (= $our_version)"); + } + + for my $type_lib (@type_libs) { + + my $expected = 'gir1.2-' . lc($type_lib->basename); + $expected =~ s/\.typelib$//; + $expected =~ tr/_/-/; + + $self->pointed_hint('typelib-package-name-does-not-match', + $type_lib->pointer, $expected) + if $self->processable->name ne $expected + && !$self->processable->relation('Provides')->satisfies($expected); + } + + return; +} + +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/Check/Desktop/Gnome/Gir/Substvars.pm b/lib/Lintian/Check/Desktop/Gnome/Gir/Substvars.pm new file mode 100644 index 0000000..d667717 --- /dev/null +++ b/lib/Lintian/Check/Desktop/Gnome/Gir/Substvars.pm @@ -0,0 +1,65 @@ +# desktop/gnome/gir/substvars -- lintian check script -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# Copyright (C) 2020 Chris Lamb +# 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::Check::Desktop::Gnome::Gir::Substvars; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; + +const my $DOLLAR => q{$}; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub source { + my ($self) = @_; + + my $debian_control = $self->processable->debian_control; + + for my $installable ($debian_control->installables) { + + next + unless $installable =~ m{ gir [\d.]+ - .* - [\d.]+ $}x; + + my $relation= $self->processable->binary_relation($installable, 'all'); + + $self->pointed_hint( + 'gobject-introspection-package-missing-depends-on-gir-depends', + $debian_control->item->pointer,$installable) + unless $relation->satisfies($DOLLAR . '{gir:Depends}'); + } + + return; +} + +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/Check/Desktop/Icons.pm b/lib/Lintian/Check/Desktop/Icons.pm new file mode 100644 index 0000000..95565ed --- /dev/null +++ b/lib/Lintian/Check/Desktop/Icons.pm @@ -0,0 +1,69 @@ +# desktop/icons -- lintian check script -*- perl -*- + +# Copyright (C) 1998 Christian Schwarz and Richard Braakman +# +# 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::Desktop::Icons; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub visit_installed_files { + my ($self, $item) = @_; + + if ($item->name =~ m{/icons/[^/]+/(\d+)x(\d+)/(?!animations/).*\.png$}){ + + my $directory_width = $1; + my $directory_height = $2; + + my $resolved = $item->resolve_path; + + if ($resolved && $resolved->file_type =~ m/,\s*(\d+)\s*x\s*(\d+)\s*,/){ + + my $file_width = $1; + my $file_height = $2; + + my $width_delta = abs($directory_width - $file_width); + my $height_delta = abs($directory_height - $file_height); + + $self->pointed_hint('icon-size-and-directory-name-mismatch', + $item->pointer, $file_width.'x'.$file_height) + if $width_delta > 2 || $height_delta > 2; + } + } + + $self->pointed_hint('raster-image-in-scalable-directory', $item->pointer) + if $item->is_file + && $item->name =~ m{/icons/[^/]+/scalable/.*\.(?:png|xpm)$}; + + return; +} + +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/Check/Desktop/X11.pm b/lib/Lintian/Check/Desktop/X11.pm new file mode 100644 index 0000000..4373980 --- /dev/null +++ b/lib/Lintian/Check/Desktop/X11.pm @@ -0,0 +1,94 @@ +# desktop/x11 -- lintian check script -*- perl -*- + +# Copyright (C) 1998 Christian Schwarz and Richard Braakman +# +# 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::Desktop::X11; + +use v5.20; +use warnings; +use utf8; + +use List::SomeUtils qw(any none); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +has fontdirs => (is => 'rw', default => sub { {} }); + +sub visit_installed_files { + my ($self, $item) = @_; + + # links to FHS locations are allowed + $self->pointed_hint('package-installs-file-to-usr-x11r6', $item->pointer) + if $item->name =~ m{^usr/X11R6/} && !$item->is_symlink; + + return + if $item->is_dir; + + # /usr/share/fonts/X11 + my ($subdir) = ($item->name =~ m{^usr/share/fonts/X11/([^/]+)/\S+}); + if (defined $subdir) { + + $self->fontdirs->{$subdir}++ + if any { $subdir eq $_ } qw(100dpi 75dpi misc); + + if (any { $subdir eq $_ } qw(PEX CID Speedo cyrillic)) { + $self->pointed_hint('file-in-discouraged-x11-font-directory', + $item->pointer); + + } elsif (none { $subdir eq $_ } + qw(100dpi 75dpi misc Type1 encodings util)) { + $self->pointed_hint('file-in-unknown-x11-font-directory', + $item->pointer); + + } elsif ($item->basename eq 'encodings.dir' + or $item->basename =~ m{fonts\.(dir|scale|alias)}) { + $self->pointed_hint('package-contains-compiled-font-file', + $item->pointer); + } + } + + return; +} + +sub installable { + my ($self) = @_; + + # X11 font directories with files + my %fontdirs = %{$self->fontdirs}; + + # check for multiple DPIs in the same X11 bitmap font package. + $self->hint('package-contains-multiple-dpi-fonts') + if $fontdirs{'100dpi'} && $fontdirs{'75dpi'}; + + $self->hint('package-mixes-misc-and-dpi-fonts') + if $fontdirs{misc} && keys %fontdirs > 1; + + return; +} + +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/Check/Desktop/X11/Font/Update.pm b/lib/Lintian/Check/Desktop/X11/Font/Update.pm new file mode 100644 index 0000000..2315e7d --- /dev/null +++ b/lib/Lintian/Check/Desktop/X11/Font/Update.pm @@ -0,0 +1,159 @@ +# desktop/x11/font/update -- lintian check script -*- perl -*- +# +# Copyright (C) 1998 Richard Braakman +# Copyright (C) 2002 Josip Rodin +# Copyright (C) 2016-2019 Chris Lamb +# 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::Desktop::X11::Font::Update; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Unicode::UTF8 qw(encode_utf8); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; + +# When detecting commands inside shell scripts, use this regex to match the +# beginning of the command rather than checking whether the command is at the +# beginning of a line. +const my $LEADING_PATTERN=> +'(?:(?:^|[`&;(|{])\s*|(?:if|then|do|while|!)\s+|env(?:\s+[[:alnum:]_]+=(?:\S+|\"[^"]*\"|\'[^\']*\'))*\s+)'; +const my $LEADING_REGEX => qr/$LEADING_PATTERN/; + +has x_fonts => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my @x_fonts + = grep { m{^usr/share/fonts/X11/.*\.(?:afm|pcf|pfa|pfb)(?:\.gz)?$} } + @{$self->processable->installed->sorted_list}; + + return \@x_fonts; + } +); + +sub visit_control_files { + my ($self, $item) = @_; + + return + unless $item->is_maintainer_script; + + return + unless length $item->interpreter; + + return + unless $item->is_open_ok; + + open(my $fd, '<', $item->unpacked_path) + or die encode_utf8('Cannot open ' . $item->unpacked_path); + + my $stashed = $EMPTY; + + my $saw_update_fonts = 0; + + my $position = 1; + while (my $possible_continuation = <$fd>) { + + chomp $possible_continuation; + + # skip empty lines + next + if $possible_continuation =~ /^\s*$/; + + # skip comment lines + next + if $possible_continuation =~ /^\s*\#/; + + my $no_comment = remove_comments($possible_continuation); + + # Concatenate lines containing continuation character (\) + # at the end + if ($no_comment =~ s{\\$}{}) { + + $stashed .= $no_comment; + + next; + } + + my $line = $stashed . $no_comment; + $stashed = $EMPTY; + + $saw_update_fonts = 1 + if $line + =~ m{$LEADING_REGEX(?:/usr/bin/)?update-fonts-(?:alias|dir|scale)\s(\S+)}; + + } continue { + ++$position; + } + + close $fd; + + if ($item->name eq 'postinst' && !$saw_update_fonts) { + + $self->pointed_hint('missing-call-to-update-fonts', $item->pointer, $_) + for @{$self->x_fonts}; + } + + return; +} + +sub remove_comments { + my ($line) = @_; + + return $line + unless length $line; + + my $simplified = $line; + + # Remove quoted strings so we can more easily ignore comments + # inside them + $simplified =~ s/(^|[^\\](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g; + $simplified =~ s/(^|[^\\](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + + # If the remaining string contains what looks like a comment, + # eat it. In either case, swap the unmodified script line + # back in for processing (if required) and return it. + if ($simplified =~ m/(?:^|[^[\\])[\s\&;\(\)](\#.*$)/) { + + my $comment = $1; + + # eat comment + $line =~ s/\Q$comment\E//; + } + + return $line; +} + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et -- cgit v1.2.3