Skip to content

Commit

Permalink
Translate Perl version string to user-friendly version string
Browse files Browse the repository at this point in the history 
Perl version strings are flawed in a few ways.  Convert them to
user-friendly strings when printed so that Git tags and tarball names
are easier for downstream distributions to work with.
  • Loading branch information
@rhansen
rhansen committed May 12, 2024
1 parent 0806363 commit dfb2196
Show file tree
Hide file tree
Showing 2 changed files with 132 additions and 2 deletions.
81 changes: 79 additions & 2 deletions ddclient.in
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,8 +21,85 @@ use File::Temp;
use Getopt::Long;
use Sys::Hostname;

use version 0.77; our $VERSION = version->declare('3.11.3_0');
my $version = $VERSION->stringify();
# Declare the ddclient version number.
#
# Perl's version strings do not support pre-release versions (alpha/development, beta, or release
# candidate) very well. The best it does is an optional underscore between arbitrary digits in the
# final component (e.g., "v1.2.3_4"). The underscore doesn't behave as most developers expect; it
# is treated as if it never existed (e.g., "v1.2.3_4" becomes "v1.2.34") except:
#
# * $v->is_alpha() will return true
# * $v->is_strict() will return false
# * $v->stringify() preserves the underscore (in its original position)
#
# Note that version::normal and version::numify lose information because the underscore is
# effectively removed.
#
# To work around Perl's limitations, human-readable versions are translated to/from Perl versions
# as follows:
#
# Human-readable Perl version Notes
# -------------------------------------------------------------------------------------------
# 1.2.3~alpha v1.2.3.0_0 compares equal to Perl version v1.2.3 (unfortunately)
# 1.2.3~betaN v1.2.3.0_N 1 <= N < 900; compares equal to Perl v1.2.3.N
# 1.2.3~rcN v1.2.3.0_M 1 <= N < 99; M = N + 900; compares equal to Perl v1.2.3.M
# 1.2.3 v1.2.3.999 for releases; no underscore in Perl version string
# 1.2.3rN v1.2.3.999.N 1 <= N < 1000; for re-releases, if necessary (rare)
#
# A tilde is used to separate "alpha", "beta", and "rc" from the version numbers because it has
# special meaning for the version comparison algorithms in RPM and Debian:
# https://docs.fedoraproject.org/en-US/packaging-guidelines/Versioning/#_handling_non_sorting_versions_with_tilde_dot_and_caret
# https://manpages.debian.org/bookworm/dpkg-dev/deb-version.7.en.html
#
# No period separator is required between "beta", "rc", or "r" and its adjacent number(s); both RPM
# and Debian will compare the adjacent number numerically, not lexicographically ("~beta2" sorts
# before "~beta10" as expected).
#
# The Perl version is declared first then converted to a human-readable form. It would be nicer to
# declare a human-readable version string and convert that to a Perl version string, but various
# tools in the Perl ecosystem require the line of source code that defines the VERSION variable to
# be self-contained (because they grep the source code and evaluate only that one line).
#
# For consistency and to match user expectations, the release part of the version is always three
# components: MAJOR.MINOR.PATCH.
use version 0.77; our $VERSION = version->declare('v3.11.3.0_0');

sub parse_version {
my ($v) = @_;
# Matches a non-negative integer with 1-3 decimal digits (zero padding disallowed).
my $n = qr/0|[1-9]\d{0,2}/;
my $vre = qr/
^
v # required "v" prefix
((?:$n\.)*?$n) # release version (e.g., 1.2, 1.2.3, or 1.2.3.4)
\.(?: # release or pre-release suffix
0_(?!999)($n)| # pre-release (alpha, beta, rc) revision
999(?:\.($n))? # release with optional re-release revision
)
$
/x;
return $v =~ $vre;
}

sub humanize_version {
my ($v) = @_;
my ($r, $pr, $rr) = parse_version($v);
return $v if !defined($r);
$v = $r;
if (!defined($pr)) {
$v .= "r$rr" if defined($rr);
} elsif ($pr eq '0') {
$v .= '~alpha';
} elsif ($pr < 900) {
$v .= "~beta$pr";
} elsif ($pr < 999) {
$v .= '~rc' . ($pr - 900);
}
return $v;
}

our $version = humanize_version($VERSION);

my $programd = $0;
$programd =~ s%^.*/%%;
my $program = $programd;
Expand Down
53 changes: 53 additions & 0 deletions t/version.pl.in
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,59 @@ use version;
SKIP: { eval { require Test::Warnings; } or skip($@, 1); }
eval { require 'ddclient'; } or BAIL_OUT($@);

ok(ddclient::parse_version($ddclient::VERSION),
"module's Perl version string is in opinionated form");

my $n = qr/0|[1-9]\d{0,2}/;
like($ddclient::version, qr/^$n\.$n\.$n(?:~alpha|~beta$n|~rc$n|r$n)?$/,
"human-readable version is in opinionated form");

my @tcs = (
['v1.0_0', '1~alpha'],
['v1.0.0_0', '1.0~alpha'],
['v1.2.3.0_0', '1.2.3~alpha'],
['v1.2.3.4.0_0', '1.2.3.4~alpha'],
['v1.0_1', '1~beta1'],
['v1.0.0_1', '1.0~beta1'],
['v1.2.3.0_1', '1.2.3~beta1'],
['v1.2.3.4.0_1', '1.2.3.4~beta1'],
['v1.2.3.0_899', '1.2.3~beta899'],
['v1.0_901', '1~rc1'],
['v1.0.0_901', '1.0~rc1'],
['v1.2.3.0_901', '1.2.3~rc1'],
['v1.2.3.4.0_901', '1.2.3.4~rc1'],
['v1.2.3.0_998', '1.2.3~rc98'],
['v1.999', '1'],
['v1.0.999', '1.0'],
['v1.2.3.999', '1.2.3'],
['v1.2.3.4.999', '1.2.3.4'],
['v1.999.1', '1r1'],
['v1.0.999.1', '1.0r1'],
['v1.2.3.999.1', '1.2.3r1'],
['v1.2.3.4.999.1', '1.2.3.4r1'],
['v1.2.3.999.999', '1.2.3r999'],
[$ddclient::VERSION, $ddclient::version],
);

subtest 'humanize_version' => sub {
for my $tc (@tcs) {
my ($pv, $want) = @$tc;
is(ddclient::humanize_version($pv), $want, "$pv -> $want");
}
};

subtest 'human-readable version can be translated back to Perl version' => sub {
for my $tc (@tcs) {
my ($want, $hv) = @$tc;
my $pv = "v$hv";
$pv =~ s/^(?!.*~)(.*?)(?:r(\d+))?$/"$1.999" . (defined($2) ? ".$2" : "")/e;
$pv =~ s/~alpha$/.0_0/;
$pv =~ s/~beta(\d+)$/.0_$1/;
$pv =~ s/~rc(\d+)$/'.0_' . (900 + $1)/e;
is($pv, $want, "$hv -> $want");
}
};

is($ddclient::version, '@PACKAGE_VERSION@', "version matches version in Autoconf");

done_testing();

0 comments on commit dfb2196

Please sign in to comment.