diff options
Diffstat (limited to 'lib/Lintian/Processable/Source')
-rw-r--r-- | lib/Lintian/Processable/Source/Changelog.pm | 109 | ||||
-rw-r--r-- | lib/Lintian/Processable/Source/Components.pm | 126 | ||||
-rw-r--r-- | lib/Lintian/Processable/Source/Format.pm | 136 | ||||
-rw-r--r-- | lib/Lintian/Processable/Source/Orig.pm | 200 | ||||
-rw-r--r-- | lib/Lintian/Processable/Source/Overrides.pm | 109 | ||||
-rw-r--r-- | lib/Lintian/Processable/Source/Patched.pm | 161 | ||||
-rw-r--r-- | lib/Lintian/Processable/Source/Relation.pm | 267 | ||||
-rw-r--r-- | lib/Lintian/Processable/Source/Repacked.pm | 99 |
8 files changed, 1207 insertions, 0 deletions
diff --git a/lib/Lintian/Processable/Source/Changelog.pm b/lib/Lintian/Processable/Source/Changelog.pm new file mode 100644 index 0000000..a781057 --- /dev/null +++ b/lib/Lintian/Processable/Source/Changelog.pm @@ -0,0 +1,109 @@ +# -*- perl -*- Lintian::Processable::Source::Changelog -- access to collected changelog data +# +# Copyright (C) 1998 Richard Braakman +# 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, see <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Source::Changelog; + +use v5.20; +use warnings; +use utf8; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Source::Changelog - access to collected changelog data + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Source::Changelog provides an interface to changelog data. + +=head1 INSTANCE METHODS + +=over 4 + +=item changelog_item + +=cut + +has changelog_item => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $item = $self->patched->resolve_path('debian/changelog'); + + return $item; + } +); + +=item changelog + +Returns the changelog of the source package as a Parse::DebianChangelog +object, or an empty object if the changelog cannot be resolved safely. + +=cut + +has changelog => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $changelog = Lintian::Changelog->new; + + my $item = $self->changelog_item; + + # return empty changelog + return $changelog + unless defined $item && $item->is_open_ok; + + return $changelog + unless $item->is_valid_utf8; + + $changelog->parse($item->decoded_utf8); + + return $changelog; + } +); + +1; + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +# 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/Processable/Source/Components.pm b/lib/Lintian/Processable/Source/Components.pm new file mode 100644 index 0000000..1541abe --- /dev/null +++ b/lib/Lintian/Processable/Source/Components.pm @@ -0,0 +1,126 @@ +# -*- perl -*- +# Lintian::Processable::Source::Components -- interface to orig tag components +# +# 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::Source::Components; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Unicode::UTF8 qw(encode_utf8); + +use Moo::Role; +use namespace::clean; + +const my $EMPTY => q{}; + +=head1 NAME + +Lintian::Processable::Source::Components - interface to orig tar components + +=head1 SYNOPSIS + + use Moo; + + with 'Lintian::Processable::Source::Components'; + +=head1 DESCRIPTION + +Lintian::Processable::Source::Components provides an interface to data for +upstream source components. Most sources only use one tarball. + +=head1 INSTANCE METHODS + +=over 4 + +=item components + +Returns a reference to a hash containing information about source components +listed in the .dsc file. The key is the filename, and the value is the name +of the component. + +=cut + +has components => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + # determine source and version; handle missing fields + my $name = $self->fields->value('Source'); + my $version = $self->fields->value('Version'); + my $architecture = 'source'; + + # it is its own source package + my $source = $name; + my $source_version = $version; + + # version handling based on Dpkg::Version::parseversion. + my $noepoch = $source_version; + if ($noepoch =~ /:/) { + $noepoch =~ s/^(?:\d+):(.+)/$1/ + or die encode_utf8("Bad version number '$noepoch'"); + } + + my $baserev = $source . '_' . $noepoch; + + # strip debian revision + $noepoch =~ s/(.+)-(?:.*)$/$1/; + my $base = $source . '_' . $noepoch; + + my $files = $self->files; + + my %components; + for my $name (keys %{$files}) { + + # Look for $pkg_$version.orig(-$comp)?.tar.$ext (non-native) + # or $pkg_$version.tar.$ext (native) + # - This deliberately does not look for the debian packaging + # even when this would be a tarball. + if ($name + =~ /^(?:\Q$base\E\.orig(?:-(.*))?|\Q$baserev\E)\.tar\.(?:gz|bz2|lzma|xz)$/ + ) { + $components{$name} = $1 // $EMPTY; + } + } + + return \%components; + } +); + +=back + +=head1 AUTHOR + +Originally written by Adam D. Barratt <adsb@debian.org> for Lintian. + +=head1 SEE ALSO + +lintian(1), L<Lintian::Processable> + +=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/Processable/Source/Format.pm b/lib/Lintian/Processable/Source/Format.pm new file mode 100644 index 0000000..551f93e --- /dev/null +++ b/lib/Lintian/Processable/Source/Format.pm @@ -0,0 +1,136 @@ +# -*- perl -*- +# Lintian::Processable::Source::Format -- interface to source package data collection + +# Copyright (C) 2008 Russ Allbery +# Copyright (C) 2009 Raphael Geissert +# 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::Source::Format; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Path::Tiny; + +use Moo::Role; +use namespace::clean; + +const my $UNDERSCORE => q{_}; + +=head1 NAME + +Lintian::Processable::Source::Format - Lintian interface to source format + +=head1 SYNOPSIS + + my $collect = Lintian::Processable::Source::Format->new; + +=head1 DESCRIPTION + +Lintian::Processable::Source::Format provides an interface to source format +information. + +=head1 INSTANCE METHODS + +=over 4 + +=item source_format + +=cut + +has source_format => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $format = $self->fields->value('Format') || '1.0'; + + return $format; + } +); + +=item native + +Returns true if the source package is native and false otherwise. +This is generally determined from the source format, though in the 1.0 +case the nativeness is determined by looking for the diff.gz (using +the name of the source package and its version). + +If the source format is 1.0 and the version number is absent, this +will return false (as native packages are a lot rarer than non-native +ones). + +Note if the source format is missing, it is assumed to be a 1.0 +package. + +=cut + +has native => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $format = $self->source_format; + + return 0 + if $format =~ /^\s*2\.0\s*$/; + + return 0 + if $format =~ /^\s*3\.0\s+\(quilt|git\)\s*$/; + + return 1 + if $format =~ /^\s*3\.0\s+\(native\)\s*$/; + + my $version = $self->fields->value('Version'); + return 0 + unless length $version; + + # strip epoch + $version =~ s/^\d+://; + + my $diffname = $self->name . $UNDERSCORE . "$version.diff.gz"; + + return 0 + if exists $self->files->{$diffname}; + + return 1; + } +); + +=back + +=head1 AUTHOR + +Originally written by Russ Allbery <rra@debian.org> for Lintian. +Amended by Felix Lechner <felix.lechner@lease-up.com> for Lintian. + +=head1 SEE ALSO + +lintian(1), Lintian::Relation(3) + +=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/Processable/Source/Orig.pm b/lib/Lintian/Processable/Source/Orig.pm new file mode 100644 index 0000000..dd263f5 --- /dev/null +++ b/lib/Lintian/Processable/Source/Orig.pm @@ -0,0 +1,200 @@ +# -*- perl -*- Lintian::Processable::Source::Orig +# +# 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::Source::Orig; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::SomeUtils qw(uniq); +use List::UtilsBy qw(sort_by); +use Path::Tiny; +use Unicode::UTF8 qw(encode_utf8); + +use Lintian::Index; + +const my $EMPTY => q{}; +const my $SPACE => q{ }; +const my $SLASH => q{/}; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Source::Orig - access to collected data about the upstream (orig) sources + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Source::Orig provides an interface to collected data about the upstream (orig) sources. + +=head1 INSTANCE METHODS + +=over 4 + +=item orig + +Returns the index for orig.tar.gz. + +=cut + +my %DECOMPRESS_COMMAND = ( + 'gz' => 'gzip --decompress --stdout', + 'bz2' => 'bzip2 --decompress --stdout', + 'xz' => 'xz --decompress --stdout', +); + +has orig => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $index = Lintian::Index->new; + my $archive = $self->basename; + $index->identifier("$archive (orig)"); + $index->basedir($self->basedir . $SLASH . 'orig'); + + return $index + if $self->native; + + # source packages can be unpacked anywhere; no anchored roots + $index->anchored(0); + + my %components = %{$self->components}; + + # keep sort order; root is missing below otherwise + my @tarballs = sort_by { $components{$_} } keys %components; + + for my $tarball (@tarballs) { + + my $component = $components{$tarball}; + + # so far, all archives with components had an extra level + my $component_dir = $index->basedir; + $component_dir .= $SLASH . $component + if length $component; + + my $subindex = Lintian::Index->new; + $subindex->basedir($component_dir); + + # source packages can be unpacked anywhere; no anchored roots + $index->anchored(0); + + my ($extension) = ($tarball =~ /\.([^.]+)$/); + die encode_utf8("Source component $tarball has no file exension\n") + unless length $extension; + + my $decompress = $DECOMPRESS_COMMAND{lc $extension}; + die encode_utf8("Don't know how to decompress $tarball") + unless $decompress; + + my @command + = (split($SPACE, $decompress), + $self->basedir . $SLASH . $tarball); + + my $errors = $subindex->create_from_piped_tar(\@command); + + push(@{$index->unpack_messages}, "$tarball . $_") + for grep { !/^tar: Ignoring / } uniq split(/\n/, $errors); + + # treat hard links like regular files + my @hardlinks = grep { $_->is_hardlink } @{$subindex->sorted_list}; + for my $item (@hardlinks) { + + my $target = $subindex->lookup($item->link); + + $item->unpacked_path($target->unpacked_path); + $item->size($target->size); + $item->link($EMPTY); + + # turn into a regular file + my $perm = $item->perm; + $perm =~ s/^-/h/; + $item->perm($perm); + + $item->path_info( + ($item->path_info & ~Lintian::Index::Item::TYPE_HARDLINK) + | Lintian::Index::Item::TYPE_FILE); + } + + my @prefixes = @{$subindex->sorted_list}; + + # keep top level prefixes; no trailing slashes + s{^([^/]+).*$}{$1}s for @prefixes; + + # squash identical values; ignore root entry ('') + my @unique = grep { length } uniq @prefixes; + + # check for single common value + if (@unique == 1) { + + # no trailing slash for directories + my $common = $unique[0]; + + # proceed if no file with that name (lacks slash) + my $conflict = $subindex->lookup($common); + unless (defined $conflict) { + + if ($common ne $component || length $component) { + + # shortens paths; keeps same base directory + my $sub_errors = $subindex->drop_common_prefix; + + push(@{$index->unpack_errors}, "$tarball . $_") + for uniq split(/\n/, $sub_errors); + } + } + } + + # lowers base directory to match index being merged into + $subindex->capture_common_prefix + if length $component; + + $index->merge_in($subindex); + } + + 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 diff --git a/lib/Lintian/Processable/Source/Overrides.pm b/lib/Lintian/Processable/Source/Overrides.pm new file mode 100644 index 0000000..d4c446f --- /dev/null +++ b/lib/Lintian/Processable/Source/Overrides.pm @@ -0,0 +1,109 @@ +# -*- perl -*- Lintian::Processable::Source::Overrides +# +# 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, see <http://www.gnu.org/licenses/>. + +package Lintian::Processable::Source::Overrides; + +use v5.20; +use warnings; +use utf8; + +use List::SomeUtils qw(first_value); + +use Moo::Role; +use namespace::clean; + +with 'Lintian::Processable::Overrides'; + +=head1 NAME + +Lintian::Processable::Source::Overrides - access to override data + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Source::Overrides provides an interface to overrides. + +=head1 INSTANCE METHODS + +=over 4 + +=item override_file + +=cut + +has override_file => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + # prefer source/lintian-overrides to source.lintian-overrides + my @candidates = ( + 'debian/source/lintian-overrides', + 'debian/source.lintian-overrides' + ); + + # pick the first + my $override_item= first_value { defined } + map { $self->patched->lookup($_) } @candidates; + + return $override_item; + } +); + +=item overrides + +=cut + +has overrides => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + return [] + unless defined $self->override_file; + + my $contents = $self->override_file->decoded_utf8; + + return $self->parse_overrides($contents); + } +); + +1; + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner <felix.lechner@lease-up.com> for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +# 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/Processable/Source/Patched.pm b/lib/Lintian/Processable/Source/Patched.pm new file mode 100644 index 0000000..229311f --- /dev/null +++ b/lib/Lintian/Processable/Source/Patched.pm @@ -0,0 +1,161 @@ +# -*- perl -*- Lintian::Processable::Source::Patched +# +# Copyright (C) 2008 Russ Allbery +# Copyright (C) 2009 Raphael Geissert +# 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::Source::Patched; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Cwd; +use List::SomeUtils qw(uniq); +use IPC::Run3; +use Path::Tiny; +use Unicode::UTF8 qw(encode_utf8 decode_utf8); + +use Lintian::Index; +use Lintian::Index::Item; + +const my $COLON => q{:}; +const my $SLASH => q{/}; +const my $NEWLINE => qq{\n}; + +const my $NO_UMASK => 0000; +const my $WAIT_STATUS_SHIFT => 8; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Source::Patched - access to sources with Debian patches applied + +=head1 SYNOPSIS + + use Lintian::Processable; + +=head1 DESCRIPTION + +Lintian::Processable::Source::Patched provides an interface to collected data about patched sources. + +=head1 INSTANCE METHODS + +=over 4 + +=item patched + +Returns a index object representing a patched source tree. + +=cut + +has patched => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $index = Lintian::Index->new; + my $archive = $self->basename; + $index->identifier("$archive (patched)"); + $index->basedir($self->basedir . $SLASH . 'unpacked'); + + # source packages can be unpacked anywhere; no anchored roots + $index->anchored(0); + + path($index->basedir)->remove_tree + if -d $index->basedir; + + print encode_utf8("N: Using dpkg-source to unpack\n") + if $ENV{'LINTIAN_DEBUG'}; + + my $saved_umask = umask; + umask $NO_UMASK; + + my @unpack_command= ( + qw(dpkg-source -q --no-check --extract), + $self->path, $index->basedir + ); + + # ignore STDOUT; older versions are not completely quiet with -q + my $unpack_errors; + + run3(\@unpack_command, \undef, \undef, \$unpack_errors); + my $status = ($? >> $WAIT_STATUS_SHIFT); + + $unpack_errors = decode_utf8($unpack_errors) + if length $unpack_errors; + + if ($status) { + my $message = "Non-zero status $status from @unpack_command"; + $message .= $COLON . $NEWLINE . $unpack_errors + if length $unpack_errors; + + die encode_utf8($message); + } + + umask $saved_umask; + + my $index_errors = $index->create_from_basedir; + + my $savedir = getcwd; + chdir($index->basedir) + or die encode_utf8('Cannot change to directory ' . $index->basedir); + + # fix permissions + my @permissions_command + = ('chmod', '-R', 'u+rwX,o+rX,o-w', $index->basedir); + my $permissions_errors; + + run3(\@permissions_command, \undef, \undef, \$permissions_errors); + + $permissions_errors = decode_utf8($permissions_errors) + if length $permissions_errors; + + chdir($savedir) + or die encode_utf8("Cannot change to directory $savedir"); + + my @messages = grep { !/^tar: Ignoring / } + split(/\n/, $unpack_errors . $index_errors . $permissions_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 diff --git a/lib/Lintian/Processable/Source/Relation.pm b/lib/Lintian/Processable/Source/Relation.pm new file mode 100644 index 0000000..e66297c --- /dev/null +++ b/lib/Lintian/Processable/Source/Relation.pm @@ -0,0 +1,267 @@ +# -*- perl -*- +# Lintian::Processable::Source::Relation -- interface to source package data collection + +# Copyright (C) 2008 Russ Allbery +# Copyright (C) 2009 Raphael Geissert +# 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::Source::Relation; + +use v5.20; +use warnings; +use utf8; + +use Carp qw(croak); +use Unicode::UTF8 qw(encode_utf8); + +use Lintian::Relation; + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Source::Relation - Lintian interface to source package data collection + +=head1 SYNOPSIS + + my ($name, $type, $dir) = ('foobar', 'source', '/path/to/lab-entry'); + my $collect = Lintian::Processable::Source::Relation->new($name); + if ($collect->native) { + print encode_utf8("Package is native\n"); + } + +=head1 DESCRIPTION + +Lintian::Processable::Source::Relation provides an interface to package data for source +packages. It implements data collection methods specific to source +packages. + +This module is in its infancy. Most of Lintian still reads all data from +files in the laboratory whenever that data is needed and generates that +data via collect scripts. The goal is to eventually access all data about +source packages via this module so that the module can cache data where +appropriate and possibly retire collect scripts in favor of caching that +data in memory. + +=head1 INSTANCE METHODS + +=over 4 + +=item binary_relation (PACKAGE, FIELD) + +Returns a L<Lintian::Relation> object for the specified FIELD in the +binary package PACKAGE in the F<debian/control> file. FIELD should be +one of the possible relationship fields of a Debian package or one of +the following special values: + +=over 4 + +=item All + +The concatenation of Pre-Depends, Depends, Recommends, and Suggests. + +=item Strong + +The concatenation of Pre-Depends and Depends. + +=item Weak + +The concatenation of Recommends and Suggests. + +=back + +If FIELD isn't present in the package, the returned Lintian::Relation +object will be empty (present but satisfies nothing). + +Any substvars in F<debian/control> will be represented in the returned +relation as packages named after the substvar. + +=item saved_binary_relations + +=cut + +has saved_binary_relations => ( + is => 'rw', + coerce => sub { my ($hashref) = @_; return ($hashref // {}); }, + default => sub { {} } +); + +my %alias = ( + all => [qw(Pre-Depends Depends Recommends Suggests)], + strong => [qw(Pre-Depends Depends)], + weak => [qw(Recommends Suggests)] +); + +my %known = map { $_ => 1 } + qw(pre-depends depends recommends suggests enhances breaks + conflicts provides replaces); + +sub binary_relation { + my ($self, $package, $name) = @_; + + return undef + unless length $name; + + my $lowercase = lc $name; + + return undef + unless length $package; + + my $relation = $self->saved_binary_relations->{$package}{$lowercase}; + unless (defined $relation) { + + if (length $alias{$lowercase}) { + $relation + = Lintian::Relation->new->logical_and( + map { $self->binary_relation($package, $_) } + @{ $alias{$lowercase} }); + + } else { + croak encode_utf8("unknown relation field $name") + unless $known{$lowercase}; + + my $value + = $self->debian_control->installable_fields($package) + ->value($name); + $relation = Lintian::Relation->new->load($value); + } + + $self->saved_binary_relations->{$package}{$lowercase} = $relation; + } + + return $relation; +} + +=item relation (FIELD) + +Returns a L<Lintian::Relation> object for the given build relationship +field FIELD. In addition to the normal build relationship fields, the +following special field names are supported: + +=over 4 + +=item Build-Depends-All + +The concatenation of Build-Depends, Build-Depends-Arch and +Build-Depends-Indep. + +=item Build-Conflicts-All + +The concatenation of Build-Conflicts, Build-Conflicts-Arch and +Build-Conflicts-Indep. + +=back + +If FIELD isn't present in the package, the returned Lintian::Relation +object will be empty (present but satisfies nothing). + +=item saved_relation + +=cut + +has saved_relations => ( + is => 'rw', + coerce => sub { my ($hashref) = @_; return ($hashref // {}); }, + default => sub { {} } +); + +sub relation { + my ($self, $name) = @_; + + return undef + unless length $name; + + my $lowercase = lc $name; + + my $relation = $self->saved_relations->{$lowercase}; + unless (defined $relation) { + + if ($name =~ /^Build-(Depends|Conflicts)-All$/i) { + my $type = $1; + my @fields + = ("Build-$type", "Build-$type-Indep", "Build-$type-Arch"); + $relation + = Lintian::Relation->new->logical_and(map { $self->relation($_) } + @fields); + + } elsif ($name =~ /^Build-(Depends|Conflicts)(?:-(?:Arch|Indep))?$/i){ + my $value = $self->fields->value($name); + $relation = Lintian::Relation->new->load($value); + + } else { + croak encode_utf8("unknown relation field $name"); + } + + $self->saved_relations->{$lowercase} = $relation; + } + + return $relation; +} + +=item relation_norestriction (FIELD) + +The same as L</relation (FIELD)>, but ignores architecture +restrictions and build profile restrictions in the FIELD field. + +=item saved_relations_norestriction + +=cut + +has saved_relations_norestriction => ( + is => 'rw', + coerce => sub { my ($hashref) = @_; return ($hashref // {}); }, + default => sub { {} } +); + +sub relation_norestriction { + my ($self, $name) = @_; + + return undef + unless length $name; + + my $lowercase = lc $name; + + my $relation = $self->saved_relations_norestriction->{$lowercase}; + unless (defined $relation) { + + $relation = $self->relation($name)->restriction_less; + $self->saved_relations_norestriction->{$lowercase} = $relation; + } + + return $relation; +} + +=back + +=head1 AUTHOR + +Originally written by Russ Allbery <rra@debian.org> for Lintian. +Amended 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/Processable/Source/Repacked.pm b/lib/Lintian/Processable/Source/Repacked.pm new file mode 100644 index 0000000..4cf057b --- /dev/null +++ b/lib/Lintian/Processable/Source/Repacked.pm @@ -0,0 +1,99 @@ +# -*- perl -*- +# Lintian::Processable::Source::Repacked -- interface to source package data collection + +# Copyright (C) 2008 Russ Allbery +# Copyright (C) 2009 Raphael Geissert +# 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::Source::Repacked; + +use v5.20; +use warnings; +use utf8; + +use Lintian::Util qw($PKGREPACK_REGEX); + +use Moo::Role; +use namespace::clean; + +=head1 NAME + +Lintian::Processable::Source::Repacked - Lintian interface to source package data collection + +=head1 SYNOPSIS + + my ($name, $type, $dir) = ('foobar', 'source', '/path/to/lab-entry'); + my $collect = Lintian::Processable::Source::Repacked->new($name); + if ($collect->native) { + print encode_utf8("Package is native\n"); + } + +=head1 DESCRIPTION + +Lintian::Processable::Source::Repacked provides an interface to package data for source +packages. It implements data collection methods specific to source +packages. + +This module is in its infancy. Most of Lintian still reads all data from +files in the laboratory whenever that data is needed and generates that +data via collect scripts. The goal is to eventually access all data about +source packages via this module so that the module can cache data where +appropriate and possibly retire collect scripts in favor of caching that +data in memory. + +=head1 INSTANCE METHODS + +=over 4 + +=item repacked + +Returns true if the source package has been "repacked" and false otherwise. +This is determined from the version name containing "dfsg" or similar. + +=cut + +has repacked => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my $upstream = $self->changelog_version->upstream; + + return $upstream =~ $PKGREPACK_REGEX; + } +); + +=back + +=head1 AUTHOR + +Originally written by Russ Allbery <rra@debian.org> for Lintian. +Amended 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 |