diff options
Diffstat (limited to 'lib/Lintian/Processable/Installable/Control.pm')
-rw-r--r-- | lib/Lintian/Processable/Installable/Control.pm | 99 |
1 files changed, 99 insertions, 0 deletions
diff --git a/lib/Lintian/Processable/Installable/Control.pm b/lib/Lintian/Processable/Installable/Control.pm new file mode 100644 index 0000000..b6a72d8 --- /dev/null +++ b/lib/Lintian/Processable/Installable/Control.pm @@ -0,0 +1,99 @@ +# -*- perl -*- Lintian::Processable::Installable::Control +# +# Copyright (C) 2020 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::Processable::Installable::Control; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::SomeUtils qw(uniq); + +use Lintian::Index; + +const my $SLASH => q{/}; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Installable::Control - access to collected control file data + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Installable::Control provides an interface to control file data. + +=head1 INSTANCE METHODS + +=over 4 + +=item control + +Returns the index for a binary control file. + +=cut + +has control => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $index = Lintian::Index->new; + my $archive = $self->basename; + $index->identifier("$archive (control)"); + $index->basedir($self->basedir . $SLASH . 'control'); + + # control files are not installed relative to the system root + # disallow absolute paths and symbolic links + + my @command = (qw(dpkg-deb --ctrl-tarfile), $self->path); + my $errors = $index->create_from_piped_tar(\@command); + + my @messages = uniq split(/\n/, $errors); + push(@{$index->unpack_messages}, @messages); + + return $index; + } +); + +=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 |