parts/inc/inctools: Rewrite parse_version

This now accepts more input formats than before, and dies when wrong
with the same messages that ppport.h uses, so that the latter can now
convert to use this function.

And, importantly, it fixes a bug where the lowest component of version
numbers in early perls was multiplied by 10.

(cherry picked from commit 38f1e0a218ae97b719e1cd048bde157d08dd3f37)
Signed-off-by: Nicolas R <atoomic@cpan.org>

diff --git a/dist/Devel-PPPort/parts/inc/inctools b/dist/Devel-PPPort/parts/inc/inctools
index dd178fd..653886b 100644 (file)
--- a/dist/Devel-PPPort/parts/inc/inctools
+++ b/dist/Devel-PPPort/parts/inc/inctools
@@ -20,31 +20,39 @@ sub format_version
 
 sub parse_version
 {
-  my $ver = shift;
+  # Returns a triplet, (5, major, minor) from the input, which can be in any
+  # of several typical formats
 
-  if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
-    return ($1, $2, $3);
-  }
-  elsif ($ver !~ /^\d+\.\d{3}(?:_\d{2})?$/) {
-    die "cannot parse version '$ver'\n";
+  my $ver = shift;
+  $ver = "" unless defined $ver;
+
+  my($r,$v,$s);
+
+  if (   ($r, $v, $s) = $ver =~ /^(5)(\d{3})(\d{3})$/ # 5029010, from the file
+                                                      # names in our
+                                                      # parts/base/ and
+                                                      # parts/todo directories
+      or ($r, $v, $s) = $ver =~ /^(\d+)\.(\d+)\.(\d+)$/   # 5.25.7
+      or ($r, $v, $s) = $ver =~ /^(\d+)\.(\d{3})(\d{3})$/ # 5.025008, from the
+                                                          # output of $]
+      or ($r, $v, $s) = $ver =~ /^(\d+)\.(\d{1,3})()$/    # 5.24, 5.004
+      or ($r, $v, $s) = $ver =~ /^(\d+)\.(00[1-5])_?(\d{2})$/  # 5.003_07
+  ) {
+
+    $s = 0 unless $s;
+
+    die "Only Perl 5 is supported '$ver'\n" if $r != 5;
+    die "Invalid version number: $ver\n" if $v >= 1000 || $s >= 1000;
+    return (5, 0 + $v, 0 + $s);
   }
 
-  $ver =~ s/_//g;
-  $ver =~ s/$/000000/;
-
-  my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
+  my $mesg = "";
+  $mesg = ".  (In 5.00x_yz, x must be 1-5.)" if $ver =~ /_/;
+  die "Invalid version number format: '$ver'$mesg\n";
+}
 
-  $v = int $v;
-  $s = int $s;
 
-  if ($r < 5 || ($r == 5 && $v < 6)) {
-    if ($s % 10) {
-      die "cannot parse version '$ver'\n";
-    }
-    $s /= 10;
-  }
 
-  return ($r, $v, $s);
 }
 
 sub dictionary_order($$)    # Sort caselessly, ignoring punct

diff --git a/dist/Devel-PPPort/parts/inc/ppphbin b/dist/Devel-PPPort/parts/inc/ppphbin
index bbf7b6f..3fe7a44 100644 (file)
--- a/dist/Devel-PPPort/parts/inc/ppphbin
+++ b/dist/Devel-PPPort/parts/inc/ppphbin
@@ -65,11 +65,7 @@ strip() if $opt{strip};
 
 if (exists $opt{'compat-version'}) {
   my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
-  if ($@) {
-    die "Invalid version number format: '$opt{'compat-version'}'\n";
-  }
-  die "Only Perl 5 is supported\n" if $r != 5;
-  die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
+  die $@ if $@;
   $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
 }
 else {