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/Test/Lintian/Prepare.pm | 551 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 551 insertions(+) create mode 100644 lib/Test/Lintian/Prepare.pm (limited to 'lib/Test/Lintian/Prepare.pm') diff --git a/lib/Test/Lintian/Prepare.pm b/lib/Test/Lintian/Prepare.pm new file mode 100644 index 0000000..8914fcc --- /dev/null +++ b/lib/Test/Lintian/Prepare.pm @@ -0,0 +1,551 @@ +# Copyright (C) 2018-2020 Felix Lechner +# Copyright (C) 2019 Chris Lamb +# +# 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 Test::Lintian::Prepare; + +=head1 NAME + +Test::Lintian::Prepare -- routines to prepare the work directories + +=head1 SYNOPSIS + + use Test::Lintian::Prepare qw(prepare); + +=head1 DESCRIPTION + +The routines in this module prepare the work directories in which the +tests are run. To do so, they use the specifications in the test set. + +=cut + +use v5.20; +use warnings; +use utf8; + +use Exporter qw(import); + +BEGIN { + our @EXPORT_OK = qw( + prepare + filleval + ); +} + +use Carp; +use Const::Fast; +use Cwd qw(getcwd); +use File::Copy; +use File::Find::Rule; +use File::Path qw(make_path remove_tree); +use File::stat; +use List::Util qw(max); +use Path::Tiny; +use Text::Template; +use Unicode::UTF8 qw(encode_utf8); + +use Lintian::Deb822::Section; + +use Test::Lintian::ConfigFile qw(read_config write_config); +use Test::Lintian::Helper qw(rfc822date copy_dir_contents); +use Test::Lintian::Templates + qw(copy_skeleton_template_sets remove_surplus_templates fill_skeleton_templates); + +const my $EMPTY => q{}; +const my $SPACE => q{ }; +const my $SLASH => q{/}; +const my $COMMA => q{,}; + +=head1 FUNCTIONS + +=over 4 + +=item prepare(SPEC_PATH, SOURCE_PATH, TEST_SET, REBUILD) + +Populates a work directory SOURCE_PATH with data from the test located +in SPEC_PATH. The optional parameter REBUILD forces a rebuild if true. + +=cut + +sub prepare { + my ($specpath, $sourcepath, $testset, $force_rebuild)= @_; + + say encode_utf8('------- Preparation starts here -------'); + say encode_utf8("Work directory is $sourcepath."); + + # for template fill, earliest date without timewarp warning + my $data_epoch = $ENV{'POLICY_EPOCH'}//time; + + # read defaults + my $defaultspath = "$testset/defaults"; + + # read default file names + my $defaultfilespath = "$defaultspath/files"; + die encode_utf8("Cannot find $defaultfilespath") + unless -e $defaultfilespath; + + # read file and adjust data age threshold + my $files = read_config($defaultfilespath); + # $data_epoch= max($data_epoch, stat($defaultfilespath)->mtime); + + # read test data + my $descpath = $specpath . $SLASH . $files->unfolded_value('Fill-Values'); + my $desc = read_config($descpath); + # $data_epoch= max($data_epoch, stat($descpath)->mtime); + + # read test defaults + my $descdefaultspath + = $defaultspath . $SLASH . $files->unfolded_value('Fill-Values'); + my $defaults = read_config($descdefaultspath); + # $data_epoch= max($data_epoch, stat($descdefaultspath)->mtime); + + # start with a shallow copy of defaults + my $testcase = Lintian::Deb822::Section->new; + $testcase->store($_, $defaults->value($_)) for $defaults->names; + + die encode_utf8("Name missing for $specpath") + unless $desc->declares('Testname'); + + die encode_utf8('Outdated test specification (./debian/debian exists).') + if -e "$specpath/debian/debian"; + + if (-d $sourcepath) { + + # check for old build artifacts + my $buildstamp = "$sourcepath/build-stamp"; + say encode_utf8('Found old build artifact.') if -e $buildstamp; + + # check for old debian/debian directory + my $olddebiandir = "$sourcepath/debian/debian"; + say encode_utf8('Found old debian/debian directory.') + if -e $olddebiandir; + + # check for rebuild demand + say encode_utf8('Forcing rebuild.') if $force_rebuild; + + # delete work directory + if($force_rebuild || -e $buildstamp || -e $olddebiandir) { + say encode_utf8("Removing work directory $sourcepath."); + remove_tree($sourcepath); + } + } + + # create work directory + unless (-d $sourcepath) { + say encode_utf8("Creating directory $sourcepath."); + make_path($sourcepath); + } + + # delete old test scripts + my @oldrunners = File::Find::Rule->file->name('*.t')->in($sourcepath); + if (@oldrunners) { + unlink(@oldrunners) + or die encode_utf8("Cannot unlink @oldrunners"); + } + + my $skeletonname = $desc->unfolded_value('Skeleton'); + if (length $skeletonname) { + + # load skeleton + my $skeletonpath = "$testset/skeletons/$skeletonname"; + my $skeleton = read_config($skeletonpath); + + $testcase->store($_, $skeleton->value($_)) for $skeleton->names; + } + + # populate working directory with specified template sets + copy_skeleton_template_sets($testcase->value('Template-Sets'), + $sourcepath, $testset) + if $testcase->declares('Template-Sets'); + + # delete templates for which we have originals + remove_surplus_templates($specpath, $sourcepath); + + # copy test specification to working directory + my $offset = path($specpath)->relative($testset)->stringify; + say encode_utf8( + "Copy test specification $offset from $testset to $sourcepath."); + copy_dir_contents($specpath, $sourcepath); + + my $valuefolder = $testcase->unfolded_value('Fill-Values-Folder'); + if (length $valuefolder) { + + # load all the values in the fill values folder + my $valuepath = "$sourcepath/$valuefolder"; + my @filepaths + = File::Find::Rule->file->name('*.values')->in($valuepath); + + for my $filepath (sort @filepaths) { + my $fill_values = read_config($filepath); + + $testcase->store($_, $fill_values->value($_)) + for $fill_values->names; + } + } + + # add individual settings after skeleton + $testcase->store($_, $desc->value($_)) for $desc->names; + + # record path to specification + $testcase->store('Spec-Path', $specpath); + + # record path to specification + $testcase->store('Source-Path', $sourcepath); + + # add other helpful info to testcase + $testcase->store('Source', $testcase->unfolded_value('Testname')) + unless $testcase->declares('Source'); + + # record our effective data age as date, unless given + $testcase->store('Date', rfc822date($data_epoch)) + unless $testcase->declares('Date'); + + warn encode_utf8('Cannot override Architecture: in test ' + . $testcase->unfolded_value('Testname')) + if $testcase->declares('Architecture'); + + die encode_utf8('DEB_HOST_ARCH is not set.') + unless defined $ENV{'DEB_HOST_ARCH'}; + $testcase->store('Host-Architecture', $ENV{'DEB_HOST_ARCH'}); + + die encode_utf8('Could not get POLICY_VERSION.') + unless defined $ENV{'POLICY_VERSION'}; + $testcase->store('Standards-Version', $ENV{'POLICY_VERSION'}) + unless $testcase->declares('Standards-Version'); + + die encode_utf8('Could not get DEFAULT_DEBHELPER_COMPAT.') + unless defined $ENV{'DEFAULT_DEBHELPER_COMPAT'}; + $testcase->store('Dh-Compat-Level', $ENV{'DEFAULT_DEBHELPER_COMPAT'}) + unless $testcase->declares('Dh-Compat-Level'); + + # add additional version components + if ($testcase->declares('Version')) { + + # add upstream version + my $upstream_version = $testcase->unfolded_value('Version'); + $upstream_version =~ s/-[^-]+$//; + $upstream_version =~ s/(-|^)(\d+):/$1/; + $testcase->store('Upstream-Version', $upstream_version); + + # version without epoch + my $no_epoch = $testcase->unfolded_value('Version'); + $no_epoch =~ s/^\d+://; + $testcase->store('No-Epoch', $no_epoch); + + unless ($testcase->declares('Prev-Version')) { + my $prev_version = '0.0.1'; + $prev_version .= '-1' + unless $testcase->unfolded_value('Type') eq 'native'; + + $testcase->store('Prev-Version', $prev_version); + } + } + + # calculate build dependencies + warn encode_utf8('Cannot override Build-Depends:') + if $testcase->declares('Build-Depends'); + combine_fields($testcase, 'Build-Depends', $COMMA . $SPACE, + 'Default-Build-Depends', 'Extra-Build-Depends'); + + # calculate build conflicts + warn encode_utf8('Cannot override Build-Conflicts:') + if $testcase->declares('Build-Conflicts'); + combine_fields($testcase, 'Build-Conflicts', $COMMA . $SPACE, + 'Default-Build-Conflicts', 'Extra-Build-Conflicts'); + + # fill testcase with itself; do it twice to make sure all is done + my $hashref = deb822_section_to_hash($testcase); + $hashref = fill_hash_from_hash($hashref); + $hashref = fill_hash_from_hash($hashref); + write_hash_to_deb822_section($hashref, $testcase); + + say encode_utf8($EMPTY); + + # fill remaining templates + fill_skeleton_templates($testcase->value('Fill-Targets'), + $hashref, $data_epoch, $sourcepath, $testset) + if $testcase->declares('Fill-Targets'); + + # write the dynamic file names + my $runfiles = path($sourcepath)->child('files'); + write_config($files, $runfiles->stringify); + + # set mtime for dynamic file names + $runfiles->touch($data_epoch); + + # write the dynamic test case file + my $rundesc + = path($sourcepath)->child($files->unfolded_value('Fill-Values')); + write_config($testcase, $rundesc->stringify); + + # set mtime for dynamic test data + $rundesc->touch($data_epoch); + + say encode_utf8($EMPTY); + + # announce data age + say encode_utf8('Data epoch is : '. rfc822date($data_epoch)); + + return; +} + +=item filleval(SPEC_PATH, EVAL_PATH, TEST_SET, REBUILD) + +Populates a evaluation directory EVAL_PATH with data from the test located +in SPEC_PATH. The optional parameter REBUILD forces a rebuild if true. + +=cut + +sub filleval { + my ($specpath, $evalpath, $testset, $force_rebuild)= @_; + + say encode_utf8('------- Filling evaluation starts here -------'); + say encode_utf8("Evaluation directory is $evalpath."); + + # read defaults + my $defaultspath = "$testset/defaults"; + + # read default file names + my $defaultfilespath = "$defaultspath/files"; + die encode_utf8("Cannot find $defaultfilespath") + unless -e $defaultfilespath; + + # read file with default file names + my $files = read_config($defaultfilespath); + + # read test data + my $descpath + = $specpath . $SLASH . $files->unfolded_value('Test-Specification'); + my $desc = read_config($descpath); + + # read test defaults + my $descdefaultspath + = $defaultspath . $SLASH . $files->unfolded_value('Test-Specification'); + my $defaults = read_config($descdefaultspath); + + # start with a shallow copy of defaults + my $testcase = Lintian::Deb822::Section->new; + $testcase->store($_, $defaults->value($_)) for $defaults->names; + + die encode_utf8("Name missing for $specpath") + unless $desc->declares('Testname'); + + # delete old test scripts + my @oldrunners = File::Find::Rule->file->name('*.t')->in($evalpath); + if (@oldrunners) { + unlink(@oldrunners) + or die encode_utf8("Cannot unlink @oldrunners"); + } + + $testcase->store('Skeleton', $desc->value('Skeleton')) + unless $testcase->declares('Skeleton'); + + my $skeletonname = $testcase->unfolded_value('Skeleton'); + if (length $skeletonname) { + + # load skeleton + my $skeletonpath = "$testset/skeletons/$skeletonname"; + my $skeleton = read_config($skeletonpath); + + $testcase->store($_, $skeleton->value($_)) for $skeleton->names; + } + + # add individual settings after skeleton + $testcase->store($_, $desc->value($_)) for $desc->names; + + # populate working directory with specified template sets + copy_skeleton_template_sets($testcase->value('Template-Sets'), + $evalpath, $testset) + if $testcase->declares('Template-Sets'); + + # delete templates for which we have originals + remove_surplus_templates($specpath, $evalpath); + + # copy test specification to working directory + my $offset = path($specpath)->relative($testset)->stringify; + say encode_utf8( + "Copy test specification $offset from $testset to $evalpath."); + copy_dir_contents($specpath, $evalpath); + + my $valuefolder = $testcase->unfolded_value('Fill-Values-Folder'); + if (length $valuefolder) { + + # load all the values in the fill values folder + my $valuepath = "$evalpath/$valuefolder"; + my @filepaths + = File::Find::Rule->file->name('*.values')->in($valuepath); + + for my $filepath (sort @filepaths) { + my $fill_values = read_config($filepath); + + $testcase->store($_, $fill_values->value($_)) + for $fill_values->names; + } + } + + # add individual settings after skeleton + $testcase->store($_, $desc->value($_)) for $desc->names; + + # fill testcase with itself; do it twice to make sure all is done + my $hashref = deb822_section_to_hash($testcase); + $hashref = fill_hash_from_hash($hashref); + $hashref = fill_hash_from_hash($hashref); + write_hash_to_deb822_section($hashref, $testcase); + + say encode_utf8($EMPTY); + + # fill remaining templates + fill_skeleton_templates($testcase->value('Fill-Targets'), + $hashref, time, $evalpath, $testset) + if $testcase->declares('Fill-Targets'); + + # write the dynamic file names + my $runfiles = path($evalpath)->child('files'); + write_config($files, $runfiles->stringify); + + # write the dynamic test case file + my $rundesc + = path($evalpath)->child($files->unfolded_value('Test-Specification')); + write_config($testcase, $rundesc->stringify); + + say encode_utf8($EMPTY); + + return; +} + +=item combine_fields + +=cut + +sub combine_fields { + my ($testcase, $destination, $delimiter, @sources) = @_; + + return + unless length $destination; + + # we are combining these contents + my @contents; + for my $source (@sources) { + push(@contents, $testcase->value($source)) + if length $source; + $testcase->drop($source); + } + + # combine + for my $content (@contents) { + $testcase->store( + $destination, + join($delimiter, + grep { length }($testcase->value($destination),$content)) + ); + } + + # delete the combined entry if it is empty + $testcase->drop($destination) + unless length $testcase->value($destination); + + return; +} + +=item deb822_section_to_hash + +=cut + +sub deb822_section_to_hash { + my ($section) = @_; + + my %hash; + for my $name ($section->names) { + + my $transformed = lc $name; + $transformed =~ s/-/_/g; + + $hash{$transformed} = $section->value($name); + } + + return \%hash; +} + +=item write_hash_to_deb822_section + +=cut + +sub write_hash_to_deb822_section { + my ($hashref, $section) = @_; + + for my $name ($section->names) { + + my $transformed = lc $name; + $transformed =~ s/-/_/g; + + $section->store($name, $hashref->{$transformed}); + } + + return; +} + +=item fill_hash_from_hash + +=cut + +sub fill_hash_from_hash { + my ($hashref, $delimiters) = @_; + + $delimiters //= ['[%', '%]']; + + my %origin = %{$hashref}; + my %destination; + + # fill hash with itself + for my $key (keys %origin) { + + my $template = $origin{$key} // $EMPTY; + my $filler= Text::Template->new(TYPE => 'STRING', SOURCE => $template); + croak encode_utf8( + "Cannot read template $template: $Text::Template::ERROR") + unless $filler; + + my $generated + = $filler->fill_in(HASH => \%origin, DELIMITERS => $delimiters); + croak encode_utf8("Could not create string from template $template") + unless defined $generated; + $destination{$key} = $generated; + } + + return \%destination; +} + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner 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 -- cgit v1.2.3