Skip to content

Commit f2c3ee5

Browse files
committed
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.
1 parent d72c8df commit f2c3ee5

File tree

2 files changed

+44
-2
lines changed

2 files changed

+44
-2
lines changed

lib/PAUSE/pmfile.pm

Lines changed: 21 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -514,9 +514,28 @@ sub parse_version {
514514
sub normalize_version {
515515
my($self,$v) = @_;
516516
$v = "undef" unless defined $v;
517+
518+
# What on earth is this hunk about? Well, if the user has written
519+
#
520+
# $VERSION = 0.000001
521+
#
522+
# ...instead of...
523+
#
524+
# $VERSION = '0.000001'
525+
#
526+
# ...then when we eval the version value, we get a number. That's bad,
527+
# because we'll lose fidelity. Sometimes this only means that 1.100
528+
# becomes 1.1, but the worse case is when a version like 0.000001 becomes
529+
# 1e-6, which then can't be turned into a version object with version->new.
530+
#
531+
# If the stringified version appears to be scientific notation, format it
532+
# back into expanded form and make a version of that.
517533
my $dv = Dumpvalue->new;
518-
my $sdv = $dv->stringify($v,1); # second argument prevents ticks
519-
$Logger->log("result of normalize_version: $sdv");
534+
my $sdv = $dv->stringify($v, 1); # second argument prevents ticks
535+
if ($sdv =~ /\A[0-9](?:\.[0-9]+)?e([-+])?[0-9]+\z/a) {
536+
my $adj = $1 eq '-' ? 'small' : 'large';
537+
die "very large or small numeric version; you must use a string in your source\n";
538+
}
520539
521540
return $v if $v eq "undef";
522541
return $v if $v =~ /^\{.*\}$/; # JSON object

t/mldistwatch-misc.t

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -494,6 +494,29 @@ EOT
494494
});
495495
};
496496

497+
subtest "very small version number (as numeric literal)" => sub {
498+
my $pause = PAUSE::TestPAUSE->init_new;
499+
$pause->upload_author_fake(PERSON => 'Tiny-Version-1.002.tar.gz', {
500+
packages => [
501+
'Tiny::Version' => {
502+
version => '0.000001',
503+
style => 'legacy_literal',
504+
},
505+
],
506+
});
507+
508+
my $result = $pause->test_reindex;
509+
510+
$pause->file_not_updated_ok(
511+
$result->tmpdir
512+
->file(qw(cpan modules 02packages.details.txt.gz)),
513+
"there were no things to update",
514+
);
515+
516+
local $TODO = "sending a useful warning here is more or less impossible";
517+
fail("assert a report was sent with an explanation");
518+
};
519+
497520
done_testing;
498521

499522
# Local Variables:

0 commit comments

Comments
 (0)