Import perl (5.30.0-9)debian/5.30.0-9debian

3 files changed, 516 insertions, 0 deletions

diff --git a/debian/t/control.t b/debian/t/control.t
new file mode 100755
index 0000000..7fef97f
--- /dev/null
+++ b/debian/t/control.t
@@ -0,0 +1,406 @@
+#!/usr/bin/perl -w
+use strict;
+use lib "./dist/Module-CoreList/lib";
+
+# Copyright 2011 Niko Tyni
+# 
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+
+# This script was created for checking the Breaks/Replaces/Provides
+# triplets in the debian/control file of the Debian perl source package.
+#
+# 1) check the versioned Breaks against Module::CoreList information
+#  
+# 2) check that all Breaks entries have appropriate Replaces and Provides
+#    entries
+#
+# 3) check that there are no packages in the Debian archive (as seen via
+#    the local apt package cache) that should have Breaks/Replaces/Provides
+#    entries
+#
+# See the the hashes below for hardcoded special cases that will probably
+# need to be updated in the future.
+
+# get the list of deprecated packages
+my %deprecated;
+require './lib/deprecate.pm';
+{ 
+	no warnings 'once';
+	%deprecated = reverse %deprecate::DEBIAN_PACKAGES;
+}
+
+# list packages that have acquired more digits in Debian than upstream uses
+# this happens because CPAN and Debian versioning systems differ
+my %known_digits = (
+    "libfile-spec-perl"  => 4,
+    "libtime-local-perl" => 4,
+    "libtime-piece-perl" => 4,
+    "libjson-pp-perl"    => 5,
+    "libextutils-parsexs-perl" => 6,
+);
+
+# list special cases of version numbers that are OK here
+# version numbering discontinuities and backported fixes cause these
+my %ok = (
+       "libencode-perl" => {
+               # bug #836138
+               "2.72" => "2.86",
+               "2.80_01" => "2.86",
+               # bug #880085
+               "2.88" => "2.94",
+       },
+       "libtest-simple-perl" => {
+               "0.98" => "0.98",
+       },
+       "libmodule-corelist-perl" => {
+               "3.10" => "3.10",
+       },
+       # bug #808629
+       "libautodie-perl" => {
+                "2.26"   => "2.29",
+       },
+);
+
+# epochs in the archive (including past ones)
+my %known_epochs = (
+	"libversion-perl" => "1",
+	"libscalar-list-utils-perl" => "1",
+	"libnet-perl" => "1",
+);
+
+# list special cases where a Breaks entry doesn't need to imply
+# Replaces+Provides
+my %triplet_check_skip = (
+	"perl-base" => [ "libfile-spec-perl" ],
+	"libperl5.30" => [ "libfilter-perl" ],
+);
+
+# list special cases where the name of the Debian package does not
+# match a module name that has a right $VERSION entry
+my %special_modules = (
+	"libcgi-pm-perl" => 'CGI',
+	"libansicolor-perl" => 'Term::ANSIColor',
+	"libio-compress-perl" => "IO::Compress::Gzip",
+	"libio-compress-zlib-perl" => "IO::Compress::Gzip",
+	"liblocale-codes-perl" => "Locale::Country",
+	"libscalar-list-utils-perl" => "List::Util",
+	"podlators-perl" => "Pod::Man",
+	"libnet-perl" => "Net::Cmd",
+	"libfilter-perl" => "Filter::Util::Call",
+);
+
+# list special cases where we're not providing a dual-lived module from
+# core even though Module::CoreList says we are. Arguably we should
+# patch our Module::CoreList, but that module probably works better as a
+# reference point than something which matches the Debian view of the world.
+my %not_in_debian_core = (
+    "libcgi-fast-perl" => 1,
+);
+
+use Test::More;
+use Module::CoreList;
+use Dpkg::Control::Info;
+use Dpkg::Deps;
+
+use AptPkg::Config '$_config';
+use AptPkg::System '$_system';
+use AptPkg::Cache;
+_init_AptPkg();
+
+# AptPkg offers a proper Debian version comparison mechanism
+my $versioning = $_system->versioning;
+my $apt = AptPkg::Cache->new;
+
+# slurp in the control info
+my $control = Dpkg::Control::Info->new(shift || "debian/control");
+
+my $perl_version = get_perl_version();
+
+# the 5.10 packaging used Conflicts; 5.12 onwards uses Breaks
+my $breaksname = ($perl_version <= 5.010001 ? "Conflicts" : "Breaks");
+
+# initialize the corelist info
+my $corelist = $Module::CoreList::version{$perl_version};
+die(qq(no Module::CoreList information found for $perl_version (try "perl -Idist/Module-CoreList/lib $0")))
+	if !defined $corelist;
+
+# for the known modules in the corelist, create a mapping
+# from a probable Debian package name to the CPAN distribution name
+#
+# this is mostly to get the casing right (Io vs. IO etc.)
+my %debian_from_cpan_guess;
+for my $cpan_name (keys %$corelist) {
+	my $guess = "lib" . (lc $cpan_name) . "-perl";
+	$guess =~ s/::/-/g;
+	$debian_from_cpan_guess{$guess} = $cpan_name;
+}
+
+# we also store the other way around so we don't have to do
+# the above dance every time
+my %cpan_from_debian_guess = reverse %debian_from_cpan_guess;
+
+# cache the list of our own binary packages for later
+my %is_perl_binary;
+
+my %deps_found;
+my $breaks_total = 0;
+my $tests_per_breaks = 6;
+
+for my $perl_package_info ($control->get_packages) {
+	my $perl_package_name = $perl_package_info->{Package};
+	my $dep_found = $deps_found{$perl_package_name} ||= {};
+	$is_perl_binary{$perl_package_name}++;
+	next if !exists $perl_package_info->{$breaksname};
+
+	# cache all the targets for Breaks, Replaces and Provides for later
+	# we store Dpkg::Deps::Simple objects for each target
+	for my $deptype ($breaksname, "Replaces", "Provides") {
+		next if !exists $perl_package_info->{$deptype};
+
+		# Dpkg::Deps cannot parse unsubstituted substvars so remove this
+		$perl_package_info->{$deptype} =~ s/\$\{perlapi:Provides}//;
+
+		my $parsed = deps_parse($perl_package_info->{$deptype});
+		next if !defined $parsed;
+		for my $target ($parsed->get_deps) {
+			$dep_found->{$deptype}{$target->{package}} = $target;
+			$breaks_total++ if $deptype eq $breaksname;
+		}
+	}
+}
+
+plan tests => $tests_per_breaks * $breaks_total + 2;
+
+ok($breaks_total, "successfully parsed debian/control");
+
+for my $perl_package_name (keys %deps_found) {
+	my $dep_found = $deps_found{$perl_package_name};
+	my $providing_package = ($perl_package_name eq 'perl-base' ? 'perl-base' : 'perl');
+	my $providing_dep = $deps_found{$providing_package};
+	# go through all the Breaks targets
+	#  check the version against Module::CoreList
+	#  check for appropriate Replaces and Provides entries 
+	#
+	for my $broken (keys %{$dep_found->{$breaksname}}) {
+		my $module = deb2cpan($broken);
+		my ($epoch, $digits) = (0, 0);
+
+		$epoch = $known_epochs{$broken}
+			if exists $known_epochs{$broken};
+
+		$digits = $known_digits{$broken}
+			if exists $known_digits{$broken};
+
+		SKIP: {
+			my $broken_version = $dep_found->{$breaksname}{$broken}{version};
+
+			skip("$module Breaks entry is unversioned", $tests_per_breaks)
+				if !defined $broken_version;
+
+			$broken_version =~ s/-\d+$//; # remove the Debian revision
+
+			skip("$module is unknown to Module::CoreList", $tests_per_breaks)
+				if !exists $corelist->{$module};
+
+			my $corelist_version =
+				cpan_version_to_deb($corelist->{$module}, $broken, $digits);
+			$corelist_version = $epoch . ":". $corelist_version
+				if $epoch;
+
+			is($broken_version, $corelist_version,
+				"Breaks for $broken in $perl_package_name matches Module::CoreList for $module");
+			# help automating fixes for major version upgrades
+			# usage example:
+			#  prove -v debian/t/control.t 2>&1 | sed -n 's,# s/,s/, p' | sed -f - -i debian/control
+			if ($broken_version ne $corelist_version) {
+				diag("s/$broken (<< $broken_version)/$broken (<< $corelist_version)/");
+			}
+
+			# check if separate packages in the archive have introduced epochs
+			# or extra digits that we don't know of
+			#
+			# if they have, it's still fine if our version of the module with
+			# those digits and epoch is earlier than the one in the archive
+			#
+			# otherwise we have a newer version than the separate package in the
+			# archive and need to update our versions in Breaks etc.
+
+			my ($current_epoch_in_breaks, $current_digits_in_breaks) =
+			   parse_epoch_and_digits_from_version($broken, $broken_version);
+
+			my $current_version_in_archive = get_archive_upstream_version($broken);
+			my ($current_epoch_in_archive, $current_digits_in_archive) =
+			   parse_epoch_and_digits_from_version($broken, $current_version_in_archive);
+
+			if ($current_epoch_in_archive  eq $current_epoch_in_breaks and
+			   ($current_digits_in_archive eq $current_digits_in_breaks or
+			    $current_digits_in_archive == 0)) { # probably just a virtual package
+
+				ok (1, "no digit or epoch changes found in the archive for $broken");
+			} else {
+				my $mangled_corelist_version =
+					cpan_version_to_deb($corelist->{$module}, $broken, $current_digits_in_archive);
+				$mangled_corelist_version = $current_epoch_in_archive. ":". $mangled_corelist_version
+					if $current_epoch_in_archive > 0;
+				ok ($versioning->compare($mangled_corelist_version, $current_version_in_archive) < 0,
+					"new digits or epoch in the archive found for $broken ($broken_version vs $current_version_in_archive) but no updates needed yet")
+			}
+
+			skip("not checking Replaces and Provides for $broken in $perl_package_name", $tests_per_breaks - 2)
+				if $triplet_check_skip{$perl_package_name} &&
+					grep { $_ eq $broken } @{$triplet_check_skip{$perl_package_name}};
+
+			if (exists $deprecated{$broken}) {
+				ok(!exists $providing_dep->{Provides}{$broken},
+					"Breaks for deprecated package $broken in $perl_package_name does not imply Provides");
+				ok(!exists $dep_found->{Replaces}{$broken},
+					"Breaks for deprecated package $broken in $perl_package_name does not imply Replaces");
+				SKIP: {
+					skip("no need to check Replaces or Provides versions for deprecated package $broken in $perl_package_name", 2);
+				}
+			} else {
+				ok(exists $providing_dep->{Provides}{$broken},
+					"Breaks for $broken in $perl_package_name implies Provides");
+				ok(exists $dep_found->{Replaces}{$broken},
+					"Breaks for $broken in $perl_package_name implies Replaces");
+
+				my $replaced_version = $dep_found->{Replaces}{$broken}{version};
+				$replaced_version =~ s/-\d+$//; # remove the Debian revision to mirror $broken_version
+				is($replaced_version, $broken_version,
+					"Replaces version for $broken in $perl_package_name matches Breaks");
+
+				my $provided_version = $providing_dep->{Provides}{$broken}{version};
+				$provided_version = '' if !defined $provided_version;
+				$provided_version =~ s/-\d+$//; # remove the Debian revision to mirror $broken_version
+				is($provided_version, $broken_version,
+				    "Provides version for $broken in $perl_package_name matches Breaks");
+				if ($provided_version ne $corelist_version) {
+					if ($provided_version eq '') {
+						diag("s/$broken,/$broken (= $corelist_version),/");
+					} else {
+						diag("s/$broken (= $provided_version)/$broken (= $corelist_version)/");
+					}
+				}
+			}
+		}
+	}
+}
+
+# finally, also check if there are any (new?) packages in the archive
+# that match Module::CoreList
+my @found_in_archive;
+for my $module (keys %$corelist) {
+	my $package = $cpan_from_debian_guess{$module};
+	next if grep $deps_found{$_}{$breaksname}{$package}, keys %deps_found;
+	next if $is_perl_binary{$package};
+	next if $not_in_debian_core{$package};
+	push @found_in_archive, $package
+		if exists $apt->{$package}
+		&& exists $apt->{$package}{VersionList};
+}
+my $found_in_archive = join(" ", @found_in_archive);
+is($found_in_archive, "", "no potential packages for new Provides/Replaces/Breaks found in the archive");
+
+# convert libfoo-bar-perl to Foo::Bar
+sub deb2cpan {
+	local $_ = shift;
+	return $special_modules{$_} if exists $special_modules{$_};
+	return $debian_from_cpan_guess{$_} if exists $debian_from_cpan_guess{$_};
+	s/^lib(.*)-perl/$1/;
+	s/-/::/g;
+	s/(\w+)/\u$1/g;
+	return $_;
+}
+			
+sub cpan_version_to_deb {
+	my $cpan_version = shift;
+	my $package = shift;
+	my $digits = shift;
+
+	# cpan_version
+	#         digits
+	#                result
+	# 1.15_02,  2 => 1.15.02
+	# 1.15_02,  4 => 1.1502
+	# 1.15_02,  0 => 1.15.02
+	# 
+	# 1.15_021, 2 => 1.15.021
+	# 1.15_021, 4 => 1.1500.021
+	# 1.15_021, 0 => 1.15.021
+	#
+	# 1.15,	 1 => 1.15
+	# 1.15,	 2 => 1.15
+	# 1.15,	 4 => 1.1500
+	# 1.15,	 0 => 1.15
+
+	return $ok{$package}{$cpan_version} if exists $ok{$package}{$cpan_version};
+
+	# 1.15_02 => (1, 15, 02)
+	my ($major, $prefix, $suffix) = ($cpan_version =~ /^(\d+\.)(\d+)(?:_(\d+))?$/);
+	die("no match with $cpan_version?") if !$major;
+
+	$suffix ||= "";
+	if (length($suffix) + length($prefix) == $digits) {
+		$prefix .= $suffix;
+		$suffix = "";
+	}
+	if (length($suffix) + length($prefix) < $digits) {
+		$prefix .= "0" while length($prefix) < $digits;
+	}
+	$suffix = ".$suffix" if $suffix ne "";
+	$major.$prefix.$suffix;
+}
+
+sub get_archive_upstream_version {
+	my $p = shift;
+	return if !exists $apt->{$p};
+	return if !exists $apt->{$p}{VersionList}; # virtual package
+	my $latest = (sort byversion @{$apt->{$p}{VersionList}})[-1];
+	my $v = $latest->{VerStr};
+	$v =~ s/\+dfsg//;
+	$v =~ s/-[^-]+$//;
+	return $v;
+}
+
+sub parse_epoch_and_digits_from_version {
+	my $p = shift;
+	my $v = shift;
+	if (!defined $v) {
+		my $digits = 0;
+		my $epoch = 0;
+		$digits = $known_digits{$p} if exists $known_digits{$p};
+		$epoch  = $known_epochs{$p} if exists $known_epochs{$p};
+		return ($epoch, $digits);
+	}
+	my ($epoch, $major, $prefix, $suffix, $revision) =
+		($v =~ /^(?:(\d+):)?((?:\d+\.))+(\d+)(?:_(\d+))?(-[^-]+)?$/);
+	$epoch = 0 if !defined $epoch;
+	return ($epoch, length $prefix);
+}
+
+sub byversion {
+	return $versioning->compare($a->{VerStr}, $b->{VerStr});
+}
+
+sub _init_AptPkg {
+	# From /usr/share/doc/libapt-pkg-perl/examples/apt-cache
+	#
+	# initialise the global config object with the default values and
+	# setup the $_system object
+	$_config->init;
+	$_system = $_config->system;
+	# supress cache building messages
+	$_config->{quiet} = 2;
+}
+
+sub get_perl_version {
+	# if cwd is a perl source directory, we check the corelist information
+	# for that. Otherwise, fall back to the running perl version
+	my $perl_version = qx'dpkg-parsechangelog | \
+		sed -ne "s/-[^-]\+$//; s/~.*//; s/^Version: *\([0-9]\+:\)*//p"';
+	chomp $perl_version;
+	$perl_version = version->parse($perl_version || $])->numify;
+	note("testing for $perl_version");
+	return $perl_version;
+}
diff --git a/debian/t/copyright.t b/debian/t/copyright.t
new file mode 100644
index 0000000..8a56b16
--- /dev/null
+++ b/debian/t/copyright.t
@@ -0,0 +1,74 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More tests => 9;
+use File::Glob ':bsd_glob';
+
+my $upstream_version;
+ok(open(P, "dpkg-parsechangelog |"), "successfully piping from dpkg-parsechangelog");
+while (<P>) {
+    /^Version: (.+)-[^-]+$/ or next;
+    $upstream_version = $1;
+    last;
+}
+isnt($upstream_version, "", "found upstream version from dpkg-parsechangelog output");
+ok(close P, "dpkg-parsechangelog exited normally");
+
+my $checked_version;
+ok(open(C, "<debian/copyright"), "successfully opened debian/copyright");
+while (<C>) {
+    next if !/^ Last checked against: Perl (.+)/;
+    $checked_version = $1;
+    last;
+}
+isnt($checked_version, "", "found checked version from debian/copyright");
+close C;
+
+is($checked_version, $upstream_version,
+    "debian/copyright last checked for the current upstream version");
+
+subtest 'Checking for stale Files: sections in debian/copyright' => sub {
+  ok(open(C, "<debian/copyright"), "successfully opened debian/copyright");
+  my $in_files = 0;
+  my $files_count = 0;
+  while (<C>) {
+    chomp;
+    s/^Files:/ / and do {
+        $in_files = 1;
+    };
+    if ($in_files) {
+        /^\S/ and do {
+            $in_files = 0;
+            next;
+        };
+        /^\s+(\S+)/ and do {
+            $files_count++;
+            my $glob = $1;
+            my @globbed = bsd_glob($glob, GLOB_ERR);
+            ok(@globbed, "'Files: $glob' in copyright file references existing files");
+        };
+    }
+  }
+  close C;
+  ok($files_count > 0, "found Files: sections in debian/copyright");
+  isnt($checked_version, "", "found checked version from debian/copyright");
+  done_testing($files_count + 3);
+};
+
+SKIP: {
+    system('which cme >/dev/null 2>&1');
+    my $cmd;
+    if ($?) {
+        system('which config-edit >/dev/null 2>&1');
+        skip('no cme or config-edit or available', 2) if $?;
+        $cmd = 'config-edit -application dpkg-copyright -ui none';
+    } else {
+        skip('no cme dpkg-copyright application available (try installing libconfig-model-dpkg-perl)', 2)
+            if qx/cme list/ !~ /dpkg-copyright/;
+        $cmd = 'cme check dpkg-copyright';
+    }
+    note("checking debian/copyright with copyright checker '$cmd'");
+    unlike( qx/$cmd 2>&1/, qr/error/,
+        'no error messages from copyright checker when parsing debian/copyright');
+    is($?, 0, 'copyright checker exited successfully');
+}
+
diff --git a/debian/t/released-versions.t b/debian/t/released-versions.t
new file mode 100755
index 0000000..6251821
--- /dev/null
+++ b/debian/t/released-versions.t
@@ -0,0 +1,36 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More tests => 6;
+
+# Test that the current upstream version is listed in debian/released-versions
+# for uploads targetting unstable.
+#
+# Forgetting this will only cause problems if/when the next minor release is
+# uploaded, at which point it will be missing perlapi-5.xx.x for this version.
+# Running this check from autopkgtest should therefore pinpoint such issues
+# well in advance.
+
+my $upstream_version;
+my $distribution;
+ok(open(P, "dpkg-parsechangelog |"), "successfully piping from dpkg-parsechangelog");
+while (<P>) {
+    chomp;
+    /^Version: (.+)-[^-]+$/ and $upstream_version = $1;
+    /^Distribution: (.+)+$/ and $distribution = $1;
+}
+ok(close P, "dpkg-parsechangelog exited normally");
+ok(defined $upstream_version, "found upstream version from dpkg-parsechangelog output");
+ok(defined $distribution, "found distribution information from dpkg-parsechangelog output");
+
+SKIP: {
+    skip("Only checking debian/released-versions for unstable (not $distribution)", 2)
+        if $distribution ne 'unstable';
+    my $found=0;
+    ok(open(C, "<debian/released-versions"), "successfully opened debian/released-versions");
+    while (<C>) {
+        chomp;
+        $found++,last if $_ eq $upstream_version;
+    }
+    close C;
+    ok($found, "found version $upstream_version in debian/released-versions");
+}