Skip to content

Commit 3955013

Browse files
rjbsrjbs
committed
indexer: reintroduce parameters to package-level errors
That way, your error can say "this was in previous file X" and not just "in a previous file, not named here".
1 parent ba1295e commit 3955013

2 files changed

Lines changed: 113 additions & 42 deletions

File tree

‎lib/PAUSE/Indexer/Errors.pm‎

Lines changed: 88 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,16 @@ use Sub::Exporter -setup => {
1010
sub dist_error;
1111
sub pkg_error;
1212

13+
sub _assert_args_present {
14+
my ($ident, $hash, $names_demanded) = @_;
15+
16+
for my $name (@$names_demanded) {
17+
next if exists $hash->{$name};
18+
19+
Carp::confess("no $name given in PKGERROR($ident)")
20+
}
21+
}
22+
1323
dist_error blib => {
1424
header => 'archive contains a "blib" directory',
1525
body => <<'EOF'
@@ -105,16 +115,23 @@ EOF
105115
};
106116

107117
pkg_error db_conflict => {
108-
# TODO bring back $package
109118
header => "Not indexed because of conflicting record in index",
110-
body => <<"EOF"
111-
Indexing failed because of conflicting records for \$package. Please report
112-
the case to the PAUSE admins at modules\@perl.org.
119+
body => sub {
120+
my ($arg) = @_;
121+
122+
_assert_args_present(db_conflict => $arg, [ qw(package_name) ]);
123+
124+
return <<"EOF"
125+
Indexing failed because of conflicting records for $arg->{package_name}.
126+
Please report the case to the PAUSE admins at modules\@perl.org.
113127
EOF
128+
},
114129
};
115130

116131
pkg_error db_error => {
117-
# TODO bring back db error string? seems weird -- rjbs, 2023-05-01
132+
# Before PKGERROR existed, this would include the database error. This felt
133+
# like a bad idea to rjbs when he refactored, so he removed it. Easy to
134+
# re-add, if we want to, though! -- rjbs, 2023-05-03
118135
header => 'Not indexed because of database error',
119136
body => <<'EOF',
120137
The PAUSE indexer could not store the indexing result in the PAUSE database due
@@ -124,30 +141,48 @@ EOF
124141
};
125142

126143
pkg_error dual_newer => {
127-
# TODO bring back parameters
128144
header => 'Not indexed because of an newer dual-life module',
129-
body => <<'EOF',
130-
Not indexed because package $opack in file $ofile has a dual life in $odist.
131-
The other version is at $oldversion, so not indexing seems okay.
145+
body => sub {
146+
my ($old) = @_;
147+
148+
_assert_args_present(db_conflict => $old, [ qw(package file dist version) ]);
149+
150+
return <<"EOF";
151+
Not indexed because package $old->{pack} in file $old->{file} has a dual life
152+
in $old->{dist}. The other version is at $old->{version}, so not indexing
153+
seems okay.
132154
EOF
155+
},
133156
};
134157

135158
pkg_error dual_older => {
136-
# TODO bring back parameters
137159
header => 'Not indexed because of an older dual-life module',
138-
body => <<'EOF',
139-
Not indexed because package $opack in file $ofile seems to have a dual life in
140-
$odist. Although the other package is at version [$oldversion], the indexer
141-
lets the other dist continue to be the reference version, shadowing the one in
142-
the core. Maybe harmless, maybe needs resolving.
160+
body => sub {
161+
my ($old) = @_;
162+
163+
_assert_args_present(db_conflict => $old, [ qw(package file dist version) ]);
164+
165+
return <<"EOF";
166+
Not indexed because package $old->{pack} in file $old->{file} seems to have a
167+
dual life in $old->{dist}. Although the other package is at version
168+
[$old->{version}], the indexer lets the other dist continue to be the reference
169+
version, shadowing the one in the core. Maybe harmless, maybe needs resolving.
143170
EOF
171+
}
144172
};
145173

146174
pkg_error mtime_fell => {
147-
# TODO bring back ofile/odist in body
148175
header => 'Release seems outdated',
149-
body => q{Not indexed because $ofile in $odist also has a zero version
150-
number and the distro has a more recent modification time.},
176+
body => sub {
177+
my ($old) = @_;
178+
179+
_assert_args_present(db_conflict => $old, [ qw(package file dist version) ]);
180+
181+
return <<"EOF";
182+
Not indexed because $old->{file} in $old->{dist} also has a zero version number
183+
and the distro has a more recent modification time.
184+
EOF
185+
}
151186
};
152187

153188
pkg_error no_permission => {
@@ -160,17 +195,33 @@ EOF
160195
};
161196

162197
pkg_error version_fell => {
163-
# TODO bring back "file in $dist", make the q{...} a qq{...}
164198
header => "Not indexed because of decreasing version number",
165-
body => q{Not indexed because $ofile in $odist has a higher version number
166-
($oldversion)},
199+
body => sub {
200+
my ($old) = @_;
201+
202+
_assert_args_present(db_conflict => $old, [ qw(package file dist version) ]);
203+
204+
return <<"EOF";
205+
Not indexed because $old->{file} in $old->{dist} has a higher version number
206+
($old->{version})
207+
EOF
208+
}
167209
};
168210

169211
pkg_error version_invalid => {
170-
# TODO put back $version itself? It's already in the report.
171-
# -- rjbs, 2023-05-01
172212
header => 'Not indexed because version is not a valid "lax version" string.',
173-
body => undef,
213+
body => sub {
214+
my ($arg) = @_;
215+
216+
_assert_args_present(db_conflict => $arg, [ qw(version) ]);
217+
218+
return <<"EOF";
219+
The version present in the file, "$arg->{version}", is not a valid lax version
220+
string. You can read more in "perldoc version". This restriction would be
221+
enforced at compile time if you put your version string within your package
222+
declaration.
223+
EOF
224+
}
174225
};
175226

176227
pkg_error version_openerr => {
@@ -225,18 +276,27 @@ sub DISTERROR {
225276
}
226277

227278
sub PKGERROR {
228-
my ($ident) = @_;
279+
my ($ident, $arg) = @_;
229280

230-
my $error = $PKG_ERROR{$ident};
231-
unless ($error) {
281+
my $template = { $PKG_ERROR{$ident}->%* };
282+
283+
unless ($template) {
232284
Carp::confess("requested unknown package error: $ident");
233285
}
234286

287+
my $error = { %$template };
288+
289+
if (ref $error->{body}) {
290+
my $body = $error->{body}->($arg);
291+
$error->{body} = $body;
292+
}
293+
235294
return $error;
236295
}
237296

238297
sub dist_error {
239298
my ($name, $arg) = @_;
299+
240300
$DIST_ERROR{$name} = {
241301
ident => $name,
242302
public => 1,
@@ -246,6 +306,7 @@ sub dist_error {
246306

247307
sub pkg_error {
248308
my ($name, $arg) = @_;
309+
249310
$PKG_ERROR{$name} = {
250311
ident => $name,
251312
public => 1,

‎lib/PAUSE/package.pm‎

Lines changed: 25 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -321,15 +321,15 @@ sub update_package {
321321
qw( package version dist filemtime file )
322322
};
323323

324-
$Logger->log([
325-
"updating old package data: %s", {
326-
package => $opack,
327-
version => $oldversion,
328-
dist => $odist,
329-
mtime => $ofilemtime,
330-
file => $ofile,
331-
}
332-
]);
324+
my $old = {
325+
package => $opack,
326+
version => $oldversion,
327+
dist => $odist,
328+
mtime => $ofilemtime,
329+
file => $ofile,
330+
};
331+
332+
$Logger->log([ "updating old package data: %s", $old ]);
333333

334334
my $MLROOT = $self->mlroot;
335335
my $odistmtime = (stat "$MLROOT/$odist")[9];
@@ -402,7 +402,9 @@ sub update_package {
402402
opack => $opack,
403403
});
404404
} elsif (defined $pp->{version} && ! version::is_lax($pp->{version})) {
405-
$ctx->abort_indexing_package($self, PKGERROR('version_invalid'));
405+
$ctx->abort_indexing_package($self, PKGERROR('version_invalid', {
406+
version => $pp->{version}
407+
}));
406408
} elsif (CPAN::Version->vgt($pp->{version},$oldversion)) {
407409
# higher VERSION here
408410
$Logger->log([
@@ -427,7 +429,7 @@ oldversion[$oldversion]
427429
pmfile[$pmfile]
428430
}); # });
429431

430-
$ctx->abort_indexing_package($self, PKGERROR('version_fell'));
432+
$ctx->abort_indexing_package($self, PKGERROR('version_fell', $old));
431433
} elsif ($older_isa_regular_perl) {
432434
$ok++; # new on 2002-08-01
433435
} else {
@@ -456,7 +458,7 @@ pmfile[$pmfile]
456458
]);
457459
$ok++;
458460
} else {
459-
$ctx->abort_indexing_package($self, PKGERROR('mtime_fell'));
461+
$ctx->abort_indexing_package($self, PKGERROR('mtime_fell', $old));
460462
}
461463
} elsif (CPAN::Version->vcmp($pp->{version}, $oldversion)==0) {
462464
# equal version here
@@ -478,7 +480,7 @@ pmfile[$pmfile]
478480
old => { dist => $odist, mtime => $odistmtime },
479481
},
480482
]);
481-
$ctx->abort_indexing_package($self, PKGERROR('mtime_fell'));
483+
$ctx->abort_indexing_package($self, PKGERROR('mtime_fell', $old));
482484
}
483485
} else {
484486
$Logger->log(
@@ -570,6 +572,14 @@ sub __do_regular_perl_update {
570572
qw( package version dist filemtime file )
571573
};
572574

575+
my $old = {
576+
package => $opack,
577+
version => $oldversion,
578+
dist => $odist,
579+
mtime => $ofilemtime,
580+
file => $ofile,
581+
};
582+
573583
my $older_isa_regular_perl = $arg->{older_isa_regular_perl};
574584

575585
my $odistmtime = $arg->{odistmtime};
@@ -592,9 +602,9 @@ sub __do_regular_perl_update {
592602
}
593603
} else {
594604
if (CPAN::Version->vgt($pp->{version},$oldversion)) {
595-
$ctx->abort_indexing_package($self, PKGERROR('dual_older'));
605+
$ctx->abort_indexing_package($self, PKGERROR('dual_older', $old));
596606
} else {
597-
$ctx->abort_indexing_package($self, PKGERROR('dual_newer'));
607+
$ctx->abort_indexing_package($self, PKGERROR('dual_newer', $old));
598608
}
599609
}
600610

0 commit comments

Comments
 (0)