From 98c50971a02aa0cb14649d20b824fb3b5b71ef7c Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Fri, 28 Apr 2023 18:06:40 +0200
Subject: [PATCH] on a very small (or large) version, do not index

Really, this should become a useful user message, but it's painfully
difficult to get that error up through the call stack.  This code needs
(in my opinion) to be rearchitected to make this sort of thing simple.

In the meantime, the code now detects this case specifically, so we can
do something about it later.
---
 lib/PAUSE/pmfile.pm  | 23 +++++++++++++++++++++--
 t/mldistwatch-misc.t | 23 +++++++++++++++++++++++
 2 files changed, 44 insertions(+), 2 deletions(-)

diff --git a/lib/PAUSE/pmfile.pm b/lib/PAUSE/pmfile.pm
index 8b9041b20..fcbbb5e18 100644
--- a/lib/PAUSE/pmfile.pm
+++ b/lib/PAUSE/pmfile.pm
@@ -569,9 +569,28 @@ sub parse_version {
 sub normalize_version {
     my($self,$v) = @_;
     $v = "undef" unless defined $v;
+
+    # What on earth is this hunk about?  Well, if the user has written
+    #
+    #   $VERSION = 0.000001
+    #
+    # ...instead of...
+    #
+    #   $VERSION = '0.000001'
+    #
+    # ...then when we eval the version value, we get a number.  That's bad,
+    # because we'll lose fidelity.  Sometimes this only means that 1.100
+    # becomes 1.1, but the worse case is when a version like 0.000001 becomes
+    # 1e-6, which then can't be turned into a version object with version->new.
+    #
+    # If the stringified version appears to be scientific notation, format it
+    # back into expanded form and make a version of that.
     my $dv = Dumpvalue->new;
-    my $sdv = $dv->stringify($v,1); # second argument prevents ticks
-    $Logger->log("result of normalize_version: $sdv");
+    my $sdv = $dv->stringify($v, 1); # second argument prevents ticks
+    if ($sdv =~ /\A[0-9](?:\.[0-9]+)?e([-+])?[0-9]+\z/a) {
+        my $adj = $1 eq '-' ? 'small' : 'large';
+        die "very large or small numeric version; you must use a string in your source\n";
+    }
 
     return $v if $v eq "undef";
     return $v if $v =~ /^\{.*\}$/; # JSON object
diff --git a/t/mldistwatch-misc.t b/t/mldistwatch-misc.t
index f75a4d290..25de3e527 100644
--- a/t/mldistwatch-misc.t
+++ b/t/mldistwatch-misc.t
@@ -581,6 +581,29 @@ subtest "do not index dists without META file" => sub {
   );
 };
 
+subtest "very small version number (as numeric literal)" => sub {
+  my $pause = PAUSE::TestPAUSE->init_new;
+  $pause->upload_author_fake(PERSON => 'Tiny-Version-1.002.tar.gz', {
+    packages => [
+      'Tiny::Version' => {
+        version => '0.000001',
+        layout  => { version => 'our-literal' },
+      },
+    ],
+  });
+
+  my $result = $pause->test_reindex;
+
+  $pause->file_not_updated_ok(
+    $result->tmpdir
+            ->file(qw(cpan modules 02packages.details.txt.gz)),
+    "there were no things to update",
+  );
+
+  local $TODO = "sending a useful warning here is more or less impossible";
+  fail("assert a report was sent with an explanation");
+};
+
 done_testing;
 
 # Local Variables: