[SCM] Debian package checker branch, master, updated. 2.5.12-110-gd7780cb

["Niels Thykier" <niels@thykier.net>]

The following commit has been merged in the master branch:
commit 3b03c9de0a242a088e7c66c3197f8593ae4f9cdd
Author: Niko Tyni <ntyni@debian.org>
Date:   Sun May 12 22:01:36 2013 +0300

    Improve the version information of packages bundled with the Perl core
    
    There are various incompatibilities with the CPAN and Debian versioning
    schemes. Try to be smarter about deriving Debian version numbers from
    Module::CoreList data, taking epochs and varying number of decimal digits
    into account.
    
    Most of this code is reused from the Debian maintainer tests of the
    Perl package (debian/t/control.t in the 'perl' source package, 5.14.2-21
    or so at the time of this writing.)
    
    Signed-off-by: Niels Thykier <niels@thykier.net>

diff --git a/private/refresh-perl-provides b/private/refresh-perl-provides
index a31d53b..7d05588 100755
--- a/private/refresh-perl-provides
+++ b/private/refresh-perl-provides
@@ -85,17 +85,25 @@ for my $pkg (@core_packages) {
         my $name = $provides->{Name};
         # skip virtual-only packages
         next if (!$cache->{$name}{VersionList});
-        my $version = find_core_version($name);
-        next if !$version;
+        my $cpan_version = find_core_version($name);
 
-        # the underscore notates a CPAN development version;
-        # these may need special casing with some packages
-        $version =~ s/_/./g;
-        print "$name $version\n";
+        next if !$cpan_version;
+
+        # the number of digits is a pain
+        #  we use the current version in the Debian archive to determine
+        #  how many we need
+        # the epoch is easier, we just copy it
+
+        my ($epoch, $digits) = epoch_and_digits($name);
+        my $debian_version = cpan_version_to_deb($cpan_version, $epoch, $digits);
+
+        next if !$debian_version;
+
+        print "$name $debian_version\n";
     }
 }
 
-# look up the version of a package in the core
+# look up the CPAN version of a package in the core
 sub find_core_version {
     my $module = shift;
     my $ret;
@@ -118,6 +126,58 @@ sub find_core_version {
     return $ret;
 }
 
+sub cpan_version_to_deb {
+        my $cpan_version = shift;
+        my $epoch = 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
+
+        # split 1.15_02 to (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 '';
+        $epoch.$major.$prefix.$suffix;
+}
+
+# Given a Debian binary package name, look up its latest version
+# and return its epoch (including the colon) if available, and
+# the number of digits in its decimal part
+sub epoch_and_digits {
+    my $p = shift;
+    return (0, 0) if !exists $cache->{$p};
+    return (0, 0) if !exists $cache->{$p}{VersionList}; # virtual package
+    my $latest = bin_latest($cache->{$p});
+    my $v = $latest->{VerStr};
+    $v =~ s/\+dfsg//;
+    my ($epoch, $major, $prefix, $suffix, $revision) =
+        ($v =~ /^(?:(\d+:))?((?:\d+\.))+(\d+)(?:_(\d+))?(-[^-]+)$/);
+    return ($epoch, length $prefix);
+}
+
 sub bin_latest {
     my $p = shift;
     return (sort bin_byversion @{$p->{VersionList}})[-1];

-- 
Debian package checker