From eecdf00b82038a7f2076074808919309066fd976 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 29 Apr 2023 11:20:58 +0200
Subject: [PATCH 01/49] package indexing: try to avoid partial updates
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Before, the call sequence was something like:

    give_regdowner_perms ❗️
    case check
    version error check
    final sanity check
    checkin ❗️

...where the ❗️-marked lines could write to the database.  This had the
effect that if the code between them returned early, the package would
have caused partial updates to the database, adding new package
permissions without indexing the package.

While we probably want to combine these in a transaction or savepoint,
this commit does the simple thing: moves the first
(give_regdowner_perms) into the other (checkin), so they run together,
with no opportunity to exit early.  This should make it safer to abort
during package indexing.
---
 lib/PAUSE/package.pm | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index 7f6a73cae..a72c51c9e 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -277,9 +277,6 @@ sub examine_pkg {
       return;
   }
 
-  # Copy permissions from main module to subsidiary modules.
-  $self->give_regdowner_perms;
-
   # Check that package name matches case of file name
   {
     my (undef, $module) = split m{/lib/}, $self->{PMFILE}, 2;
@@ -849,6 +846,9 @@ sub checkin {
   my $pp = $self->{PP};
   my $pmfile = $self->{PMFILE};
 
+  # Copy permissions from main module to subsidiary modules.
+  $self->give_regdowner_perms;
+
   $self->dist->{CHECKINS}{ lc $package }{$package} = $self->{PMFILE};
 
   my $row = $dbh->selectrow_hashref(

From 6ec9423fbdbe010fc3fdba04b9d23c9fcad39ad0 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 29 Apr 2023 12:02:00 +0200
Subject: [PATCH 02/49] PAUSE::Indexer::Context: a (currently zero-value)
 object for context

The plan will be to use this to gather indexing state, to trigger
abords, and to decide how to report the result to the user.
---
 lib/PAUSE/Indexer/Context.pm |   8 +++
 lib/PAUSE/dist.pm            |  55 +++++++--------
 lib/PAUSE/mldistwatch.pm     |  29 ++++----
 lib/PAUSE/package.pm         | 131 +++++++++++++++++++----------------
 lib/PAUSE/pmfile.pm          |  16 ++---
 5 files changed, 132 insertions(+), 107 deletions(-)
 create mode 100644 lib/PAUSE/Indexer/Context.pm

diff --git a/lib/PAUSE/Indexer/Context.pm b/lib/PAUSE/Indexer/Context.pm
new file mode 100644
index 000000000..3d228fc45
--- /dev/null
+++ b/lib/PAUSE/Indexer/Context.pm
@@ -0,0 +1,8 @@
+package PAUSE::Indexer::Context;
+use v5.12.0;
+use Moo;
+
+
+
+no Moo;
+1;
diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 409932445..d04a5e8fc 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -168,7 +168,7 @@ sub alert {
 }
 
 sub all_alerts {
-  my ($self) = @_;
+  my ($self, $ctx) = @_;
   return @{ $self->{ALERT} // [] };
 }
 
@@ -285,7 +285,7 @@ sub isa_dev_version {
 }
 
 sub examine_dist {
-  my($self) = @_;
+  my ($self, $ctx) = @_;
   my $dist = $self->{DIST};
   my $MLROOT = $self->mlroot;
   my($suffix,$skip);
@@ -358,7 +358,7 @@ sub mlroot {
 }
 
 sub mail_summary {
-  my($self) = @_;
+  my ($self, $ctx) = @_;
   my $distro = $self->{DIST};
   my $author = $self->{USERID};
   my @m;
@@ -367,7 +367,7 @@ sub mail_summary {
     "The following report has been written by the PAUSE namespace indexer.\n",
     "Please contact modules\@perl.org if there are any open questions.\n";
 
-  if ($self->has_indexing_warnings) {
+  if ($self->has_indexing_warnings($ctx)) {
     push @m,
       "\nWARNING:  Some irregularities were found while indexing your\n",
         "          distribution.  See below for more details.\n";
@@ -387,7 +387,7 @@ sub mail_summary {
   my $asciiname = $u->{asciiname} // $u->{fullname} // "name unknown";
   my $substrdistro = substr $distro, 5;
   my($distrobasename) = $substrdistro =~ m|.*/(.*)|;
-  my $versions_from_meta = $self->version_from_meta_ok ? "yes" : "no";
+  my $versions_from_meta = $self->version_from_meta_ok($ctx) ? "yes" : "no";
   my $parse_cpan_meta_version = Parse::CPAN::Meta->VERSION;
 
   # This can occur when, for example, the "distribution" is Foo.pm.gz — of
@@ -561,7 +561,7 @@ sub mail_summary {
         $inxst->{$p}{infile} ||= "missing in META.yml, tolerated by PAUSE indexer";
         push @m, sprintf("     module : %s\n",  $p);
 
-        if (my @warnings = $self->indexing_warnings_for_package($p)) {
+        if (my @warnings = $self->indexing_warnings_for_package($ctx, $p)) {
           push @m, map {;
                  sprintf("     WARNING: %s\n", $_) } @warnings;
         }
@@ -590,7 +590,7 @@ sub mail_summary {
         } elsif ($self->{REASON_TO_SKIP}) {
           # The reason we skipped this dist is already at the top of the
           # report.  Don't tack on a guess.
-        } elsif ($self->version_from_meta_ok) {
+        } elsif ($self->version_from_meta_ok($ctx)) {
 
           push @m,  qq{Nothing in this distro has been \n}
                  .  qq{indexed, because according to META.yml this\n}
@@ -649,7 +649,8 @@ sub mail_summary {
 }
 
 sub index_status {
-  my($self,$pack,$version,$infile,$status,$verb_status) = @_;
+  my ($self, $ctx, $pack, $version, $infile, $status, $verb_status) = @_;
+
   $self->{INDEX_STATUS}{$pack} = {
     version => $version,
     infile => $infile,
@@ -659,19 +660,19 @@ sub index_status {
 }
 
 sub add_indexing_warning {
-  my($self,$pack,$warning) = @_;
+  my ($self, $ctx, $pack, $warning) = @_;
 
   push @{ $self->{INDEX_WARNINGS}{$pack} }, $warning;
   return;
 }
 
 sub indexing_warnings_for_package {
-  my($self,$pack) = @_;
+  my ($self, $ctx, $pack) = @_;
   return @{ $self->{INDEX_WARNINGS}{$pack} // [] };
 }
 
 sub has_indexing_warnings {
-  my ($self) = @_;
+  my ($self, $ctx) = @_;
   my $i;
   my $warnings = $self->{INDEX_WARNINGS};
 
@@ -688,7 +689,7 @@ sub malformed_provides_names {
 }
 
 sub check_blib {
-  my($self) = @_;
+  my ($self, $ctx) = @_;
   if (grep m|^[^/]+/blib/|, @{$self->{MANIFOUND}}) {
     $self->{HAS_BLIB}++;
     return;
@@ -722,7 +723,7 @@ sub check_blib {
 }
 
 sub check_multiple_root {
-  my($self) = @_;
+  my ($self, $ctx) = @_;
   my %seen;
   my @top = grep { s|/.*||; !$seen{$_}++ } map { $_ } @{$self->{MANIFOUND}};
   if (@top > 1) {
@@ -734,7 +735,7 @@ sub check_multiple_root {
 }
 
 sub check_world_writable {
-  my($self) = @_;
+  my ($self, $ctx) = @_;
   my @files = @{$self->{MANIFOUND}};
   my @dirs = List::MoreUtils::uniq map {File::Basename::dirname($_) . "/"} @files;
   my $Ldirs = @dirs;
@@ -785,7 +786,7 @@ sub check_world_writable {
 }
 
 sub filter_pms {
-  my($self) = @_;
+  my ($self, $ctx) = @_;
   my @pmfile;
 
   # very similar code is in PAUSE::package::filter_ppps
@@ -858,7 +859,7 @@ sub _package_governing_permission {
 }
 
 sub _index_by_files {
-  my ($self, $pmfiles, $provides) = @_;
+  my ($self, $ctx, $pmfiles, $provides) = @_;
   my $dist = $self->{DIST};
 
   my $main_package = $self->_package_governing_permission;
@@ -878,12 +879,12 @@ sub _index_by_files {
       META_CONTENT => $self->{META_CONTENT},
       MAIN_PACKAGE => $main_package,
     );
-    $fio->examine_fio;
+    $fio->examine_fio($ctx);
   }
 }
 
 sub _index_by_meta {
-  my ($self, $pmfiles, $provides) = @_;
+  my ($self, $ctx, $pmfiles, $provides) = @_;
   my $dist = $self->{DIST};
 
   my $main_package = $self->_package_governing_permission;
@@ -929,12 +930,12 @@ sub _index_by_meta {
       META_CONTENT => $self->{META_CONTENT},
       MAIN_PACKAGE => $main_package,
     );
-    $pio->examine_pkg;
+    $pio->examine_pkg($ctx);
   }
 }
 
 sub examine_pms {
-  my $self = shift;
+  my ($self, $ctx) = @_;
   return if $self->{HAS_BLIB};
   return if $self->{HAS_MULTIPLE_ROOT};
   return if $self->{HAS_WORLD_WRITABLE};
@@ -945,10 +946,10 @@ sub examine_pms {
 
   my $dist = $self->{DIST};
 
-  my $pmfiles = $self->filter_pms;
+  my $pmfiles = $self->filter_pms($ctx);
   my ($meta, $provides, $indexing_method);
 
-  if (my $version_from_meta_ok = $self->version_from_meta_ok) {
+  if (my $version_from_meta_ok = $self->version_from_meta_ok($ctx)) {
     $meta = $self->{META_CONTENT};
     $provides = $meta->{provides};
     if ($provides && "HASH" eq ref $provides) {
@@ -961,7 +962,7 @@ sub examine_pms {
   }
 
   if ($indexing_method) {
-    $self->$indexing_method($pmfiles, $provides);
+    $self->$indexing_method($ctx, $pmfiles, $provides);
   } else {
     $self->alert("Couldn't determine an indexing method!");
   }
@@ -982,7 +983,7 @@ sub chown_unsafe {
 }
 
 sub read_dist {
-  my $self = shift;
+  my ($self, $ctx) = @_;
 
   my @manifind;
   my $ok = eval { @manifind = sort keys %{ExtUtils::Manifest::manifind()}; 1 };
@@ -1008,7 +1009,7 @@ sub read_dist {
 }
 
 sub extract_readme_and_meta {
-  my $self = shift;
+  my ($self, $ctx) = @_;
   my($suffix) = $self->{SUFFIX};
   return unless $suffix;
   my $dist = $self->{DIST};
@@ -1130,7 +1131,7 @@ sub write_updated_meta6_json {
 }
 
 sub version_from_meta_ok {
-  my($self) = @_;
+  my ($self, $ctx) = @_;
   return $self->{VERSION_FROM_META_OK} if exists $self->{VERSION_FROM_META_OK};
   my $c = $self->{META_CONTENT};
 
@@ -1194,7 +1195,7 @@ sub lock {
 }
 
 sub set_indexed {
-  my($self) = @_;
+  my ($self, $ctx) = @_;
   my $dist = $self->{DIST};
   my $dbh = $self->connect;
   my $rows_affected = $dbh->do(
diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index 67b6b4562..395cb05ee 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -39,6 +39,7 @@ use PAUSE::dist ();
 use PAUSE::pmfile ();
 use PAUSE::package ();
 use PAUSE::mldistwatch::Constants ();
+use PAUSE::Indexer::Context;
 use PAUSE::MailAddress ();
 use PAUSE::PermsManager ();
 use Process::Status ();
@@ -338,7 +339,7 @@ sub _newcountokay {
 }
 
 sub _do_the_database_work {
-  my ($self, $dio) = @_;
+  my ($self, $ctx, $dio) = @_;
 
   my $ok = eval {
     # This is here for test purposes.  It lets us force the db work to die,
@@ -372,7 +373,7 @@ sub _do_the_database_work {
     }
 
     # ...or else Perl 5...
-    $dio->examine_pms;      # will switch user
+    $dio->examine_pms($ctx);      # will switch user
 
     my $main_pkg = $dio->_package_governing_permission;
 
@@ -438,6 +439,8 @@ sub maybe_index_dist {
                                DIST   => $dist,
                               );
 
+    my $ctx = PAUSE::Indexer::Context->new;
+
     local $Logger = $Logger->proxy({ proxy_prefix => "$dist: " });
 
     if (my $skip_reason = $self->reason_to_skip_dist($dio)) {
@@ -473,13 +476,13 @@ sub maybe_index_dist {
     }
 
     for my $method (qw( examine_dist read_dist extract_readme_and_meta )) {
-      $dio->$method;
+      $dio->$method($ctx);
       if ($dio->skip) {
           delete $self->{ALLlasttime}{$dist};
           delete $self->{ALLfound}{$dist};
 
           if ($dio->{REASON_TO_SKIP}) {
-              $dio->mail_summary;
+              $dio->mail_summary($ctx);
           }
           return;
       }
@@ -493,7 +496,7 @@ sub maybe_index_dist {
     if (($dio->{META_CONTENT}{release_status} // 'stable') ne 'stable') {
         # META.json / META.yml declares it's not stable; do not index!
         $dio->{REASON_TO_SKIP} = PAUSE::mldistwatch::Constants::EMETAUNSTABLE;
-        $dio->mail_summary;
+        $dio->mail_summary($ctx);
         return;
     }
 
@@ -502,16 +505,16 @@ sub maybe_index_dist {
         # control.  When it's wrong, just abort the whole dist.
         $Logger->log([ "META provides has malformed package names: %s", \@bad_names ]);
         $dio->{REASON_TO_SKIP} = PAUSE::mldistwatch::Constants::EBADPROVIDES;
-        $dio->mail_summary;
+        $dio->mail_summary($ctx);
         return;
     }
 
-    $dio->check_blib;
-    $dio->check_multiple_root;
-    $dio->check_world_writable;
+    $dio->check_blib($ctx);
+    $dio->check_multiple_root($ctx);
+    $dio->check_world_writable($ctx);
 
     for my $attempt (1 .. 3) {
-      my $db_ok = $self->_do_the_database_work($dio);
+      my $db_ok = $self->_do_the_database_work($ctx, $dio);
       last if $db_ok;
       $self->disconnect;
       if ($attempt == 3) {
@@ -521,11 +524,11 @@ sub maybe_index_dist {
       }
     }
 
-    $dio->mail_summary unless $dio->perl_major_version == 6;
+    $dio->mail_summary($ctx) unless $dio->perl_major_version == 6;
     $self->sleep;
-    $dio->set_indexed;
+    $dio->set_indexed($ctx);
 
-    my @alerts = $dio->all_alerts;
+    my @alerts = $dio->all_alerts($ctx);
     return unless @alerts;
     return @alerts;
 }
diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index a72c51c9e..dbc517b84 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -88,7 +88,7 @@ sub give_regdowner_perms {
   # ensure that new packages are given, at a minimum, the same permission as
   # those given to the main package of the distribution being uploaded.
   # -- rjbs, 2018-04-19
-  my $self = shift;
+  my ($self, $ctx) = @_;
   my $package = $self->{PACKAGE};
   my $main_package = $self->{MAIN_PACKAGE};
 
@@ -117,7 +117,7 @@ sub give_regdowner_perms {
 
 # package PAUSE::package;
 sub perm_check {
-  my $self = shift;
+  my ($self, $ctx) = @_;
   my $dist = $self->{DIST};
   my $package = $self->{PACKAGE};
   my $main_package = $self->{MAIN_PACKAGE};
@@ -172,7 +172,8 @@ Current registered primary maintainer is $owner.
 Hint: you can always find the legitimate maintainer(s) on PAUSE under
 "View Permissions".};
 
-          $self->index_status($package,
+          $self->index_status($ctx,
+                              $package,
                               $pp->{version},
                               $pp->{infile},
                               PAUSE::mldistwatch::Constants::EMISSPERM,
@@ -235,7 +236,7 @@ sub mlroot {
 
 sub _pkg_name_insane {
     # XXX should be tested
-    my $self = shift;
+    my ($self, $ctx) = @_;
 
     return PAUSE::package->name_is_insane($self->{PACKAGE});
 }
@@ -254,7 +255,7 @@ sub name_is_insane {
 
 # package PAUSE::package;
 sub examine_pkg {
-  my $self = shift;
+  my ($self, $ctx) = @_;
 
   my $dbh = $self->connect;
   my $package = $self->{PACKAGE};
@@ -264,7 +265,7 @@ sub examine_pkg {
 
   # should they be cought earlier? Maybe.
   # but as an ultimate sanity check suggested by Richard Soderberg
-  if ($self->_pkg_name_insane) {
+  if ($self->_pkg_name_insane($ctx)) {
       $Logger->log("package[$package] name seems illegal");
       delete $self->{FIO};    # circular reference
       return;
@@ -272,8 +273,8 @@ sub examine_pkg {
 
   # Query all users with perms for this package
 
-  unless ($self->perm_check){ # (P2.0&P3.0)
-      delete $self->{FIO};    # circular reference
+  unless ($self->perm_check($ctx)) { # (P2.0&P3.0)
+      delete $self->{FIO};           # circular reference
       return;
   }
 
@@ -286,6 +287,7 @@ sub examine_pkg {
       if (lc $module eq lc $package && $module ne $package) {
         # warn "/// $self->{PMFILE} vs. $module vs. $package\n";
         $self->add_indexing_warning(
+          $ctx,
           "Capitalization of package ($package) does not match filename!",
         );
       }
@@ -297,7 +299,8 @@ sub examine_pkg {
   if ($pp->{version} && $pp->{version} =~ /^\{.*\}$/) { # JSON parser error
       my $err = JSON::jsonToObj($pp->{version});
       if ($err->{openerr}) {
-          $self->index_status($package,
+          $self->index_status($ctx,
+                              $package,
                               "undef",
                               $pp->{infile},
                               PAUSE::mldistwatch::Constants::EOPENFILE,
@@ -306,7 +309,8 @@ sub examine_pkg {
         read the file. It issued the following error: C< $err->{openerr} >},
                               );
       } else {
-          $self->index_status($package,
+          $self->index_status($ctx,
+                              $package,
                               "undef",
                               $pp->{infile},
                               PAUSE::mldistwatch::Constants::EPARSEVERSION,
@@ -340,16 +344,17 @@ sub examine_pkg {
       }
   }
 
-  $self->checkin;
+  $self->checkin($ctx);
   delete $self->{FIO};    # circular reference
 }
 
 sub _version_ok {
-  my($self, $pp, $package, $dist) = @_;
+  my ($self, $ctx, $pp, $package, $dist) = @_;
   if (length $pp->{version} > 16) {
     my $errno = PAUSE::mldistwatch::Constants::ELONGVERSION;
     my $error = PAUSE::mldistwatch::Constants::heading($errno);
-    $self->index_status($package,
+    $self->index_status($ctx,
+                        $package,
                         $pp->{version},
                         $pp->{infile},
                         $errno,
@@ -369,9 +374,7 @@ dist[$dist]
 # package PAUSE::package;
 sub update_package {
   # we come here only for packages that have opack and package
-
-  my $self = shift;
-  my $row = shift;
+  my ($self, $ctx, $row) = @_;
 
   my $dbh = $self->connect;
   my $package = $self->{PACKAGE};
@@ -467,7 +470,8 @@ sub update_package {
           }
       } else {
           if (CPAN::Version->vgt($pp->{version},$oldversion)) {
-              $self->index_status($package,
+              $self->index_status($ctx,
+                                  $package,
                                   $pp->{version},
                                   $pp->{infile},
                                   PAUSE::mldistwatch::Constants::EDUALOLDER,
@@ -480,7 +484,8 @@ Maybe harmless, maybe needs resolving.},
 
                               );
           } else {
-              $self->index_status($package,
+              $self->index_status($ctx,
+                                  $package,
                                   $pp->{version},
                                   $pp->{infile},
                                   PAUSE::mldistwatch::Constants::EDUALYOUNGER,
@@ -493,7 +498,8 @@ $oldversion, so not indexing seems okay.},
           }
       }
   } elsif (defined $pp->{version} && ! version::is_lax($pp->{version})) {
-      $self->index_status($package,
+      $self->index_status($ctx,
+                          $package,
                           $pp->{version},
                           $pmfile,
                           PAUSE::mldistwatch::Constants::EBADVERSION,
@@ -514,7 +520,8 @@ $oldversion, so not indexing seems okay.},
   } elsif (CPAN::Version->vgt($oldversion,$pp->{version})) {
       # lower VERSION number here
       if ($odist ne $dist) {
-          $self->index_status($package,
+          $self->index_status($ctx,
+                              $package,
                               $pp->{version},
                               $pmfile,
                               PAUSE::mldistwatch::Constants::EVERFALLING,
@@ -561,7 +568,7 @@ pmfile[$pmfile]
               ]);
               $ok++;
           } else {
-              $self->index_status(
+              $self->index_status($ctx,
                                   $package,
                                   $pp->{version},
                                   $pp->{infile},
@@ -591,7 +598,7 @@ also has a zero version number and the distro has a more recent modification tim
                   old     => { dist => $odist, mtime => $odistmtime },
                 },
               ]);
-              $self->index_status(
+              $self->index_status($ctx,
                                   $package,
                                   $pp->{version},
                                   $pp->{infile},
@@ -639,19 +646,20 @@ has the same version number and the distro has a more recent modification time.}
               [ @$pkg_recs ],
           ]);
 
-          $self->index_status
-              ($package,
-               "undef",
-               $pp->{infile},
-               PAUSE::mldistwatch::Constants::EDBCONFLICT,
-               qq{Indexing failed because of conflicting records for $package.
+          $self->index_status(
+              $ctx,
+              $package,
+              "undef",
+              $pp->{infile},
+              PAUSE::mldistwatch::Constants::EDBCONFLICT,
+              qq{Indexing failed because of conflicting records for $package.
 Please report the case to the PAUSE admins at modules\@perl.org.},
-              );
+          );
           $ok = 0;
       }
   }
 
-  return unless $self->_version_ok($pp, $package, $dist);
+  return unless $self->_version_ok($ctx, $pp, $package, $dist);
 
 
   if ($ok) {
@@ -688,24 +696,26 @@ Please report the case to the PAUSE admins at modules\@perl.org.},
                              };
 
       if ($rows_affected) { # expecting only "1" can happen
-          $self->index_status
-              ($package,
-               $pp->{version},
-               $pp->{infile},
-               PAUSE::mldistwatch::Constants::OK,
-               "indexed",
-              );
+          $self->index_status(
+              $ctx,
+              $package,
+              $pp->{version},
+              $pp->{infile},
+              PAUSE::mldistwatch::Constants::OK,
+              "indexed",
+          );
       } else {
           my $dbherrstr = $dbh->errstr;
-          $self->index_status
-              ($package,
-               "undef",
-               $pp->{infile},
-               PAUSE::mldistwatch::Constants::EDBERR,
-               qq{The PAUSE indexer could not store the indexing
+          $self->index_status(
+            $ctx,
+            $package,
+            "undef",
+            $pp->{infile},
+            PAUSE::mldistwatch::Constants::EDBERR,
+            qq{The PAUSE indexer could not store the indexing
 result in the DB due the following error: C< $dbherrstr >.
 Please report the case to the PAUSE admins at modules\@perl.org.},
-              );
+          );
       }
 
   }
@@ -714,36 +724,38 @@ Please report the case to the PAUSE admins at modules\@perl.org.},
 
 # package PAUSE::package;
 sub index_status {
-  my($self) = shift;
+  my ($self, $ctx, @rest) = @_;
   my $dio;
+
   if (my $fio = $self->{FIO}) {
       $dio = $fio->{DIO};
   } else {
       $dio = $self->{DIO};
   }
-  $dio->index_status(@_);
+
+  $dio->index_status($ctx, @rest);
 }
 
 sub get_index_status_status {
-  my ($self) = @_;
+  my ($self, $ctx) = @_;
 
   return $self->dist->{INDEX_STATUS}{ $self->{PACKAGE} }{status};
 }
 
 sub add_indexing_warning {
-  my($self) = shift;
+  my ($self, $ctx, @rest) = @_;
   my $dio;
   if (my $fio = $self->{FIO}) {
       $dio = $fio->{DIO};
   } else {
       $dio = $self->{DIO};
   }
-  $dio->add_indexing_warning($self->{PACKAGE}, $_[0]);
+  $dio->add_indexing_warning($ctx, $self->{PACKAGE}, @rest);
 }
 
 # package PAUSE::package;
 sub insert_into_package {
-  my $self = shift;
+  my ($self, $ctx) = @_;
   my $dbh = $self->connect;
   my $package = $self->{PACKAGE};
   my $dist = $self->{DIST};
@@ -767,7 +779,7 @@ sub insert_into_package {
     }
   ]);
 
-  return unless $self->_version_ok($pp, $package, $dist);
+  return unless $self->_version_ok($ctx, $pp, $package, $dist);
   $dbh->do($query,
             undef,
             $package,
@@ -779,7 +791,8 @@ sub insert_into_package {
             $self->dist->{TIME},
             $distname,
           );
-  $self->index_status($package,
+  $self->index_status($ctx,
+                      $package,
                       $pp->{version},
                       $pp->{infile},
                       PAUSE::mldistwatch::Constants::OK,
@@ -790,7 +803,7 @@ sub insert_into_package {
 # package PAUSE::package;
 # returns always the return value of print, so basically always 1
 sub checkin_into_primeur {
-  my $self = shift;
+  my ($self, $ctx) = @_;
   my $dbh = $self->connect;
   my $package = $self->{PACKAGE};
   my $dist = $self->{DIST};
@@ -839,7 +852,7 @@ sub checkin_into_primeur {
 
 # package PAUSE::package;
 sub checkin {
-  my $self = shift;
+  my ($self, $ctx) = @_;
   my $dbh = $self->connect;
   my $package = $self->{PACKAGE};
   my $dist = $self->{DIST};
@@ -847,7 +860,7 @@ sub checkin {
   my $pmfile = $self->{PMFILE};
 
   # Copy permissions from main module to subsidiary modules.
-  $self->give_regdowner_perms;
+  $self->give_regdowner_perms($ctx);
 
   $self->dist->{CHECKINS}{ lc $package }{$package} = $self->{PMFILE};
 
@@ -863,15 +876,15 @@ sub checkin {
 
   if ($row) {
       # We know this package from some time ago
-      $self->update_package($row);
+      $self->update_package($ctx, $row);
   } else {
       # we hear for the first time about this package
-      $self->insert_into_package;
+      $self->insert_into_package($ctx);
   }
 
-  my $status = $self->get_index_status_status;
+  my $status = $self->get_index_status_status($ctx);
   if (! $status or $status == PAUSE::mldistwatch::Constants::OK) {
-      $self->checkin_into_primeur; # called in void context!
+      $self->checkin_into_primeur($ctx); # called in void context!
   }
 
 }
diff --git a/lib/PAUSE/pmfile.pm b/lib/PAUSE/pmfile.pm
index a57adb823..7baa38a36 100644
--- a/lib/PAUSE/pmfile.pm
+++ b/lib/PAUSE/pmfile.pm
@@ -106,7 +106,7 @@ sub filter_ppps {
 # package PAUSE::pmfile;
 sub examine_fio {
     # fio: file object
-    my $self = shift;
+    my ($self, $ctx) = @_;
 
     my $dist = $self->{DIO}{DIST};
     my $dbh = $self->connect;
@@ -117,7 +117,7 @@ sub examine_fio {
     my($filemtime) = (stat $pmfile)[9];
     $self->{MTIME} = $filemtime;
 
-    unless ($self->version_from_meta_ok) {
+    unless ($self->version_from_meta_ok($ctx)) {
         my $version;
         unless (eval { $version = $self->parse_version; 1 }) {
           my $error = $@;
@@ -148,7 +148,7 @@ sub examine_fio {
         }
     }
 
-    my($ppp) = $self->packages_per_pmfile;
+    my($ppp) = $self->packages_per_pmfile($ctx);
     my @keys_ppp = $self->filter_ppps(sort keys %$ppp);
 
     $Logger->log([ "will examine packages: %s", \@keys_ppp ]);
@@ -174,7 +174,7 @@ sub examine_fio {
                       MAIN_PACKAGE => $self->{MAIN_PACKAGE},
                   );
 
-        $pio->examine_pkg;
+        $pio->examine_pkg($ctx);
 
     }                       # end foreach package
 
@@ -184,14 +184,14 @@ sub examine_fio {
 
 # package PAUSE::pmfile
 sub version_from_meta_ok {
-    my($self) = @_;
+    my ($self, $ctx) = @_;
     return $self->{VERSION_FROM_META_OK} if exists $self->{VERSION_FROM_META_OK};
-    $self->{VERSION_FROM_META_OK} = $self->{DIO}->version_from_meta_ok;
+    $self->{VERSION_FROM_META_OK} = $self->{DIO}->version_from_meta_ok($ctx);
 }
 
 # package PAUSE::pmfile;
 sub packages_per_pmfile {
-    my $self = shift;
+    my ($self, $ctx) = @_;
 
     my $ppp = {};
     my $pmfile = $self->{PMFILE};
@@ -293,7 +293,7 @@ sub packages_per_pmfile {
             $ppp->{$pkg}{infile} = $pmfile;
             if (PAUSE->basename_matches_package($pmfile,$pkg)) {
                 $ppp->{$pkg}{basename_matches_package} = $pmfile;
-                if ($self->version_from_meta_ok) {
+                if ($self->version_from_meta_ok($ctx)) {
                     my $provides = $self->{DIO}{META_CONTENT}{provides};
                     if (exists $provides->{$pkg}) {
                         if (defined $provides->{$pkg}{version}) {

From 2c82b0a4612a5e69ab24fa3fd8a0340d1d389e0f Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 29 Apr 2023 13:21:43 +0200
Subject: [PATCH 03/49] Indexer context: move indexing warnings to context

---
 lib/PAUSE/Indexer/Context.pm | 35 +++++++++++++++++++++++++++++++++++
 lib/PAUSE/dist.pm            | 15 ++++-----------
 lib/PAUSE/package.pm         | 17 +++--------------
 t/mldistwatch-misc.t         |  4 ++--
 4 files changed, 44 insertions(+), 27 deletions(-)

diff --git a/lib/PAUSE/Indexer/Context.pm b/lib/PAUSE/Indexer/Context.pm
index 3d228fc45..1049fc01d 100644
--- a/lib/PAUSE/Indexer/Context.pm
+++ b/lib/PAUSE/Indexer/Context.pm
@@ -2,7 +2,42 @@ package PAUSE::Indexer::Context;
 use v5.12.0;
 use Moo;
 
+has package_warnings => (
+  is => 'bare',
+  reader  => '_package_warnings',
+  default => sub {  {}  },
+);
 
+sub add_package_warning {
+  my ($self, $package_obj, $warning) = @_;
+
+  my $package = $package_obj->{PACKAGE};
+  my $pmfile  = $package_obj->pmfile->{PMFILE};
+
+  my $key = "$package\0$pmfile";
+
+  my $list = ($self->_package_warnings->{$key} //= []);
+  push @$list, {
+    package => $package,
+    pmfile  => $pmfile,
+    text    => $warning,
+  };
+
+  return;
+}
+
+sub warnings_for_all_packages {
+  my ($self) = @_;
+
+  return map {; @$_ } values $self->_package_warnings->%*;
+}
+
+sub warnings_for_package {
+  my ($self, $package_name) = @_;
+
+  return grep {; $_->{package} eq $package_name }
+         map  {; @$_ } values $self->_package_warnings->%*;
+}
 
 no Moo;
 1;
diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index d04a5e8fc..d44c73797 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -559,11 +559,11 @@ sub mail_summary {
         # magic words, see also report02() around line 573, same wording there,
         # exception prompted by JOESUF/libapreq2-2.12.tar.gz
         $inxst->{$p}{infile} ||= "missing in META.yml, tolerated by PAUSE indexer";
-        push @m, sprintf("     module : %s\n",  $p);
+        push @m, sprintf("     package: %s\n",  $p);
 
-        if (my @warnings = $self->indexing_warnings_for_package($ctx, $p)) {
+        if (my @warnings = $ctx->warnings_for_package($p)) {
           push @m, map {;
-                 sprintf("     WARNING: %s\n", $_) } @warnings;
+                 sprintf("     WARNING: %s\n", $_->{text}) } @warnings;
         }
 
         push @m, sprintf("     version: %s\n", $inxst->{$p}{version});
@@ -659,13 +659,6 @@ sub index_status {
   };
 }
 
-sub add_indexing_warning {
-  my ($self, $ctx, $pack, $warning) = @_;
-
-  push @{ $self->{INDEX_WARNINGS}{$pack} }, $warning;
-  return;
-}
-
 sub indexing_warnings_for_package {
   my ($self, $ctx, $pack) = @_;
   return @{ $self->{INDEX_WARNINGS}{$pack} // [] };
@@ -709,7 +702,7 @@ sub check_blib {
       }
       last DIRDOWN unless $success; # no directory to step down anymore
       if (++$endless > 10) {
-        $self->alert("ENDLESS LOOP detected!");
+        $ctx->alert("ENDLESS LOOP detected!");
         last DIRDOWN;
       }
       next DIRDOWN;
diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index dbc517b84..408a18d21 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -286,9 +286,9 @@ sub examine_pkg {
 
       if (lc $module eq lc $package && $module ne $package) {
         # warn "/// $self->{PMFILE} vs. $module vs. $package\n";
-        $self->add_indexing_warning(
-          $ctx,
-          "Capitalization of package ($package) does not match filename!",
+        $ctx->add_package_warning(
+          $self,
+          "Capitalization of package does not match filename!",
         );
       }
     }
@@ -742,17 +742,6 @@ sub get_index_status_status {
   return $self->dist->{INDEX_STATUS}{ $self->{PACKAGE} }{status};
 }
 
-sub add_indexing_warning {
-  my ($self, $ctx, @rest) = @_;
-  my $dio;
-  if (my $fio = $self->{FIO}) {
-      $dio = $fio->{DIO};
-  } else {
-      $dio = $self->{DIO};
-  }
-  $dio->add_indexing_warning($ctx, $self->{PACKAGE}, @rest);
-}
-
 # package PAUSE::package;
 sub insert_into_package {
   my ($self, $ctx) = @_;
diff --git a/t/mldistwatch-misc.t b/t/mldistwatch-misc.t
index 00ba8e483..4a7cfad78 100644
--- a/t/mldistwatch-misc.t
+++ b/t/mldistwatch-misc.t
@@ -194,14 +194,14 @@ subtest "warn when pkg and module match only case insensitively" => sub {
           sub {
             like(
               $_[0]{email}->get_body,
-              qr/Capitalization of package \(Fewer\)/,
+              qr/package: Fewer\s+WARNING: Capitalization of package/,
               "warning about Fewer v. fewer",
             );
           },
           sub {
             like(
               $_[0]{email}->get_body,
-              qr/Capitalization of package \(More\)/,
+              qr/package: More\s+WARNING: Capitalization of package/,
               "warning about More v. more",
             );
           },

From c27e5f0f64cba69885ceee27a301070f8a875d00 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 29 Apr 2023 13:22:01 +0200
Subject: [PATCH 04/49] Indexer context: move alerts to context

---
 lib/PAUSE/Indexer/Context.pm | 19 +++++++++++++++++
 lib/PAUSE/dist.pm            | 40 ++++++++++++------------------------
 lib/PAUSE/mldistwatch.pm     | 14 ++++++-------
 lib/PAUSE/package.pm         | 16 ++++-----------
 lib/PAUSE/pmfile.pm          |  8 --------
 t/lib/Mock/Dist.pm           |  2 +-
 6 files changed, 43 insertions(+), 56 deletions(-)

diff --git a/lib/PAUSE/Indexer/Context.pm b/lib/PAUSE/Indexer/Context.pm
index 1049fc01d..b97af9db3 100644
--- a/lib/PAUSE/Indexer/Context.pm
+++ b/lib/PAUSE/Indexer/Context.pm
@@ -39,5 +39,24 @@ sub warnings_for_package {
          map  {; @$_ } values $self->_package_warnings->%*;
 }
 
+has alerts => (
+  is      => 'bare',
+  reader  => '_alerts',
+  default => sub {  []  },
+);
+
+sub alert {
+  my ($self, $alert) = @_;
+  $alert =~ s/\v+\z//;
+
+  push $self->_alerts->@*, $alert;
+  return;
+}
+
+sub all_alerts {
+  my ($self) = @_;
+  return $self->_alerts->@*;
+}
+
 no Moo;
 1;
diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index d44c73797..6e0116971 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -158,22 +158,8 @@ sub mtime_ok {
   return;
 }
 
-sub alert {
-  my ($self, $what) = @_;
-
-  $self->{ALERT} //= [];
-  1 while chomp $what;
-  push @{ $self->{ALERT} }, $what;
-  return;
-}
-
-sub all_alerts {
-  my ($self, $ctx) = @_;
-  return @{ $self->{ALERT} // [] };
-}
-
 sub untar {
-  my $self = shift;
+  my ($self, $ctx) = @_;
   my $dist = $self->{DIST};
   local *TARTEST;
   my $tarbin = $self->hub->{TARBIN};
@@ -188,7 +174,7 @@ sub untar {
   while (<TARTEST>) {
     if (m:^\.\./: || m:/\.\./: ) {
       $Logger->log("*** ALERT: updir detected!");
-      $self->alert("updir detected!");
+      $ctx->alert("updir detected!");
       $self->{COULD_NOT_UNTAR}++;
       return;
     }
@@ -199,7 +185,7 @@ sub untar {
   $self->{PERL_MAJOR_VERSION} = 5 unless defined $self->{PERL_MAJOR_VERSION};
   unless (close TARTEST) {
     $Logger->log("could not untar $dist!");
-    $self->alert("could not untar!");
+    $ctx->alert("could not untar!");
     $self->{COULD_NOT_UNTAR}++;
     return;
   }
@@ -247,7 +233,7 @@ sub skip { shift->{SKIP} }
 my $SUFFQR = qr/\.(tgz|tbz|tar[\._-]gz|tar\.bz2|tar\.Z)$/;
 
 sub _examine_regular_perl {
-  my ($self) = @_;
+  my ($self, $ctx) = @_;
   my ($suffix, $skip);
 
   my $dist = $self->{DIST};
@@ -268,10 +254,10 @@ sub _examine_regular_perl {
     $suffix = $1;
   } else {
     $Logger->log("perl distro ($dist) with an unusual suffix!");
-    $self->alert("perl distro ($dist) with an unusual suffix!");
+    $ctx->alert("perl distro ($dist) with an unusual suffix!");
   }
   unless ($skip) {
-    $skip = 1 unless $self->untar;
+    $skip = 1 unless $self->untar($ctx);
   }
 
   return ($suffix, $skip);
@@ -292,7 +278,7 @@ sub examine_dist {
   $suffix = $skip = "";
 
   if (PAUSE::isa_regular_perl($dist)) {
-    ($suffix, $skip) = $self->_examine_regular_perl;
+    ($suffix, $skip) = $self->_examine_regular_perl($ctx);
     $self->{SUFFIX} = $suffix;
     $self->{SKIP}   = $skip;
     return;
@@ -314,7 +300,7 @@ sub examine_dist {
 
   if ($dist =~ $SUFFQR) {
     $suffix = $1;
-    $skip = 1 unless $self->untar;
+    $skip = 1 unless $self->untar($ctx);
   } elsif ($dist =~ /\.pm\.(?:Z|gz|bz2)$/) {
     $Logger->log("dist is a single-.pm-file upload");
     $suffix = "N/A";
@@ -498,7 +484,7 @@ sub mail_summary {
     } else {
 
       my $err = join "\n", @{$self->{HAS_WORLD_WRITABLE_FIXINGERRORS}||[]};
-      $self->alert("Fixing a world-writable tarball failed: $err");
+      $ctx->alert("Fixing a world-writable tarball failed: $err");
 
     }
 
@@ -859,7 +845,7 @@ sub _index_by_files {
 
   for my $pmfile (@$pmfiles) {
     if ($pmfile =~ m|/blib/|) {
-      $self->alert("blib directory detected ($pmfile)");
+      $ctx->alert("blib directory detected ($pmfile)");
       next;
     }
 
@@ -957,7 +943,7 @@ sub examine_pms {
   if ($indexing_method) {
     $self->$indexing_method($ctx, $pmfiles, $provides);
   } else {
-    $self->alert("Couldn't determine an indexing method!");
+    $ctx->alert("Couldn't determine an indexing method!");
   }
 }
 
@@ -1210,7 +1196,7 @@ sub p6_dist_meta_ok {
 }
 
 sub p6_index_dist {
-  my $self   = shift;
+  my ($self, $ctx) = @_;
   my $dbh    = $self->connect;
   my $dist   = $self->{DIST};
   my $MLROOT = $self->mlroot;
@@ -1288,7 +1274,7 @@ sub p6_index_dist {
   }
   unless (close TARTEST) {
     $Logger->log("could not untar!");
-    $self->alert("Could not untar!");
+    $ctx->alert("Could not untar!");
     $self->{COULD_NOT_UNTAR}++;
     return "ERROR: Could not untar $dist!";
   }
diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index 395cb05ee..d6022af5e 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -357,15 +357,15 @@ sub _do_the_database_work {
     # Either we're doing Perl 6...
     if ($dio->perl_major_version == 6) {
       if ($dio->p6_dist_meta_ok) {
-        if (my $err = $dio->p6_index_dist) {
-          $dio->alert($err);
+        if (my $err = $dio->p6_index_dist($ctx)) {
+          $ctx->alert($err);
           $dbh->rollback;
         } else {
           $dbh->commit;
         }
       }
       else {
-        $dio->alert("Meta information of Perl 6 dist is invalid");
+        $ctx->alert("Meta information of Perl 6 dist is invalid");
         $dbh->rollback;
       }
 
@@ -382,7 +382,7 @@ sub _do_the_database_work {
 
       $dbh->commit;
     } else {
-      $dio->alert("Uploading user has no permissions on package $main_pkg");
+      $ctx->alert("Uploading user has no permissions on package $main_pkg");
       $dio->{NO_DISTNAME_PERMISSION} = 1;
       $dbh->rollback;
     }
@@ -519,7 +519,7 @@ sub maybe_index_dist {
       $self->disconnect;
       if ($attempt == 3) {
         $Logger->log_debug("tried $attempt times to do db work, but all failed");
-        $dio->alert("database errors while indexing");
+        $ctx->alert("database errors while indexing");
         $dio->{REASON_TO_SKIP} = PAUSE::mldistwatch::Constants::E_DB_XACTFAIL;
       }
     }
@@ -528,9 +528,7 @@ sub maybe_index_dist {
     $self->sleep;
     $dio->set_indexed($ctx);
 
-    my @alerts = $dio->all_alerts($ctx);
-    return unless @alerts;
-    return @alerts;
+    return $ctx->all_alerts;
 }
 
 sub check_for_new {
diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index 408a18d21..f040a72d1 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -71,14 +71,6 @@ sub new {
   bless { @_ }, ref($me) || $me;
 }
 
-# package PAUSE::package;
-sub alert {
-  my $self = shift;
-  my $what = shift;
-  my $parent = $self->parent;
-  $parent->alert($what);
-}
-
 # package PAUSE::package;
 # return value nonsensical
 # XXX needs case check
@@ -179,7 +171,7 @@ Hint: you can always find the legitimate maintainer(s) on PAUSE under
                               PAUSE::mldistwatch::Constants::EMISSPERM,
                               $message,
                               );
-          $self->alert(qq{$error:
+          $ctx->alert(qq{$error:
 package[$package]
 version[$pp->{version}]
 file[$pp->{infile}]
@@ -360,7 +352,7 @@ sub _version_ok {
                         $errno,
                         $error,
                         );
-    $self->alert(qq{$error:
+    $ctx->alert(qq{$error:
 package[$package]
 version[$pp->{version}]
 file[$pp->{infile}]
@@ -531,7 +523,7 @@ has a higher version number ($oldversion)},
 
           delete $self->dist->{CHECKINS}{ lc $package }{ $package };
 
-          $self->alert(qq{decreasing VERSION number [$pp->{version}]
+          $ctx->alert(qq{decreasing VERSION number [$pp->{version}]
 in package[$package]
 dist[$dist]
 oldversion[$oldversion]
@@ -541,7 +533,7 @@ pmfile[$pmfile]
           $ok++;          # new on 2002-08-01
       } else {
           # we get a different result now than we got in a previous run
-          $self->alert("Taking back previous version calculation. odist[$odist]oversion[$oldversion]dist[$dist]version[$pp->{version}].");
+          $ctx->alert("Taking back previous version calculation. odist[$odist]oversion[$oldversion]dist[$dist]version[$pp->{version}].");
           $ok++;
       }
   } else {
diff --git a/lib/PAUSE/pmfile.pm b/lib/PAUSE/pmfile.pm
index 7baa38a36..b523fcf04 100644
--- a/lib/PAUSE/pmfile.pm
+++ b/lib/PAUSE/pmfile.pm
@@ -27,14 +27,6 @@ sub new {
     bless { @_ }, ref($me) || $me;
 }
 
-# package PAUSE::pmfile;
-sub alert {
-    my $self = shift;
-    my $what = shift;
-    my $dio = $self->{DIO};
-    $dio->alert($what);
-}
-
 sub connect {
     my($self) = @_;
     my $dio = $self->{DIO};
diff --git a/t/lib/Mock/Dist.pm b/t/lib/Mock/Dist.pm
index f63ef5486..c9e80121a 100644
--- a/t/lib/Mock/Dist.pm
+++ b/t/lib/Mock/Dist.pm
@@ -9,7 +9,7 @@ use Test::Deep ();
 
 my $null = sub {};
 
-my @NULL = qw(verbose alert connect disconnect mlroot);
+my @NULL = qw(verbose connect disconnect mlroot);
 
 my %ALWAYS = (
   version_from_meta_ok => 1,

From a0badf20bb8e74c308306a2d43c269345a6dffb9 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 29 Apr 2023 13:37:29 +0200
Subject: [PATCH 05/49] indexer: make more dist indexing steps check for skip

---
 lib/PAUSE/dist.pm        | 24 ++++++++++++++++++++++++
 lib/PAUSE/mldistwatch.pm | 35 +++++++++--------------------------
 2 files changed, 33 insertions(+), 26 deletions(-)

diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 6e0116971..acf312c8c 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -1083,6 +1083,30 @@ sub extract_readme_and_meta {
   }
 }
 
+sub check_indexability {
+    my ($self, $ctx) = @_;
+    if ($self->{META_CONTENT}{distribution_type}
+        && $self->{META_CONTENT}{distribution_type} =~ m/^(script)$/) {
+        return;
+    }
+
+    if (($self->{META_CONTENT}{release_status} // 'stable') ne 'stable') {
+        # META.json / META.yml declares it's not stable; do not index!
+        $self->{SKIP} = 1;
+        $self->{REASON_TO_SKIP} = PAUSE::mldistwatch::Constants::EMETAUNSTABLE;
+        return;
+    }
+
+    if (my @bad_names = $self->malformed_provides_names) {
+        # "provides" is the "I know what I'm doing better than the indexer"
+        # control.  When it's wrong, just abort the whole dist.
+        $Logger->log([ "META provides has malformed package names: %s", \@bad_names ]);
+        $self->{SKIP} = 1;
+        $self->{REASON_TO_SKIP} = PAUSE::mldistwatch::Constants::EBADPROVIDES;
+        return;
+    }
+}
+
 sub write_updated_meta6_json {
   my($self, $metafile, $MLROOT, $dist, $sans) = @_;
 
diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index d6022af5e..650126b80 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -475,7 +475,15 @@ sub maybe_index_dist {
         }
     }
 
-    for my $method (qw( examine_dist read_dist extract_readme_and_meta )) {
+    for my $method (qw(
+      examine_dist
+      read_dist
+      extract_readme_and_meta
+      check_indexability
+      check_blib
+      check_multiple_root
+      check_world_writable
+    )) {
       $dio->$method($ctx);
       if ($dio->skip) {
           delete $self->{ALLlasttime}{$dist};
@@ -488,31 +496,6 @@ sub maybe_index_dist {
       }
     }
 
-    if ($dio->{META_CONTENT}{distribution_type}
-        && $dio->{META_CONTENT}{distribution_type} =~ m/^(script)$/) {
-        return;
-    }
-
-    if (($dio->{META_CONTENT}{release_status} // 'stable') ne 'stable') {
-        # META.json / META.yml declares it's not stable; do not index!
-        $dio->{REASON_TO_SKIP} = PAUSE::mldistwatch::Constants::EMETAUNSTABLE;
-        $dio->mail_summary($ctx);
-        return;
-    }
-
-    if (my @bad_names = $dio->malformed_provides_names) {
-        # "provides" is the "I know what I'm doing better than the indexer"
-        # control.  When it's wrong, just abort the whole dist.
-        $Logger->log([ "META provides has malformed package names: %s", \@bad_names ]);
-        $dio->{REASON_TO_SKIP} = PAUSE::mldistwatch::Constants::EBADPROVIDES;
-        $dio->mail_summary($ctx);
-        return;
-    }
-
-    $dio->check_blib($ctx);
-    $dio->check_multiple_root($ctx);
-    $dio->check_world_writable($ctx);
-
     for my $attempt (1 .. 3) {
       my $db_ok = $self->_do_the_database_work($ctx, $dio);
       last if $db_ok;

From 93309d78c0e49214893d6e0c8e6103635141e4d2 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 01:41:47 +0200
Subject: [PATCH 06/49] indexer: add Abort and Errors to control indexing

This lets us easily register errors with name and description, and to
use those errors to easily say "stop the whole dist for this reason" and
have the right thing happen.  Subsequent commits will put these new
libraries to use.
---
 lib/PAUSE/Indexer/Abort.pm   |  16 +++++
 lib/PAUSE/Indexer/Context.pm |  37 +++++++++++
 lib/PAUSE/Indexer/Errors.pm  | 121 +++++++++++++++++++++++++++++++++++
 3 files changed, 174 insertions(+)
 create mode 100644 lib/PAUSE/Indexer/Abort.pm
 create mode 100644 lib/PAUSE/Indexer/Errors.pm

diff --git a/lib/PAUSE/Indexer/Abort.pm b/lib/PAUSE/Indexer/Abort.pm
new file mode 100644
index 000000000..e9660ad31
--- /dev/null
+++ b/lib/PAUSE/Indexer/Abort.pm
@@ -0,0 +1,16 @@
+package PAUSE::Indexer::Abort;
+use v5.12.0;
+use Moo;
+
+has public => (
+  is      => 'ro',
+  default => 0,
+);
+
+has message => (
+  is => 'ro',
+  required => 1,
+);
+
+no Moo;
+1;
diff --git a/lib/PAUSE/Indexer/Context.pm b/lib/PAUSE/Indexer/Context.pm
index b97af9db3..724584a29 100644
--- a/lib/PAUSE/Indexer/Context.pm
+++ b/lib/PAUSE/Indexer/Context.pm
@@ -2,6 +2,10 @@ package PAUSE::Indexer::Context;
 use v5.12.0;
 use Moo;
 
+use PAUSE::Indexer::Abort;
+use PAUSE::Indexer::Errors;
+use PAUSE::Logger '$Logger';
+
 has package_warnings => (
   is => 'bare',
   reader  => '_package_warnings',
@@ -58,5 +62,38 @@ sub all_alerts {
   return $self->_alerts->@*;
 }
 
+has dist_errors => (
+  is      => 'bare',
+  reader  => '_dist_errors',
+  default => sub {  []  },
+);
+
+sub add_dist_error {
+  my ($self, $error) = @_;
+
+  $error = ref $error ? $error : { ident => $error, message => $error };
+
+  $Logger->log("adding dist error: " . ($error->{ident} // $error->{message}));
+  push $self->_dist_errors->@*, $error;
+
+  return $error;
+}
+
+sub dist_errors {
+  my ($self) = @_;
+  return $self->_dist_errors->@*;
+}
+
+sub abort_indexing {
+  my ($self, $error) = @_;
+
+  $error = $self->add_dist_error($error);
+
+  die PAUSE::Indexer::Abort->new({
+    message => $error->{message},
+    public  => $error->{public},
+  });
+}
+
 no Moo;
 1;
diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
new file mode 100644
index 000000000..1d5dafdf3
--- /dev/null
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -0,0 +1,121 @@
+package PAUSE::Indexer::Errors;
+use v5.12.0;
+use warnings;
+
+use Sub::Exporter -setup => {
+  exports => [ 'ERROR' ],
+  groups  => { default => [ 'ERROR' ] },
+};
+
+my %ERROR;
+
+sub public_error {
+  my ($name, $arg) = @_;
+  $ERROR{$name} = {
+    ident   => $name,
+    public  => 1,
+    %$arg,
+  };
+}
+
+public_error blib => {
+  header  => 'archive contains a "blib" directory',
+  body    => <<~'EOF'
+    The distribution contains a blib/ directory and is therefore not being
+    indexed.  Hint: try 'make dist'.
+    EOF
+};
+
+public_error multiroot => {
+  header  => 'archive has multiple roots',
+  body    => sub {
+    my ($dist) = @_;
+    return <<~"EOF"
+      The distribution does not unpack into a single directory and is therefore
+      not being indexed. Hint: try 'make dist' or 'Build dist'. (The directory
+      entries found were: @{$dist->{HAS_MULTIPLE_ROOT}})
+    EOF
+  },
+};
+
+public_error no_distname_permission => {
+  header  => 'missing permissions on distname package',
+  body    => sub {
+    my ($dist) = @_;
+
+    my $pkg = $dist->_package_governing_permission;
+
+    return <<~"EOF"
+      You appear to be missing a .pm file containing a package matching the
+      dist name.  For this distribution, that package would be called $pkg.
+      Adding this may solve your issue. Or maybe it is the other way round and
+      a different distribution name could be chosen, matching a package you are
+      shipping.
+      EOF
+  },
+};
+
+public_error no_meta => {
+  header  => "no META.yml or META.json found",
+  body    => <<~'EOF',
+    Your archive didn't contain a META.json or META.yml file.  You need to
+    include at least one of these.  A CPAN distribution building tool like
+    ExtUtils::MakeMaker can help with this.
+    EOF
+};
+
+public_error single_pm => {
+  header  => 'dist is a single-.pm-file upload',
+  body    => <<~"EOF",
+    You've uploaded a compressed .pm file without a META.json, a build tool, or
+    the other things you need to be a CPAN distribution.  This was once
+    permitted, but no longer is.  Please use a CPAN distribution building tool.
+    EOF
+};
+
+public_error unstable_release => {
+  header  => 'META release_status is not stable',
+  body    => <<~'EOF',
+    Your META file provides a release status other than "stable", so this
+    distribution will not be indexed.
+    EOF
+};
+
+public_error worldwritable => {
+  header  => 'archive has world writable files',
+  body    => sub {
+    my ($dist) = @_;
+    return <<~"EOF"
+      The distribution contains the following world writable directories or
+      files and is therefore considered a security breach and as such not
+      being indexed: @{$dist->{HAS_WORLD_WRITABLE}}
+      EOF
+  },
+};
+
+public_error xact_fail => {
+  header => "ERROR: Database error occurred during index update",
+  body   => <<~'EOF',
+    This distribution was not indexed due to database errors.  You can request
+    another indexing attempt be made by logging into https://pause.perl.org/
+    EOF
+};
+
+sub ERROR {
+  my ($ident) = @_;
+
+  my $error = PAUSE::Indexer::Errors->error_named($ident);
+  unless ($error) {
+    Carp::confess("requested unknown error: $ident");
+  }
+
+  return $error;
+}
+
+sub error_named {
+  my ($self, $ident) = @_;
+
+  return $ERROR{$ident};
+}
+
+1;

From c86ea5a32d76642393b630851f99869d67c15f43 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 09:29:40 +0200
Subject: [PATCH 07/49] indexer: a big refactor to change how we abort indexing

We replace $dist->{SKIP} with $ctx->dist_errors.  This accumulates a
list of reasons to stop indexing the whole dist (although usually only
one can show up).

$dist->{REASON_TO_SKIP} is also replaced by dist_errors.  Previously,
SKIP (a bool) meant to skip and REASON_TO_SKIP meant "and tell the user
this".  Now, there is always a reason, and the error contains a separate
flag indicating whether to send it to the user.

Previously, some skip reasons were REASON_TO_SKIP, but others were
other properties on the $dist object, like HAS_BLIB or
HAS_MULTIPLE_ROOT.  These are now dist errors, so there's a uniform
handling of their description, and they can abort processing in a
uniform way.

Code that wants to abort can $ctx->abort_indexing, which adds a
dist_error and uses an exception to stop processing the dist further.

I deleted a bunch of code managing the "you don't have permissions on
the distribution-name package", which is the thing that asserts you must
have permission on Foo::Bar to upload Foo-Bar.  Previously, this code
still summarized each pmfile scanned, and then fixed up the results to
act like passing modules failed.  Now, this error is simply displayed as
a total dist failure.  I think it should be possible to show the package
indexing summary again in the future, but for now the code was overly
complex and didn't really add much value.

I broke out two hunks of email content generating code, done just to
reduce the total size of the mail_summary subroutine.

I also eliminated the code that would produce
Your-Tarball-withoutworldwriteables, which was meant to automatically
correct for authors uploading archives with a+w permissions on their
files.  In the last 13 years, this seems to have rescued only one
still-indexed dist.  It's just an error now.
---
 lib/PAUSE/Indexer/Errors.pm        |  13 +
 lib/PAUSE/dist.pm                  | 420 +++++++++++------------------
 lib/PAUSE/mldistwatch.pm           |  29 +-
 lib/PAUSE/mldistwatch/Constants.pm |   2 -
 t/mldistwatch-big.t                |  20 +-
 t/mldistwatch-misc.t               |   2 +-
 6 files changed, 192 insertions(+), 294 deletions(-)

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index 1d5dafdf3..3669569d8 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -18,6 +18,19 @@ sub public_error {
   };
 }
 
+public_error bad_provides => {
+  header  => 'META provides includes a malformed package name',
+  body    => sub {
+    my ($dist) = @_;
+    my $names = join q{, }, @{ $dist->{MALFORMED_PROVIDES} || [] };
+    return <<~"EOF"
+      The "provides" entry in your META file names packages that aren't valid
+      package names: $names.  When "provides" can't be trusted, none of it is,
+      so nothing in this distribution will be indexed.
+      EOF
+  },
+};
+
 public_error blib => {
   header  => 'archive contains a "blib" directory',
   body    => <<~'EOF'
diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index acf312c8c..89106e087 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -10,6 +10,7 @@ use PAUSE ();
 use Parse::CPAN::Meta;
 use PAUSE::package ();
 use PAUSE::mldistwatch::Constants;
+use PAUSE::Indexer::Errors;
 use JSON::XS ();
 
 use PAUSE::Logger '$Logger';
@@ -220,8 +221,6 @@ sub untar {
 
 sub perl_major_version { shift->{PERL_MAJOR_VERSION} }
 
-sub skip { shift->{SKIP} }
-
 # Commented out this function just like $ISA_BLEAD_PERL
 ##sub isa_blead_perl {
 ##  my($self,$dist) = @_;
@@ -256,6 +255,7 @@ sub _examine_regular_perl {
     $Logger->log("perl distro ($dist) with an unusual suffix!");
     $ctx->alert("perl distro ($dist) with an unusual suffix!");
   }
+
   unless ($skip) {
     $skip = 1 unless $self->untar($ctx);
   }
@@ -279,35 +279,36 @@ sub examine_dist {
 
   if (PAUSE::isa_regular_perl($dist)) {
     ($suffix, $skip) = $self->_examine_regular_perl($ctx);
+
     $self->{SUFFIX} = $suffix;
-    $self->{SKIP}   = $skip;
+
+    if ($skip) {
+      $ctx->abort_indexing("won't process regular perl upload");
+    }
+
     return;
   }
 
   if ($self->isa_dev_version) {
-    $Logger->log("dist is a developer release");
     $self->{SUFFIX} = "N/A";
-    $self->{SKIP}   = 1;
-    return;
+    $ctx->abort_indexing("dist is a developer release");
   }
 
   if ($dist =~ m|/perl-\d+|) {
-    $Logger->log("dist is an unofficial perl-like release");
     $self->{SUFFIX} = "N/A";
-    $self->{SKIP}   = 1;
-    return;
+    $ctx->abort_indexing("dist is an unofficial perl-like release");
   }
 
   if ($dist =~ $SUFFQR) {
-    $suffix = $1;
-    $skip = 1 unless $self->untar($ctx);
+    $self->{SUFFIX} = $1;
+    unless ($self->untar($ctx)) {
+      $ctx->abort_indexing("can't untar archive");
+    }
   } elsif ($dist =~ /\.pm\.(?:Z|gz|bz2)$/) {
-    $Logger->log("dist is a single-.pm-file upload");
-    $suffix = "N/A";
-    $skip   = 1;
-    $self->{REASON_TO_SKIP} = PAUSE::mldistwatch::Constants::EBAREPMFILE;
+    $self->{SUFFIX} = "N/A";
+    $ctx->abort_indexing(ERROR('single_pm'));
   } elsif ($dist =~ /\.zip$/) {
-    $suffix = "zip";
+    $self->{SUFFIX} = "zip";
     my $unzipbin = $self->hub->{UNZIPBIN};
     my $system = "$unzipbin $MLROOT/$dist > /dev/null 2>&1";
     unless (system($system)==0) {
@@ -320,12 +321,10 @@ sub examine_dist {
       # system("$unzipbin -t $MLROOT/$dist");
     }
   } else {
-    $Logger->log("file does not appear to be a CPAN distribution");
-    $skip = 1;
+    $ctx->abort_indexing("file does not appear to be a CPAN distribution");
   }
 
-  $self->{SUFFIX} = $suffix;
-  $self->{SKIP}   = $skip;
+  return;
 }
 
 sub connect {
@@ -343,6 +342,84 @@ sub mlroot {
   $self->hub->mlroot;
 }
 
+sub _update_mail_content_when_things_were_indexed {
+    my ($self, $ctx, $inxst, $m_ref, $status_ref) = @_;
+
+    my $Lstatus = 0;
+    my $intro_written;
+    for my $p (sort {
+        $inxst->{$b}{status} <=> $inxst->{$a}{status}
+          or
+        $a cmp $b
+      } keys %$inxst) {
+      my $status = $inxst->{$p}{status};
+      unless (defined $$status_ref) {
+        if ($status) {
+          if ($status > PAUSE::mldistwatch::Constants::OK) {
+            $$status_ref =
+            PAUSE::mldistwatch::Constants::heading($status)
+            || "UNKNOWN (status=$status)";
+          } else {
+            $$status_ref = "OK";
+          }
+        } else {
+          $$status_ref = "Unknown";
+        }
+        push @$m_ref, "Status of this distro: $$status_ref\n";
+        push @$m_ref, "="x(length($$status_ref)+23), "\n\n";
+      }
+      unless ($intro_written++) {
+        push @$m_ref, qq{\nThe following packages (grouped by }.
+        qq{status) have been found in the distro:\n\n};
+      }
+      if ($status != $Lstatus) {
+        my $heading =
+        PAUSE::mldistwatch::Constants::heading($status) ||
+        "UNKNOWN (status=$status)";
+        push @$m_ref, sprintf "Status: %s\n%s\n\n", $heading, "="x(length($heading)+8);
+      }
+      my $tf14 = Text::Format->new(
+        bodyIndent => 14,
+        firstIndent => 14,
+      );
+      my $verb_status = $tf14->format($inxst->{$p}{verb_status});
+      $verb_status =~ s/^\s+//; # otherwise this line is too long
+      # magic words, see also report02() around line 573, same wording there,
+      # exception prompted by JOESUF/libapreq2-2.12.tar.gz
+      $inxst->{$p}{infile} ||= "missing in META.yml, tolerated by PAUSE indexer";
+      push @$m_ref, sprintf("     package: %s\n",  $p);
+
+      if (my @warnings = $ctx->warnings_for_package($p)) {
+        push @$m_ref, map {;
+               sprintf("     WARNING: %s\n", $_->{text}) } @warnings;
+      }
+
+      push @$m_ref, sprintf("     version: %s\n", $inxst->{$p}{version});
+      push @$m_ref, sprintf("     in file: %s\n", $inxst->{$p}{infile});
+      push @$m_ref, sprintf("     status : %s\n",  $verb_status);
+
+      $Lstatus = $status;
+    }
+}
+
+sub _update_mail_content_when_nothing_was_indexed {
+    my ($self, $ctx, $inxst, $m_ref, $status_ref) = @_;
+
+    if ($self->version_from_meta_ok($ctx)) {
+      push @$m_ref,  qq{Nothing in this distro has been \n}
+                  .  qq{indexed, because according to META.yml this\n}
+                  .  qq{package does not provide any modules.\n\n};
+
+      $$status_ref = "Empty_provides";
+    } else {
+      push @$m_ref,  qq{No or no indexable package statements could be found\n}
+                  .  qq{in the distro (maybe a script or documentation\n}
+                  .  qq{distribution or a developer release?)\n\n};
+
+      $$status_ref = "Empty_no_pm";
+    }
+}
+
 sub mail_summary {
   my ($self, $ctx) = @_;
   my $distro = $self->{DIST};
@@ -399,217 +476,71 @@ sub mail_summary {
 
   my $status_over_all;
 
-  if (my $err = $self->{REASON_TO_SKIP}) {
-    push @m, $tf->format( PAUSE::mldistwatch::Constants::heading($err) ),
-             qq{\n\n};
-    $status_over_all = "Failed";
-  }
+  my @dist_errors = $ctx->dist_errors;
 
-  # NO_DISTNAME_PERMISSION must not hide other problem messages, so
-  # we fix up any "OK" status records to reflect the permission
-  # problem and let the rest of the report run as usual
-  if ($self->{NO_DISTNAME_PERMISSION}) {
-    my $pkg = $self->_package_governing_permission;
-    push @m, $tf->format(qq[This distribution name will only be indexed
-      when uploaded by users with permission for the package $pkg.
-      Either someone else has ownership over that package name, or
-      this is a brand new distribution and that package name was neither
-      listed in the 'provides' field in the META file nor found
-      inside the distribution's modules.  Therefore, no modules
-      will be indexed.]);
-    push @m, qq{\nFurther details on the indexing attempt follow.\n\n};
-    $status_over_all = "Failed";
+  for my $error (@dist_errors) {
+    my $header = $error->{header};
+    my $body   = $error->{body};
+    $body = $body->($self) if ref $body;
 
-    my $inxst = $self->{INDEX_STATUS};
-    if ($inxst && ref $inxst && %$inxst) {
-      unless ($inxst->{$pkg}) {
-        # Perhaps they forgot a pm file matching the dist name
-        my($inxpkg_eg) = sort keys %$inxst;
-        $inxpkg_eg =~ s/::/-/g;
-        $inxpkg_eg =~ s/$/-.../;
-        push @m, $tf->format(qq{\n\nYou appear to be missing a .pm file
-          containing a package matching the dist name ($pkg). Adding this
-          may solve your issue. Or maybe it is the other way round and a
-          different distribution name could be chosen to reflect an
-          actually included package name (eg. $inxpkg_eg).\n});
-    }
-
-      for my $p ( keys %$inxst ) {
-          next unless
-            $inxst->{$p}{status} == PAUSE::mldistwatch::Constants::OK;
-          $inxst->{$p}{status} = PAUSE::mldistwatch::Constants::EDISTNAMEPERM;
-          $inxst->{$p}{verb_status} =
-            "Not indexed; $author not authorized for this distribution name";
-      }
-    }
-    else {
-        # some other problem prevented any modules from having status
-        # recorded, we don't have to do anything
-    }
-  }
-
-  if ($self->{HAS_MULTIPLE_ROOT}) {
-
-    push @m, $tf->format(qq[The distribution does not unpack
-      into a single directory and is therefore not being
-      indexed. Hint: try 'make dist' or 'Build dist'. (The
-        directory entries found were: @{$self->{HAS_MULTIPLE_ROOT}})]);
-
-    push @m, qq{\n\n};
-
-    $status_over_all = "Failed";
-
-  } elsif ($self->{HAS_WORLD_WRITABLE}) {
-
-    push @m, $tf->format(qq[The distribution contains the
-      following world writable directories or files and is
-      therefore considered a security breach and as such not
-      being indexed: @{$self->{HAS_WORLD_WRITABLE}} ]);
-
-    push @m, qq{\n\n};
-
-    if ($self->{HAS_WORLD_WRITABLE_FIXEDFILE}) {
-
-      push @m, $tf->format(qq[For your convenience PAUSE has
-        tried to write a new tarball with all the
-        world-writable bits removed. The file is put on
-        the CPAN as
-        '$self->{HAS_WORLD_WRITABLE_FIXEDFILE}' along with
-        your upload and will be indexed automatically
-        unless there are other errors that prevent that.
-        Please watch for a separate indexing report.]);
-
-      push @m, qq{\n\n};
-
-    } else {
-
-      my $err = join "\n", @{$self->{HAS_WORLD_WRITABLE_FIXINGERRORS}||[]};
-      $ctx->alert("Fixing a world-writable tarball failed: $err");
-
-    }
-
-    $status_over_all = "Failed";
-
-  } elsif ($self->{HAS_BLIB}) {
-
-    push @m, $tf->format(qq{The distribution contains a blib/
-      directory and is therefore not being indexed. Hint:
-      try 'make dist'.});
-
-    push @m, qq{\n\n};
+    push @m, "## $header\n\n";
+    push @m, $tf->format($body), qq{\n\n};
 
     $status_over_all = "Failed";
+  }
 
-  } else {
+  if (($status_over_all//'Ok') ne 'Failed') {
     my $inxst = $self->{INDEX_STATUS};
     if ($inxst && ref $inxst && %$inxst) {
-      my $Lstatus = 0;
-      my $intro_written;
-      for my $p (sort {
-          $inxst->{$b}{status} <=> $inxst->{$a}{status}
-            or
-          $a cmp $b
-        } keys %$inxst) {
-        my $status = $inxst->{$p}{status};
-        unless (defined $status_over_all) {
-          if ($status) {
-            if ($status > PAUSE::mldistwatch::Constants::OK) {
-              $status_over_all =
-              PAUSE::mldistwatch::Constants::heading($status)
-              || "UNKNOWN (status=$status)";
-            } else {
-              $status_over_all = "OK";
-            }
-          } else {
-            $status_over_all = "Unknown";
-          }
-          push @m, "Status of this distro: $status_over_all\n";
-          push @m, "="x(length($status_over_all)+23), "\n\n";
-        }
-        unless ($intro_written++) {
-          push @m, qq{\nThe following packages (grouped by }.
-          qq{status) have been found in the distro:\n\n};
-        }
-        if ($status != $Lstatus) {
-          my $heading =
-          PAUSE::mldistwatch::Constants::heading($status) ||
-          "UNKNOWN (status=$status)";
-          push @m, sprintf "Status: %s\n%s\n\n", $heading, "="x(length($heading)+8);
-        }
-        my $tf14 = Text::Format->new(
-          bodyIndent  => 14,
-          firstIndent => 14,
-        );
-        my $verb_status = $tf14->format($inxst->{$p}{verb_status});
-        $verb_status =~ s/^\s+//; # otherwise this line is too long
-        # magic words, see also report02() around line 573, same wording there,
-        # exception prompted by JOESUF/libapreq2-2.12.tar.gz
-        $inxst->{$p}{infile} ||= "missing in META.yml, tolerated by PAUSE indexer";
-        push @m, sprintf("     package: %s\n",  $p);
-
-        if (my @warnings = $ctx->warnings_for_package($p)) {
-          push @m, map {;
-                 sprintf("     WARNING: %s\n", $_->{text}) } @warnings;
-        }
-
-        push @m, sprintf("     version: %s\n", $inxst->{$p}{version});
-        push @m, sprintf("     in file: %s\n", $inxst->{$p}{infile});
-        push @m, sprintf("     status : %s\n",  $verb_status);
+      $self->_update_mail_content_when_things_were_indexed(
+        $ctx,
+        $inxst,
+        \@m,
+        \$status_over_all,
+      );
 
-        $Lstatus = $status;
-      }
     } else {
       $Logger->log([ "index status: %s", $inxst ]);
 
-      if ($pmfiles > 0 || $self->{REASON_TO_SKIP}) {
-        if ($self->{REASON_TO_SKIP} == PAUSE::mldistwatch::Constants::E_DB_XACTFAIL) {
-          push @m,  qq{This distribution was not indexed due to database\n}
-                 .  qq{errors.  You can request another indexing attempt be\n}
-                 .  qq{made by logging into https://pause.perl.org/\n\n};
+      # No files have status, no dist-wide errors.  Nothing to report!
+      return unless $pmfiles || $ctx->dist_errors;
 
-          $status_over_all = "Failed";
-        } elsif ($self->{REASON_TO_SKIP} == PAUSE::mldistwatch::Constants::ENOMETAFILE) {
-          push @m,  qq{This distribution was not indexed because it did not\n}
-                 .  qq{contain a META.yml or META.json file.\n\n};
+      $self->_update_mail_content_when_nothing_was_indexed(
+        $ctx,
+        $inxst,
+        \@m,
+        \$status_over_all,
+      );
+    }
+  }
 
-          $status_over_all = "Failed";
-        } elsif ($self->{REASON_TO_SKIP}) {
-          # The reason we skipped this dist is already at the top of the
-          # report.  Don't tack on a guess.
-        } elsif ($self->version_from_meta_ok($ctx)) {
+  push @m, qq{__END__\n};
 
-          push @m,  qq{Nothing in this distro has been \n}
-                 .  qq{indexed, because according to META.yml this\n}
-                 .  qq{package does not provide any modules.\n\n};
+  $self->_send_email(\@m, $status_over_all);
+  return;
+}
 
-          $status_over_all = "Empty_provides";
+sub _send_email {
+    my ($self, $lines, $status_over_all) = @_;
 
-        } else {
+    if ($PAUSE::Config->{TESTHOST} || $self->hub->{OPT}{testhost}) {
+      if ($self->hub->{PICK}) {
+        local $"="";
+        warn "Unsent Report [@$lines]";
+      }
 
-          push @m,  qq{No or no indexable package statements could be found\n}
-                 .  qq{in the distro (maybe a script or documentation\n}
-                 .  qq{distribution or a developer release?)\n\n};
+      return;
+    }
 
-          $status_over_all = "Empty_no_pm";
+    my $author = $self->{USERID};
+    my $distro = $self->{DIST};
 
-        }
-      } else {
-        # no need to write a report at all
-        return;
-      }
+    my $substrdistro = substr $distro, 5;
 
-    }
-  }
-  push @m, qq{__END__\n};
-  my $pma = PAUSE::MailAddress->new_from_userid($author);
-  if ($PAUSE::Config->{TESTHOST} || $self->hub->{OPT}{testhost}) {
-    if ($self->hub->{PICK}) {
-      local $"="";
-      warn "Unsent Report [@m]";
-    }
-  } else {
+    my $pma = PAUSE::MailAddress->new_from_userid($author);
     my $to = sprintf "%s, %s", $pma->address, $PAUSE::Config->{ADMIN};
     my $failed = "";
+
     if ($status_over_all ne "OK") {
       $failed = "Failed: ";
     }
@@ -625,13 +556,12 @@ sub mail_summary {
           content_type => 'text/plain',
           encoding     => 'quoted-printable',
         },
-        body_str => join( ($, // q{}) , @m),
+        body_str => join(q{}, @$lines),
     );
 
     sendmail($email);
 
     $Logger->log("sent indexer report email");
-  }
 }
 
 sub index_status {
@@ -671,7 +601,7 @@ sub check_blib {
   my ($self, $ctx) = @_;
   if (grep m|^[^/]+/blib/|, @{$self->{MANIFOUND}}) {
     $self->{HAS_BLIB}++;
-    return;
+    $ctx->abort_indexing(ERROR('blib'));
   }
   # sometimes they package their stuff deep inside a hierarchy
   my @found = @{$self->{MANIFOUND}};
@@ -696,6 +626,7 @@ sub check_blib {
     # more than one entry in this directory means final check
     if (grep m|^blib/|, @found) {
       $self->{HAS_BLIB}++;
+      $ctx->abort_indexing(ERROR('blib'));
     }
     last DIRDOWN;
   }
@@ -706,8 +637,8 @@ sub check_multiple_root {
   my %seen;
   my @top = grep { s|/.*||; !$seen{$_}++ } map { $_ } @{$self->{MANIFOUND}};
   if (@top > 1) {
-    $Logger->log([ "archive has multiple roots: %s", [ sort @top ] ]);
     $self->{HAS_MULTIPLE_ROOT} = \@top;
+    $ctx->abort_indexing(ERROR('multiroot'));
   } else {
     $self->{DISTROOT} = $top[0];
   }
@@ -725,43 +656,12 @@ sub check_world_writable {
     $Ldirs = $dirs;
   }
   my @ww = grep {my @stat = stat $_; $stat[2] & 2} @dirs, @files;
-  if (@ww) {
-    # XXX todo: set a variable if we could successfully build the
-    # new tarball and make it visible for debugging and later
-    # visible for the user
-
-    # we are now in temp dir and in front of us is
-    # $self->{DISTROOT}, e.g. 'Tk-Wizard-2.142' (the directory, not necessarily the significant part of the distro name)
-    my @wwfixingerrors;
-    for my $wwf (@ww) {
-      my @stat = stat $wwf;
-      unless (chmod $stat[2] &~ 0022, $wwf) {
-        push @wwfixingerrors, "error during 'chmod $stat[2] &~ 0022, $wwf': $!";
-      }
-    }
-    my $fixedfile = "$self->{DISTROOT}-withoutworldwriteables.tar.gz";
-    my $todir = File::Basename::dirname($self->{DIST}); # M/MA/MAKAROW
-    my $to_abs = $self->hub->{MLROOT} . "/$todir/$fixedfile";
-    if (! length $self->{DISTROOT}) {
-      push @wwfixingerrors, "Alert: \$self->{DISTROOT} is empty, cannot fix";
-    } elsif ($self->{DIST} =~ /-withoutworldwriteables/) {
-      push @wwfixingerrors, "Sanity check failed: incoming file '$self->{DIST}' already has '-withoutworldwriteables' in the name";
-    } elsif (-e $to_abs) {
-      push @wwfixingerrors, "File '$to_abs' already exists, won't overwrite";
-    } elsif (0 != system (tar => "czf",
-        $to_abs,
-        $self->{DISTROOT}
-      )) {
-      push @wwfixingerrors, "error during 'tar ...': $!";
-    }
-    $Logger->log([ "archive has world writable files: %s", [ sort @ww ] ]);
-    $self->{HAS_WORLD_WRITABLE} = \@ww;
-    if (@wwfixingerrors) {
-      $self->{HAS_WORLD_WRITABLE_FIXINGERRORS} = \@wwfixingerrors;
-    } else {
-      $self->{HAS_WORLD_WRITABLE_FIXEDFILE} = $fixedfile;
-    }
-  }
+
+  return unless @ww;
+
+  $Logger->log([ "archive has world writable files: %s", [ sort @ww ] ]);
+  $self->{HAS_WORLD_WRITABLE} = \@ww;
+  $ctx->abort_indexing(ERROR('worldwritable'));
 }
 
 sub filter_pms {
@@ -915,9 +815,6 @@ sub _index_by_meta {
 
 sub examine_pms {
   my ($self, $ctx) = @_;
-  return if $self->{HAS_BLIB};
-  return if $self->{HAS_MULTIPLE_ROOT};
-  return if $self->{HAS_WORLD_WRITABLE};
 
   # XXX not yet reached, we need to re-examine what happens without SKIP.
   # Currently SKIP shadows the event of could_not_untar
@@ -1041,9 +938,7 @@ sub extract_readme_and_meta {
 
   unless ($json || $yaml) {
     $self->{METAFILE} = "No META.yml or META.json found";
-    $self->{SKIP}     = 1;
-    $self->{REASON_TO_SKIP} = PAUSE::mldistwatch::Constants::ENOMETAFILE;
-    $Logger->log("no META.yml or META.json found");
+    $ctx->abort_indexing(ERROR('no_meta'));
     return;
   }
 
@@ -1090,10 +985,14 @@ sub check_indexability {
         return;
     }
 
+    $Logger->log([
+      "release status: %s",
+      $self->{META_CONTENT}{release_status},
+    ]);
+
     if (($self->{META_CONTENT}{release_status} // 'stable') ne 'stable') {
         # META.json / META.yml declares it's not stable; do not index!
-        $self->{SKIP} = 1;
-        $self->{REASON_TO_SKIP} = PAUSE::mldistwatch::Constants::EMETAUNSTABLE;
+        $ctx->abort_indexing(ERROR('unstable_release'));
         return;
     }
 
@@ -1101,9 +1000,8 @@ sub check_indexability {
         # "provides" is the "I know what I'm doing better than the indexer"
         # control.  When it's wrong, just abort the whole dist.
         $Logger->log([ "META provides has malformed package names: %s", \@bad_names ]);
-        $self->{SKIP} = 1;
-        $self->{REASON_TO_SKIP} = PAUSE::mldistwatch::Constants::EBADPROVIDES;
-        return;
+        $self->{MALFORMED_PROVIDES} = \@bad_names;
+        $ctx->abort_indexing(ERROR('bad_provides'));
     }
 }
 
diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index 650126b80..63e455ac7 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -40,6 +40,7 @@ use PAUSE::pmfile ();
 use PAUSE::package ();
 use PAUSE::mldistwatch::Constants ();
 use PAUSE::Indexer::Context;
+use PAUSE::Indexer::Errors;
 use PAUSE::MailAddress ();
 use PAUSE::PermsManager ();
 use Process::Status ();
@@ -383,7 +384,7 @@ sub _do_the_database_work {
       $dbh->commit;
     } else {
       $ctx->alert("Uploading user has no permissions on package $main_pkg");
-      $dio->{NO_DISTNAME_PERMISSION} = 1;
+      $ctx->add_dist_error(ERROR('no_distname_permission'));
       $dbh->rollback;
     }
 
@@ -484,16 +485,22 @@ sub maybe_index_dist {
       check_multiple_root
       check_world_writable
     )) {
-      $dio->$method($ctx);
-      if ($dio->skip) {
-          delete $self->{ALLlasttime}{$dist};
-          delete $self->{ALLfound}{$dist};
+        my $ok    = eval { $dio->$method($ctx); 1; };
+        my $abort = $@;
+        if (!$ok) {
+            if (! $abort->isa('PAUSE::Indexer::Abort')) {
+                die $abort; # Rethrow unexpected exception
+            }
 
-          if ($dio->{REASON_TO_SKIP}) {
-              $dio->mail_summary($ctx);
-          }
-          return;
-      }
+            delete $self->{ALLlasttime}{$dist};
+            delete $self->{ALLfound}{$dist};
+
+            if ($abort->public) {
+                $dio->mail_summary($ctx);
+            }
+
+            return;
+        }
     }
 
     for my $attempt (1 .. 3) {
@@ -503,7 +510,7 @@ sub maybe_index_dist {
       if ($attempt == 3) {
         $Logger->log_debug("tried $attempt times to do db work, but all failed");
         $ctx->alert("database errors while indexing");
-        $dio->{REASON_TO_SKIP} = PAUSE::mldistwatch::Constants::E_DB_XACTFAIL;
+        $ctx->add_dist_error(ERROR('xact_fail'));
       }
     }
 
diff --git a/lib/PAUSE/mldistwatch/Constants.pm b/lib/PAUSE/mldistwatch/Constants.pm
index 4be13a3cd..53fc0b4e8 100644
--- a/lib/PAUSE/mldistwatch/Constants.pm
+++ b/lib/PAUSE/mldistwatch/Constants.pm
@@ -12,7 +12,6 @@ use constant EOPENFILE => 21;
 use constant EMISSPERM => 20;
 use constant ELONGVERSION => 13;
 use constant EBADVERSION => 12;
-use constant EBADPROVIDES => 11;
 use constant EPARSEVERSION => 10;
 use constant ENOMETAFILE => 8;
 use constant E_DB_XACTFAIL => 7;
@@ -39,7 +38,6 @@ our $heading = {
   EOLDRELEASE() => "Release seems outdated",
   EOPENFILE() => "Problem while reading the distribtion",
   EMETAUNSTABLE() => "META release_status is not stable, will not index",
-  EBADPROVIDES() => "META provides includes a malformed package name",
   EPARSEVERSION() => "Version parsing problem",
   EVERFALLING() => "Decreasing version number",
   OK() => "Successfully indexed",
diff --git a/t/mldistwatch-big.t b/t/mldistwatch-big.t
index 81ebaf97d..b504dc316 100644
--- a/t/mldistwatch-big.t
+++ b/t/mldistwatch-big.t
@@ -139,25 +139,7 @@ subtest "require permission on main module" => sub {
           sub {
             like(
               $_[0]->{email}->as_string,
-              qr/for\s+the\s+package\s+XFR/,
-              "email looks right",
-            );
-          },
-          sub {
-            like(
-              $_[0]->{email}->as_string,
-              qr/You\s+appear.*\.pm\s+file.*dist\s+name\s+\(XFR\)/s,
-              "email looks right",
-            );
-          },
-          sub {
-            like(
-              $_[0]->{email}->as_string,
-                qr/
-                  \s+the\s+other\s+way\s+round
-                  .+
-                  XForm-Rollout-\.\.\.
-                  /xs,
+              qr/package\s+would\s+be\s+called\s+XFR/,
               "email looks right",
             );
           },
diff --git a/t/mldistwatch-misc.t b/t/mldistwatch-misc.t
index 4a7cfad78..862e50a43 100644
--- a/t/mldistwatch-misc.t
+++ b/t/mldistwatch-misc.t
@@ -554,7 +554,7 @@ subtest "do not index dists without META file" => sub {
   my $nometa = sub {
     like(
       $_[0]{email}->object->body_str,
-      qr/\QDistribution included neither META.json nor META.yml/,
+      qr/\Qno META.yml or META.json found/,
       "email contains ENOMETAFILE string",
     );
   };

From fc660404fbcc89665195c6bcce89a09495eb0b20 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 29 Apr 2023 21:26:38 +0200
Subject: [PATCH 08/49] indexer constants: remove a bunch of dead constants

---
 lib/PAUSE/mldistwatch/Constants.pm | 36 +++++++++---------------------
 1 file changed, 11 insertions(+), 25 deletions(-)

diff --git a/lib/PAUSE/mldistwatch/Constants.pm b/lib/PAUSE/mldistwatch/Constants.pm
index 53fc0b4e8..0b3ad504f 100644
--- a/lib/PAUSE/mldistwatch/Constants.pm
+++ b/lib/PAUSE/mldistwatch/Constants.pm
@@ -5,7 +5,6 @@ package PAUSE::mldistwatch::Constants;
 # constants used for index_status:
 use constant EDUALOLDER => 50; # pumpkings only
 use constant EDUALYOUNGER => 30; # pumpkings only
-use constant EDISTNAMEPERM => 26;
 use constant EDBERR => 25;
 use constant EDBCONFLICT => 23;
 use constant EOPENFILE => 21;
@@ -13,34 +12,23 @@ use constant EMISSPERM => 20;
 use constant ELONGVERSION => 13;
 use constant EBADVERSION => 12;
 use constant EPARSEVERSION => 10;
-use constant ENOMETAFILE => 8;
-use constant E_DB_XACTFAIL => 7;
-use constant EMETAUNSTABLE => 6;
-use constant EBAREPMFILE => 5;
 use constant EOLDRELEASE => 4;
-use constant EMTIMEFALLING => 3; # deprecated after rev 478
 use constant EVERFALLING => 2;
 use constant OK => 1;
 
 our $heading = {
-  EBADVERSION() => "Version string is not a valid 'lax version' string",
-  ELONGVERSION() => "Version string exceeds maximum allowed length of 16b",
-  E_DB_XACTFAIL() => "ERROR: Database error occurred during index update",
-  EBAREPMFILE() => "Bare .pm files are not indexed",
-  EDBCONFLICT() => "Conflicting record found in index",
-  EDBERR() => "Database error",
-  EDUALOLDER() => "An older dual-life module stays reference",
-  EDUALYOUNGER() => "Dual-life module stays reference",
-  EDISTNAMEPERM() => "No permissions for distribution name",
-  EMISSPERM() => "Permission missing",
-  EMTIMEFALLING() => "Decreasing mtime on a file (category to be deprecated)",
-  ENOMETAFILE() => "Distribution included neither META.json nor META.yml",
-  EOLDRELEASE() => "Release seems outdated",
-  EOPENFILE() => "Problem while reading the distribtion",
-  EMETAUNSTABLE() => "META release_status is not stable, will not index",
+  EBADVERSION()   => "Version string is not a valid 'lax version' string",
+  ELONGVERSION()  => "Version string exceeds maximum allowed length of 16b",
+  EDBCONFLICT()   => "Conflicting record found in index",
+  EDBERR()        => "Database error",
+  EDUALOLDER()    => "An older dual-life module stays reference",
+  EDUALYOUNGER()  => "Dual-life module stays reference",
+  EMISSPERM()     => "Permission missing",
+  EOLDRELEASE()   => "Release seems outdated",
+  EOPENFILE()     => "Problem while reading the distribtion",
   EPARSEVERSION() => "Version parsing problem",
-  EVERFALLING() => "Decreasing version number",
-  OK() => "Successfully indexed",
+  EVERFALLING()   => "Decreasing version number",
+  OK()            => "Successfully indexed",
 };
 
 sub heading ($) {
@@ -50,5 +38,3 @@ sub heading ($) {
 }
 
 1;
-
-

From 14d78d973444b393a1314efe34875b3177a8c817 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 12:19:07 +0200
Subject: [PATCH 09/49] indexer context: call a method instead of copypasting

---
 lib/PAUSE/Indexer/Context.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/PAUSE/Indexer/Context.pm b/lib/PAUSE/Indexer/Context.pm
index 724584a29..ecdd5d667 100644
--- a/lib/PAUSE/Indexer/Context.pm
+++ b/lib/PAUSE/Indexer/Context.pm
@@ -40,7 +40,7 @@ sub warnings_for_package {
   my ($self, $package_name) = @_;
 
   return grep {; $_->{package} eq $package_name }
-         map  {; @$_ } values $self->_package_warnings->%*;
+         $self->warnings_for_all_packages;
 }
 
 has alerts => (

From 8b9643fd4163f2d443b9a32c395f40c889732c46 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 12:21:26 +0200
Subject: [PATCH 10/49] indexer: improve the no_distname_permissions error

...by bringing back text I had deleted.
---
 lib/PAUSE/Indexer/Errors.pm | 12 +++++++-----
 t/mldistwatch-big.t         |  2 +-
 2 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index 3669569d8..aa08f509d 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -59,11 +59,13 @@ public_error no_distname_permission => {
     my $pkg = $dist->_package_governing_permission;
 
     return <<~"EOF"
-      You appear to be missing a .pm file containing a package matching the
-      dist name.  For this distribution, that package would be called $pkg.
-      Adding this may solve your issue. Or maybe it is the other way round and
-      a different distribution name could be chosen, matching a package you are
-      shipping.
+      This distribution name will only be indexed when uploaded by users with
+      permission for the package $pkg.  Either someone else has ownership over
+      that package name, or this is a brand new distribution and that package
+      name was neither listed in the 'provides' field in the META file nor
+      found inside the distribution's modules.  Therefore, no modules will be
+      indexed.  Adding a package called $pkg may solve your issue, or instead
+      you may wish to change the name of your distribution.
       EOF
   },
 };
diff --git a/t/mldistwatch-big.t b/t/mldistwatch-big.t
index b504dc316..5d5f17d69 100644
--- a/t/mldistwatch-big.t
+++ b/t/mldistwatch-big.t
@@ -139,7 +139,7 @@ subtest "require permission on main module" => sub {
           sub {
             like(
               $_[0]->{email}->as_string,
-              qr/package\s+would\s+be\s+called\s+XFR/,
+              qr/adding\s+a\s+package\s+called\s+XFR/i,
               "email looks right",
             );
           },

From 866401dca9136d15ea16b328e34381f897f9e9a8 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 12:35:38 +0200
Subject: [PATCH 11/49] indexer: restructure the try/catch for dist indexing

This should be functionally the same, but a bit easier to read and
reason about.
---
 lib/PAUSE/mldistwatch.pm | 40 +++++++++++++++++++---------------------
 1 file changed, 19 insertions(+), 21 deletions(-)

diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index 63e455ac7..e56ecc94e 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -476,31 +476,29 @@ sub maybe_index_dist {
         }
     }
 
-    for my $method (qw(
-      examine_dist
-      read_dist
-      extract_readme_and_meta
-      check_indexability
-      check_blib
-      check_multiple_root
-      check_world_writable
-    )) {
-        my $ok    = eval { $dio->$method($ctx); 1; };
-        my $abort = $@;
-        if (!$ok) {
-            if (! $abort->isa('PAUSE::Indexer::Abort')) {
-                die $abort; # Rethrow unexpected exception
-            }
+    my $examine_dist_ok = eval {
+        $dio->examine_dist($ctx);
+        $dio->read_dist($ctx);
+        $dio->extract_readme_and_meta($ctx);
+        $dio->check_indexability($ctx);
+        $dio->check_blib($ctx);
+        $dio->check_multiple_root($ctx);
+        $dio->check_world_writable($ctx);
+        1;
+    };
 
-            delete $self->{ALLlasttime}{$dist};
-            delete $self->{ALLfound}{$dist};
+    unless ($examine_dist_ok) {
+        my $abort = $@;
+        die $abort unless $abort->isa('PAUSE::Indexer::Abort');
 
-            if ($abort->public) {
-                $dio->mail_summary($ctx);
-            }
+        delete $self->{ALLlasttime}{$dist};
+        delete $self->{ALLfound}{$dist};
 
-            return;
+        if ($abort->public) {
+            $dio->mail_summary($ctx);
         }
+
+        return;
     }
 
     for my $attempt (1 .. 3) {

From 97720dcb4b3dada308db632d83e0d4f8fcd9fc51 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 12:50:52 +0200
Subject: [PATCH 12/49] indexer: drop old warning code, use the new code

---
 lib/PAUSE/dist.pm | 23 +++--------------------
 1 file changed, 3 insertions(+), 20 deletions(-)

diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 89106e087..3eafbfc59 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -430,7 +430,9 @@ sub mail_summary {
     "The following report has been written by the PAUSE namespace indexer.\n",
     "Please contact modules\@perl.org if there are any open questions.\n";
 
-  if ($self->has_indexing_warnings($ctx)) {
+  if ($ctx->warnings_for_all_packages) {
+    # If there were any warnings, put in a note to the reader that they should
+    # look for them.
     push @m,
       "\nWARNING:  Some irregularities were found while indexing your\n",
         "          distribution.  See below for more details.\n";
@@ -575,19 +577,6 @@ sub index_status {
   };
 }
 
-sub indexing_warnings_for_package {
-  my ($self, $ctx, $pack) = @_;
-  return @{ $self->{INDEX_WARNINGS}{$pack} // [] };
-}
-
-sub has_indexing_warnings {
-  my ($self, $ctx) = @_;
-  my $i;
-  my $warnings = $self->{INDEX_WARNINGS};
-
-  @$_ && return 1 for values %$warnings;
-}
-
 sub malformed_provides_names {
   my ($self) = @_;
 
@@ -1311,12 +1300,6 @@ Accessor method. True if perl distro from non-pumpking or a dev release.
 
 =head3 index_status
 
-=head3 add_indexing_warning
-
-=head3 indexing_warnings_for_package
-
-=head3 has_indexing_warnings
-
 =head3 _package_governing_permission
 
 The package used to determine whether the uploader may upload this distro.

From 2bc7dbb2fd5bb1c799ea4b96f8bfa6b8701474fd Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 16:22:04 +0200
Subject: [PATCH 13/49] no_index rules: simplify code while refactoring

---
 lib/PAUSE/pmfile.pm | 72 +++++++++++++++++++++------------------------
 1 file changed, 34 insertions(+), 38 deletions(-)

diff --git a/lib/PAUSE/pmfile.pm b/lib/PAUSE/pmfile.pm
index b523fcf04..8e3124110 100644
--- a/lib/PAUSE/pmfile.pm
+++ b/lib/PAUSE/pmfile.pm
@@ -47,52 +47,48 @@ sub mlroot {
 
 # package PAUSE::pmfile;
 sub filter_ppps {
-    my($self,@ppps) = @_;
+    my($self, @package_names) = @_;
     my @res;
 
+    # the name "private" is there for backwards compatibility
+    my $no_index = $self->{META_CONTENT} &&
+        ($self->{META_CONTENT}{no_index} || $self->{META_CONTENT}{private});
+
+    unless ($no_index && ref $no_index eq 'HASH') {
+        # There's no no_index directive, or it's bogus.  We'll keep every
+        # package!
+        return @package_names;
+    }
+
     # very similar code is in PAUSE::dist::filter_pms
-  MANI: for my $ppp ( @ppps ) {
-        if ($self->{META_CONTENT}){
-            my $no_index = $self->{META_CONTENT}{no_index}
-                            || $self->{META_CONTENT}{private}; # backward compat
-            if (ref($no_index) eq 'HASH') {
-                my %map = (
-                            package => qr{\z},
-                            namespace => qr{::},
-                          );
-                for my $k (qw(package namespace)) {
-                    next unless my $v = $no_index->{$k};
-                    my $rest = $map{$k};
-                    if (ref $v eq "ARRAY") {
-                        for my $ve (@$v) {
-                            $ve =~ s|::$||;
-                            if ($ppp =~ /^$ve$rest/){
-                                $Logger->log("no_index rule on $k $ve; skipping $ppp");
-                                next MANI;
-                            } else {
-                                $Logger->log_debug("no_index rule on $k $ve; NOT skipping $ppp");
-                            }
-                        }
-                    } else {
-                        $v =~ s|::$||;
-                        if ($ppp =~ /^$v$rest/){
-                            $Logger->log("no_index rule on $k $v; skipping $ppp");
-                            next MANI;
-                        } else {
-                            $Logger->log_debug("no_index rule on $k $v; NOT skipping $ppp");
-                        }
-                    }
+    PACKAGE: for my $pkg ( @package_names ) {
+        my %map = (
+          package   => qr{\z},
+          namespace => qr{::},
+        );
+
+        TYPE: for my $type (qw(package namespace)) {
+            next TYPE unless my $rules = $no_index->{$type};
+
+            my $rest = $map{$type};
+            $rules = [$rules] unless ref $rules;
+
+            for my $rule (@$rules) {
+                $rule =~ s|::$||;
+
+                if ($pkg =~ /^\Q$rule\E$rest/) {
+                    $Logger->log("no_index rule on $type $rule; skipping $pkg");
+                    next PACKAGE;
+                } else {
+                    $Logger->log_debug("no_index rule on $type $rule; NOT skipping $pkg");
                 }
-            } else {
-                $Logger->log_debug("no no_index or private in META_CONTENT");
             }
-        } else {
-            # $Logger->log("no META_CONTENT"); # too noisy
+
+            push @res, $pkg;
         }
-        push @res, $ppp;
     }
 
-    @res;
+    return @res;
 }
 
 # package PAUSE::pmfile;

From a46c0cc35c24a249980a34664dbe043b5c638035 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 17:08:19 +0200
Subject: [PATCH 14/49] indexer: turn Abort into Abort::Dist

This is in preparation for using Abort::Package to abort packge indexing.
---
 lib/PAUSE/Indexer/{Abort.pm => Abort/Dist.pm} |  2 +-
 lib/PAUSE/Indexer/Abort/Package.pm            | 16 +++++++++++++
 lib/PAUSE/Indexer/Context.pm                  |  7 +++---
 lib/PAUSE/dist.pm                             | 24 +++++++++----------
 lib/PAUSE/mldistwatch.pm                      |  2 +-
 5 files changed, 34 insertions(+), 17 deletions(-)
 rename lib/PAUSE/Indexer/{Abort.pm => Abort/Dist.pm} (79%)
 create mode 100644 lib/PAUSE/Indexer/Abort/Package.pm

diff --git a/lib/PAUSE/Indexer/Abort.pm b/lib/PAUSE/Indexer/Abort/Dist.pm
similarity index 79%
rename from lib/PAUSE/Indexer/Abort.pm
rename to lib/PAUSE/Indexer/Abort/Dist.pm
index e9660ad31..830312ae6 100644
--- a/lib/PAUSE/Indexer/Abort.pm
+++ b/lib/PAUSE/Indexer/Abort/Dist.pm
@@ -1,4 +1,4 @@
-package PAUSE::Indexer::Abort;
+package PAUSE::Indexer::Abort::Dist;
 use v5.12.0;
 use Moo;
 
diff --git a/lib/PAUSE/Indexer/Abort/Package.pm b/lib/PAUSE/Indexer/Abort/Package.pm
new file mode 100644
index 000000000..f3401693d
--- /dev/null
+++ b/lib/PAUSE/Indexer/Abort/Package.pm
@@ -0,0 +1,16 @@
+package PAUSE::Indexer::Abort::Package;
+use v5.12.0;
+use Moo;
+
+has public => (
+  is      => 'ro',
+  default => 0,
+);
+
+has message => (
+  is => 'ro',
+  required => 1,
+);
+
+no Moo;
+1;
diff --git a/lib/PAUSE/Indexer/Context.pm b/lib/PAUSE/Indexer/Context.pm
index ecdd5d667..34c4fe6dd 100644
--- a/lib/PAUSE/Indexer/Context.pm
+++ b/lib/PAUSE/Indexer/Context.pm
@@ -2,7 +2,8 @@ package PAUSE::Indexer::Context;
 use v5.12.0;
 use Moo;
 
-use PAUSE::Indexer::Abort;
+use PAUSE::Indexer::Abort::Dist;
+use PAUSE::Indexer::Abort::Package;
 use PAUSE::Indexer::Errors;
 use PAUSE::Logger '$Logger';
 
@@ -84,12 +85,12 @@ sub dist_errors {
   return $self->_dist_errors->@*;
 }
 
-sub abort_indexing {
+sub abort_indexing_dist {
   my ($self, $error) = @_;
 
   $error = $self->add_dist_error($error);
 
-  die PAUSE::Indexer::Abort->new({
+  die PAUSE::Indexer::Abort::Dist->new({
     message => $error->{message},
     public  => $error->{public},
   });
diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 3eafbfc59..837cdcb01 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -283,7 +283,7 @@ sub examine_dist {
     $self->{SUFFIX} = $suffix;
 
     if ($skip) {
-      $ctx->abort_indexing("won't process regular perl upload");
+      $ctx->abort_indexing_dist("won't process regular perl upload");
     }
 
     return;
@@ -291,22 +291,22 @@ sub examine_dist {
 
   if ($self->isa_dev_version) {
     $self->{SUFFIX} = "N/A";
-    $ctx->abort_indexing("dist is a developer release");
+    $ctx->abort_indexing_dist("dist is a developer release");
   }
 
   if ($dist =~ m|/perl-\d+|) {
     $self->{SUFFIX} = "N/A";
-    $ctx->abort_indexing("dist is an unofficial perl-like release");
+    $ctx->abort_indexing_dist("dist is an unofficial perl-like release");
   }
 
   if ($dist =~ $SUFFQR) {
     $self->{SUFFIX} = $1;
     unless ($self->untar($ctx)) {
-      $ctx->abort_indexing("can't untar archive");
+      $ctx->abort_indexing_dist("can't untar archive");
     }
   } elsif ($dist =~ /\.pm\.(?:Z|gz|bz2)$/) {
     $self->{SUFFIX} = "N/A";
-    $ctx->abort_indexing(ERROR('single_pm'));
+    $ctx->abort_indexing_dist(ERROR('single_pm'));
   } elsif ($dist =~ /\.zip$/) {
     $self->{SUFFIX} = "zip";
     my $unzipbin = $self->hub->{UNZIPBIN};
@@ -321,7 +321,7 @@ sub examine_dist {
       # system("$unzipbin -t $MLROOT/$dist");
     }
   } else {
-    $ctx->abort_indexing("file does not appear to be a CPAN distribution");
+    $ctx->abort_indexing_dist("file does not appear to be a CPAN distribution");
   }
 
   return;
@@ -590,7 +590,7 @@ sub check_blib {
   my ($self, $ctx) = @_;
   if (grep m|^[^/]+/blib/|, @{$self->{MANIFOUND}}) {
     $self->{HAS_BLIB}++;
-    $ctx->abort_indexing(ERROR('blib'));
+    $ctx->abort_indexing_dist(ERROR('blib'));
   }
   # sometimes they package their stuff deep inside a hierarchy
   my @found = @{$self->{MANIFOUND}};
@@ -615,7 +615,7 @@ sub check_blib {
     # more than one entry in this directory means final check
     if (grep m|^blib/|, @found) {
       $self->{HAS_BLIB}++;
-      $ctx->abort_indexing(ERROR('blib'));
+      $ctx->abort_indexing_dist(ERROR('blib'));
     }
     last DIRDOWN;
   }
@@ -627,7 +627,7 @@ sub check_multiple_root {
   my @top = grep { s|/.*||; !$seen{$_}++ } map { $_ } @{$self->{MANIFOUND}};
   if (@top > 1) {
     $self->{HAS_MULTIPLE_ROOT} = \@top;
-    $ctx->abort_indexing(ERROR('multiroot'));
+    $ctx->abort_indexing_dist(ERROR('multiroot'));
   } else {
     $self->{DISTROOT} = $top[0];
   }
@@ -650,7 +650,7 @@ sub check_world_writable {
 
   $Logger->log([ "archive has world writable files: %s", [ sort @ww ] ]);
   $self->{HAS_WORLD_WRITABLE} = \@ww;
-  $ctx->abort_indexing(ERROR('worldwritable'));
+  $ctx->abort_indexing_dist(ERROR('worldwritable'));
 }
 
 sub filter_pms {
@@ -927,7 +927,7 @@ sub extract_readme_and_meta {
 
   unless ($json || $yaml) {
     $self->{METAFILE} = "No META.yml or META.json found";
-    $ctx->abort_indexing(ERROR('no_meta'));
+    $ctx->abort_indexing_dist(ERROR('no_meta'));
     return;
   }
 
@@ -981,7 +981,7 @@ sub check_indexability {
 
     if (($self->{META_CONTENT}{release_status} // 'stable') ne 'stable') {
         # META.json / META.yml declares it's not stable; do not index!
-        $ctx->abort_indexing(ERROR('unstable_release'));
+        $ctx->abort_indexing_dist(ERROR('unstable_release'));
         return;
     }
 
diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index e56ecc94e..58d57ab97 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -489,7 +489,7 @@ sub maybe_index_dist {
 
     unless ($examine_dist_ok) {
         my $abort = $@;
-        die $abort unless $abort->isa('PAUSE::Indexer::Abort');
+        die $abort unless $abort->isa('PAUSE::Indexer::Abort::Dist');
 
         delete $self->{ALLlasttime}{$dist};
         delete $self->{ALLfound}{$dist};

From 31295bf0f6d590796aab861d3e88b1a8d71e2486 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 17:13:42 +0200
Subject: [PATCH 15/49] indexer: gather packages, then index them

This is a simple refactoring, where we pile up the PAUSE::package
objects and then loop over them to index.  The point of this change is
to give us a very small piece of code around which to build the
eval/next loop that catches Abort::Package exceptions.
---
 lib/PAUSE/dist.pm   | 10 ++++++++--
 lib/PAUSE/pmfile.pm | 44 +++++++++++++++++++++++++-------------------
 2 files changed, 33 insertions(+), 21 deletions(-)

diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 837cdcb01..8d82bbec9 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -757,8 +757,9 @@ sub _index_by_meta {
 
   my $main_package = $self->_package_governing_permission;
 
-  my @packages =  map {[ $_ => $provides->{$_ }]} sort keys %$provides;
-  PACKAGE: for (@packages) {
+  my @packages;
+  my @package_names =  map {[ $_ => $provides->{$_ }]} sort keys %$provides;
+  PACKAGE: for (@package_names) {
     my ( $k, $v ) = @$_;
 
     unless (ref $v and length $v->{file}) {
@@ -798,6 +799,11 @@ sub _index_by_meta {
       META_CONTENT => $self->{META_CONTENT},
       MAIN_PACKAGE => $main_package,
     );
+
+    push @packages, $pio;
+  }
+
+  for my $pio (@packages) {
     $pio->examine_pkg($ctx);
   }
 }
diff --git a/lib/PAUSE/pmfile.pm b/lib/PAUSE/pmfile.pm
index 8e3124110..4703b2070 100644
--- a/lib/PAUSE/pmfile.pm
+++ b/lib/PAUSE/pmfile.pm
@@ -136,38 +136,44 @@ sub examine_fio {
         }
     }
 
-    my($ppp) = $self->packages_per_pmfile($ctx);
-    my @keys_ppp = $self->filter_ppps(sort keys %$ppp);
+    my ($ppp) = $self->packages_per_pmfile($ctx);
+    my @package_names = $self->filter_ppps(sort keys %$ppp);
 
-    $Logger->log([ "will examine packages: %s", \@keys_ppp ]);
+    unless (@package_names) {
+        $Logger->log("no files left after filtering");
+        return;
+    }
+
+    $Logger->log([ "will examine packages: %s", \@package_names ]);
 
     #
     # Immediately after each package (pmfile) examined contact
     # the database
     #
 
-    my ($package);
-  DBPACK: foreach $package (@keys_ppp) {
-
+    my @packages;
+    for my $package_name (@package_names) {
         # What do we need? dio, fio, pmfile, time, dist, dbh, alert?
         my $pio = PAUSE::package->new(
-                      PACKAGE => $package,
-                      DIST => $dist,
-                      PP => $ppp->{$package}, # hash containing
-                                              # version
-                      PMFILE => $pmfile,
-                      FIO => $self,
-                      USERID => $self->{USERID},
-                      META_CONTENT => $self->{META_CONTENT},
-                      MAIN_PACKAGE => $self->{MAIN_PACKAGE},
-                  );
+            PACKAGE => $package_name,
+            DIST => $dist,
+            PP => $ppp->{$package_name},  # hash containing
+                                          # version
+            PMFILE => $pmfile,
+            FIO => $self,
+            USERID => $self->{USERID},
+            META_CONTENT => $self->{META_CONTENT},
+            MAIN_PACKAGE => $self->{MAIN_PACKAGE},
+        );
 
-        $pio->examine_pkg($ctx);
+        push @packages, $pio;
+    }
 
-    }                       # end foreach package
+    for my $pio (@packages) {
+      $pio->examine_pkg($ctx);
+    }
 
     delete $self->{DIO};    # circular reference
-
 }
 
 # package PAUSE::pmfile

From fb2e9f79554797d91dd918db9f1d10beee5bd1d6 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 17:25:35 +0200
Subject: [PATCH 16/49] indexer: introduce an Abort::Package catch loop

---
 lib/PAUSE/dist.pm   | 17 ++++++++++++++---
 lib/PAUSE/pmfile.pm |  4 +---
 2 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 8d82bbec9..02aaaf949 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -803,9 +803,20 @@ sub _index_by_meta {
     push @packages, $pio;
   }
 
-  for my $pio (@packages) {
-    $pio->examine_pkg($ctx);
-  }
+  $self->index_packages($ctx, \@packages);
+}
+
+sub index_packages {
+    my ($self, $ctx, $packages) = @_;
+
+    PACKAGE: for my $pkg (@$packages) {
+        unless (eval { $pkg->examine_pkg($ctx); 1 }) {
+            my $abort = $@;
+            die $abort unless $abort->isa('PAUSE::Indexer::Abort::Package');
+
+            next PACKAGE;
+        }
+    }
 }
 
 sub examine_pms {
diff --git a/lib/PAUSE/pmfile.pm b/lib/PAUSE/pmfile.pm
index 4703b2070..7215148dd 100644
--- a/lib/PAUSE/pmfile.pm
+++ b/lib/PAUSE/pmfile.pm
@@ -169,9 +169,7 @@ sub examine_fio {
         push @packages, $pio;
     }
 
-    for my $pio (@packages) {
-      $pio->examine_pkg($ctx);
-    }
+    $self->{DIO}->index_packages($ctx, \@packages);
 
     delete $self->{DIO};    # circular reference
 }

From 85bd6bf0b7f7aada29f9982923a6161fbeaf1074 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 23:31:05 +0200
Subject: [PATCH 17/49] indexer: factor our part of the package indexer

This is largley to make the subroutine easier to think about.
---
 lib/PAUSE/package.pm | 120 +++++++++++++++++++++++++++----------------
 1 file changed, 75 insertions(+), 45 deletions(-)

diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index f040a72d1..0e88cf881 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -426,6 +426,10 @@ sub update_package {
     },
   ]);
 
+  # We don't think it's either a CPAN distribution or a perl upload.  What even
+  # are we doing?  Just give up. -- rjbs, 2023-04-30
+  return unless $distorperlok;
+
   # Until 2002-08-01 we always had
   # if >ver                                                 OK
   # elsif <ver
@@ -449,46 +453,13 @@ sub update_package {
   # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2002-07/msg01579.html
   # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2002-08/msg00062.html
 
-  if (! $distorperlok) {
-  } elsif ($isa_regular_perl) {
-      if ($older_isa_regular_perl) {
-          if (CPAN::Version->vgt($pp->{version},$oldversion)) {
-              $ok++;
-          } elsif (CPAN::Version->vgt($oldversion,$pp->{version})) {
-          } elsif (CPAN::Version->vcmp($pp->{version},$oldversion)==0
-                    &&
-                    $tdistmtime >= $odistmtime) {
-              $ok++;
-          }
-      } else {
-          if (CPAN::Version->vgt($pp->{version},$oldversion)) {
-              $self->index_status($ctx,
-                                  $package,
-                                  $pp->{version},
-                                  $pp->{infile},
-                                  PAUSE::mldistwatch::Constants::EDUALOLDER,
-
-                                  qq{Not indexed because package $opack
-in file $ofile seems to have a dual life in $odist. Although the other
-package is at version [$oldversion], the indexer lets the other dist
-continue to be the reference version, shadowing the one in the core.
-Maybe harmless, maybe needs resolving.},
-
-                              );
-          } else {
-              $self->index_status($ctx,
-                                  $package,
-                                  $pp->{version},
-                                  $pp->{infile},
-                                  PAUSE::mldistwatch::Constants::EDUALYOUNGER,
-
-                                  qq{Not indexed because package $opack
-in file $ofile has a dual life in $odist. The other version is at
-$oldversion, so not indexing seems okay.},
-
-                              );
-          }
-      }
+  if ($isa_regular_perl) {
+      $ok = $self->__do_regular_perl_update($ctx, $row, {
+          oldversion  => $oldversion,
+          tdistmtime  => $tdistmtime,
+          odistmtime  => $odistmtime,
+          opack       => $opack,
+      });
   } elsif (defined $pp->{version} && ! version::is_lax($pp->{version})) {
       $self->index_status($ctx,
                           $package,
@@ -569,9 +540,8 @@ pmfile[$pmfile]
 also has a zero version number and the distro has a more recent modification time.}
                                   );
           }
-      } elsif (CPAN::Version
-                ->vcmp($pp->{version},
-                      $oldversion)==0) {    # equal version here
+      } elsif (CPAN::Version->vcmp($pp->{version}, $oldversion)==0) {
+          # equal version here
           # XXX needs better logging message -- dagolden, 2011-08-13
           if ($tdistmtime >= $odistmtime) { # but younger or same-age dist
               $Logger->log([
@@ -606,8 +576,8 @@ has the same version number and the distro has a more recent modification time.}
       }
   }
 
-
-  if ($ok) {              # sanity check
+  # sanity check
+  if ($ok) {
 
       if ($self->{FIO}{DIO}{VERSION_FROM_META_OK}) {
           # nothing to argue at the moment, e.g. lib_pm.PL
@@ -714,6 +684,66 @@ Please report the case to the PAUSE admins at modules\@perl.org.},
 
 }
 
+sub __do_regular_perl_update {
+    my ($self, $ctx, $old_row, $arg) = @_;
+
+    my ($opack, $oldversion, $odist, $ofilemtime, $ofile) = @$old_row{
+      qw( package version dist filemtime file )
+    };
+
+    my $older_isa_regular_perl = $arg->{older_isa_regular_perl};
+
+    my $odistmtime  = $arg->{odistmtime};
+    my $tdistmtime  = $arg->{tdistmtime};
+
+    my $pp      = $self->{PP};
+    my $package = $self->{PACKAGE};
+
+    my $ok = 0;
+
+    if ($older_isa_regular_perl) {
+        if (CPAN::Version->vgt($pp->{version},$oldversion)) {
+            $ok++;
+        } elsif (CPAN::Version->vgt($oldversion,$pp->{version})) {
+        } elsif (CPAN::Version->vcmp($pp->{version},$oldversion)==0
+                  &&
+                  $tdistmtime >= $odistmtime
+        ) {
+            $ok++;
+        }
+    } else {
+        if (CPAN::Version->vgt($pp->{version},$oldversion)) {
+            $self->index_status($ctx,
+                                $package,
+                                $pp->{version},
+                                $pp->{infile},
+                                PAUSE::mldistwatch::Constants::EDUALOLDER,
+
+                                qq{Not indexed because package $opack
+in file $ofile seems to have a dual life in $odist. Although the other
+package is at version [$oldversion], the indexer lets the other dist
+continue to be the reference version, shadowing the one in the core.
+Maybe harmless, maybe needs resolving.},
+
+                            );
+        } else {
+            $self->index_status($ctx,
+                                $package,
+                                $pp->{version},
+                                $pp->{infile},
+                                PAUSE::mldistwatch::Constants::EDUALYOUNGER,
+
+                                qq{Not indexed because package $opack
+in file $ofile has a dual life in $odist. The other version is at
+$oldversion, so not indexing seems okay.},
+
+                            );
+        }
+    }
+
+    return $ok;
+}
+
 # package PAUSE::package;
 sub index_status {
   my ($self, $ctx, @rest) = @_;

From 44ebe7648280c711903ad17a622bdfed5aec8e8f Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 23:41:02 +0200
Subject: [PATCH 18/49] indexer: try to use "return early" instead of $ok more

The indexer, here, kept doing this:

    if ($ok) { ... }

    if ($ok) { ... }

...and any given block might set $ok to 0, but never return early.  That
meant that it was hard to know whether $ok might get set back later.  It
never would.

Instead, the code now returns early, because $ok can only become true
early on, and from then on is really a way of saying "abort, but keep
running through code anyway".  Better to just return.
---
 lib/PAUSE/package.pm | 180 +++++++++++++++++++++----------------------
 1 file changed, 89 insertions(+), 91 deletions(-)

diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index 0e88cf881..899c05a4f 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -576,112 +576,110 @@ has the same version number and the distro has a more recent modification time.}
       }
   }
 
-  # sanity check
-  if ($ok) {
-
-      if ($self->{FIO}{DIO}{VERSION_FROM_META_OK}) {
-          # nothing to argue at the moment, e.g. lib_pm.PL
-      } elsif (
-                ! $pp->{basename_matches_package}
-                &&
-                PAUSE->basename_matches_package($ofile,$package)
-              ) {
-
-          $Logger->log([
-            "warning: basename does not match package, but it used to: %s", {
-              package => $package,
-              old_file => $ofile,
-              new_file => $pp->{infile},
-            }
-          ]);
-
-          $ok = 0;
-      }
+  # If we're not okay yet, we're not going to become okay going forward.
+  return unless $ok;
+
+  if ($self->{FIO}{DIO}{VERSION_FROM_META_OK}) {
+      # nothing to argue at the moment, e.g. lib_pm.PL
+  } elsif (
+      ! $pp->{basename_matches_package}
+      &&
+      PAUSE->basename_matches_package($ofile,$package)
+  ) {
+      $Logger->log([
+        "warning: basename does not match package, but it used to: %s", {
+          package => $package,
+          old_file => $ofile,
+          new_file => $pp->{infile},
+        }
+      ]);
+
+      return;
   }
 
-  if ($ok) {
-      my $query = qq{SELECT package, version, dist from  packages WHERE lc_package = ?};
-      my($pkg_recs) = $dbh->selectall_arrayref($query,{ Slice => {} }, lc $package);
-      if (@$pkg_recs > 1) {
-          $Logger->log([
-              "conflicting records exist in packages table, won't index: %s",
-              [ @$pkg_recs ],
-          ]);
-
-          $self->index_status(
-              $ctx,
-              $package,
-              "undef",
-              $pp->{infile},
-              PAUSE::mldistwatch::Constants::EDBCONFLICT,
-              qq{Indexing failed because of conflicting records for $package.
+  my ($pkg_recs) = $dbh->selectall_arrayref(
+      qq{
+          SELECT package, version, dist
+          FROM packages
+          WHERE lc_package = ?
+      },
+      { Slice => {} },
+      lc $package,
+  );
+
+  if (@$pkg_recs > 1) {
+      $Logger->log([
+          "conflicting records exist in packages table, won't index: %s",
+          [ @$pkg_recs ],
+      ]);
+
+      $self->index_status(
+          $ctx,
+          $package,
+          "undef",
+          $pp->{infile},
+          PAUSE::mldistwatch::Constants::EDBCONFLICT,
+          qq{Indexing failed because of conflicting records for $package.
 Please report the case to the PAUSE admins at modules\@perl.org.},
-          );
-          $ok = 0;
-      }
+      );
+
+      return; # XXX Obsolete when the index_status above becomes an
+              # ->abort_indexing_package!
   }
 
   return unless $self->_version_ok($ctx, $pp, $package, $dist);
 
 
-  if ($ok) {
-      my $query = qq{
-        UPDATE  packages
-        SET     package = ?, lc_package = ?, version = ?, dist = ?, file = ?,
-                filemtime = ?, pause_reg = ?
-        WHERE lc_package = ?
-      };
+  $Logger->log([
+    "updating packages: %s", {
+      package  => $package,
+      version  => $pp->{version},
+      dist     => $dist,
+      infile   => $pp->{infile},
+      filetime => $pp->{filemtime},
+      disttime => $self->dist->{TIME},
+    },
+  ]);
 
-      $Logger->log([
-        "updating packages: %s", {
-          package  => $package,
-          version  => $pp->{version},
-          dist     => $dist,
-          infile   => $pp->{infile},
-          filetime => $pp->{filemtime},
-          disttime => $self->dist->{TIME},
-        },
-      ]);
+  my $rows_affected = eval {
+      $dbh->do(
+          q{
+            UPDATE  packages
+            SET     package = ?, version = ?, dist = ?, file = ?,
+                    filemtime = ?, pause_reg = ?
+            WHERE lc_package = ?
+          },
+          undef,
+          $package, $pp->{version}, $dist, $pp->{infile},
+          $pp->{filemtime}, $self->dist->{TIME},
+          lc $package,
+      );
+  };
 
-      my $rows_affected = eval { $dbh->do
-                                     ($query,
-                                      undef,
-                                      $package,
-                                      lc $package,
-                                      $pp->{version},
-                                      $dist,
-                                      $pp->{infile},
-                                      $pp->{filemtime},
-                                      $self->dist->{TIME},
-                                      lc $package,
-                                     );
-                             };
-
-      if ($rows_affected) { # expecting only "1" can happen
-          $self->index_status(
-              $ctx,
-              $package,
-              $pp->{version},
-              $pp->{infile},
-              PAUSE::mldistwatch::Constants::OK,
-              "indexed",
-          );
-      } else {
-          my $dbherrstr = $dbh->errstr;
-          $self->index_status(
-            $ctx,
-            $package,
-            "undef",
-            $pp->{infile},
-            PAUSE::mldistwatch::Constants::EDBERR,
-            qq{The PAUSE indexer could not store the indexing
+  unless ($rows_affected) {
+      my $dbherrstr = $dbh->errstr;
+      $self->index_status(
+        $ctx,
+        $package,
+        "undef",
+        $pp->{infile},
+        PAUSE::mldistwatch::Constants::EDBERR,
+        qq{The PAUSE indexer could not store the indexing
 result in the DB due the following error: C< $dbherrstr >.
 Please report the case to the PAUSE admins at modules\@perl.org.},
-          );
-      }
+      );
 
+      return; # XXX this return obsolete when ->abort_indexing_package is here
   }
 
+  $self->index_status(
+      $ctx,
+      $package,
+      $pp->{version},
+      $pp->{infile},
+      PAUSE::mldistwatch::Constants::OK,
+      "indexed",
+  );
 }
 
 sub __do_regular_perl_update {

From e3479b9e47aaee10bd122fc50d1f9e78fa4b7e42 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 3 May 2023 19:43:34 +0200
Subject: [PATCH 19/49] indexer context: add package-level indexing status

This adds the code needed to have the context object track package
indexing status.  It isn't used yet, but it shows that we need to rename
distribution-level errors, so they're unambiguous, and then does that!
---
 lib/PAUSE/Indexer/Context.pm |  92 +++++++++++++++++
 lib/PAUSE/Indexer/Errors.pm  | 188 ++++++++++++++++++++++++++++++-----
 lib/PAUSE/dist.pm            |  16 +--
 lib/PAUSE/mldistwatch.pm     |   4 +-
 4 files changed, 263 insertions(+), 37 deletions(-)

diff --git a/lib/PAUSE/Indexer/Context.pm b/lib/PAUSE/Indexer/Context.pm
index 34c4fe6dd..10f6829e0 100644
--- a/lib/PAUSE/Indexer/Context.pm
+++ b/lib/PAUSE/Indexer/Context.pm
@@ -28,9 +28,101 @@ sub add_package_warning {
     text    => $warning,
   };
 
+  $Logger->log([
+    "adding package warning to %s: %s",
+    $package_obj->{PACKAGE},
+    $list->[-1],
+  ]);
+
+  return;
+}
+
+has package_status => (
+  is => 'bare',
+  reader  => '_package_status',
+  default => sub {  {}  },
+);
+
+sub _set_package_error {
+  my ($self, $package_obj, $status) = @_;
+
+  # XXX remove this block when ->index_status is dead
+  $package_obj->{FIO}{DIO}->index_status(
+    $self,
+    $package_obj->{PACKAGE},
+    $package_obj->{PP}{version},
+    $package_obj->{PP}{infile},
+    2, # OK
+    $status->{header},
+  );
+
+  $self->_package_status->{ $package_obj->{PACKAGE} } = {
+    is_success  => 0,
+    filename    => $package_obj->{PP}{infile},
+    version     => $package_obj->{PP}{version},
+    header      => $status->{header},
+    body        => $status->{body},
+    package     => $package_obj->{PACKAGE},
+  };
+
+  $Logger->log([
+    "set error status for %s",
+    $package_obj->{PACKAGE},
+  ]);
+
   return;
 }
 
+sub record_package_indexing {
+  my ($self, $package_obj) = @_;
+
+  # XXX remove this block when ->index_status is dead
+  $package_obj->{FIO}{DIO}->index_status(
+    $self,
+    $package_obj->{PACKAGE},
+    $package_obj->{PP}{version},
+    $package_obj->{PP}{infile},
+    1, # OK
+    "it worked",
+  );
+
+  $self->_package_status->{ $package_obj->{PACKAGE} } = {
+    is_success  => 1,
+    filename    => $package_obj->{PP}{infile},
+    version     => $package_obj->{PP}{version},
+    header      => "Indexed successfully",
+    body        => "The package was indexed successfully.",
+    package     => $package_obj->{PACKAGE},
+  };
+
+  $Logger->log([
+    "set OK status for %s",
+    $package_obj->{PACKAGE},
+  ]);
+
+  return;
+}
+
+sub package_statuses {
+  my ($self) = @_;
+
+  my %stash = $self->_package_status->%*;
+  return @stash{ sort keys %stash };
+}
+
+sub abort_indexing_package {
+  my ($self, $package_obj, $error) = @_;
+
+  $Logger->log("abort indexing $package_obj->{PACKAGE}");
+
+  $self->_set_package_error($package_obj, $error);
+
+  die PAUSE::Indexer::Abort::Package->new({
+    message => $error->{header},
+    public  => 1,
+  });
+}
+
 sub warnings_for_all_packages {
   my ($self) = @_;
 
diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index aa08f509d..2c2224af5 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -3,22 +3,14 @@ use v5.12.0;
 use warnings;
 
 use Sub::Exporter -setup => {
-  exports => [ 'ERROR' ],
-  groups  => { default => [ 'ERROR' ] },
+  exports => [ qw( DISTERROR PKGERROR ) ],
+  groups  => { default => [ qw( DISTERROR PKGERROR ) ] },
 };
 
-my %ERROR;
+sub dist_error;
+sub pkg_error;
 
-sub public_error {
-  my ($name, $arg) = @_;
-  $ERROR{$name} = {
-    ident   => $name,
-    public  => 1,
-    %$arg,
-  };
-}
-
-public_error bad_provides => {
+dist_error bad_provides => {
   header  => 'META provides includes a malformed package name',
   body    => sub {
     my ($dist) = @_;
@@ -31,7 +23,7 @@ public_error bad_provides => {
   },
 };
 
-public_error blib => {
+dist_error blib => {
   header  => 'archive contains a "blib" directory',
   body    => <<~'EOF'
     The distribution contains a blib/ directory and is therefore not being
@@ -39,7 +31,7 @@ public_error blib => {
     EOF
 };
 
-public_error multiroot => {
+dist_error multiroot => {
   header  => 'archive has multiple roots',
   body    => sub {
     my ($dist) = @_;
@@ -51,7 +43,7 @@ public_error multiroot => {
   },
 };
 
-public_error no_distname_permission => {
+dist_error no_distname_permission => {
   header  => 'missing permissions on distname package',
   body    => sub {
     my ($dist) = @_;
@@ -70,7 +62,7 @@ public_error no_distname_permission => {
   },
 };
 
-public_error no_meta => {
+dist_error no_meta => {
   header  => "no META.yml or META.json found",
   body    => <<~'EOF',
     Your archive didn't contain a META.json or META.yml file.  You need to
@@ -79,7 +71,7 @@ public_error no_meta => {
     EOF
 };
 
-public_error single_pm => {
+dist_error single_pm => {
   header  => 'dist is a single-.pm-file upload',
   body    => <<~"EOF",
     You've uploaded a compressed .pm file without a META.json, a build tool, or
@@ -88,7 +80,7 @@ public_error single_pm => {
     EOF
 };
 
-public_error unstable_release => {
+dist_error unstable_release => {
   header  => 'META release_status is not stable',
   body    => <<~'EOF',
     Your META file provides a release status other than "stable", so this
@@ -96,7 +88,7 @@ public_error unstable_release => {
     EOF
 };
 
-public_error worldwritable => {
+dist_error worldwritable => {
   header  => 'archive has world writable files',
   body    => sub {
     my ($dist) = @_;
@@ -108,7 +100,7 @@ public_error worldwritable => {
   },
 };
 
-public_error xact_fail => {
+dist_error xact_fail => {
   header => "ERROR: Database error occurred during index update",
   body   => <<~'EOF',
     This distribution was not indexed due to database errors.  You can request
@@ -116,21 +108,163 @@ public_error xact_fail => {
     EOF
 };
 
-sub ERROR {
+pkg_error bad_package_name => {
+  header  => 'Not indexed because of invalid package name.',
+  body    => <<~'EOF',
+    This package wasn't indexed because its name doesn't conform to standard
+    naming.  Basically:  one or more valid identifiers, separated by double
+    colons (::).
+    EOF
+};
+
+pkg_error db_conflict => {
+  # TODO bring back $package
+  header  => "Not indexed because of conflicting record in index",
+  body    => <<~"EOF"
+    Indexing failed because of conflicting records for \$package.  Please
+    report the case to the PAUSE admins at modules\@perl.org.
+    EOF
+};
+
+pkg_error db_error => {
+  # TODO bring back db error string?  seems weird -- rjbs, 2023-05-01
+  header  => 'Not indexed because of database error',
+  body    => <<~'EOF',
+    The PAUSE indexer could not store the indexing result in the PAUSE
+    database due to an internal database error.  Please report this to the
+    PAUSE admins at modules@perl.org.
+    EOF
+};
+
+pkg_error dual_newer => {
+  # TODO bring back parameters
+  header  => 'Not indexed because of an newer dual-life module',
+  body    => <<~'EOF',
+    Not indexed because package $opack in file $ofile has a dual life in
+    $odist. The other version is at $oldversion, so not indexing seems okay.
+    EOF
+};
+
+pkg_error dual_older => {
+  # TODO bring back parameters
+  header  => 'Not indexed because of an older dual-life module',
+  body    => <<~'EOF',
+    Not indexed because package $opack in file $ofile seems to have a dual
+    life in $odist. Although the other package is at version [$oldversion],
+    the indexer lets the other dist continue to be the reference version,
+    shadowing the one in the core.  Maybe harmless, maybe needs resolving.
+    EOF
+};
+
+pkg_error mtime_fell => {
+  # TODO bring back ofile/odist in body
+  header  => 'Release seems outdated',
+  body    => q{Not indexed because $ofile in $odist also has a zero version
+               number and the distro has a more recent modification time.},
+};
+
+pkg_error no_permission => {
+  header  => 'Not indexed because the required permissions were missing.',
+  body    => <<~'EOF',
+    This package wasn't indexed because you don't have permission to use this
+    package name.  Hint: you can always find the legitimate maintainer(s) on
+    PAUSE under "View Permissions".
+    EOF
+};
+
+pkg_error version_fell => {
+  # TODO bring back "file in $dist", make the q{...} a qq{...}
+  header => "Not indexed because of decreasing version number",
+  body   => q{Not indexed because $ofile in $odist has a higher version number
+              ($oldversion)},
+};
+
+pkg_error version_invalid => {
+  # TODO put back $version itself?  It's already in the report.
+  # -- rjbs, 2023-05-01
+  header  => 'Not indexed because version is not a valid "lax version" string.',
+  body    => undef,
+};
+
+pkg_error version_openerr => {
+  header  => 'Not indexed because of version handling error.',
+  body    => <<~'EOF',
+    The PAUSE indexer was not able to read the file.
+    EOF
+};
+
+pkg_error version_parse => {
+  header  => 'Not indexed because of version parsing error.',
+  body    => <<~'EOF',
+    The PAUSE indexer was not able to parse the file.
+
+    Note: the indexer is running in a Safe compartment and cannot provide the
+    full functionality of perl in the VERSION line. It is trying hard, but
+    sometime it fails. As a workaround, please consider writing a META.yml
+    that contains a "provides" attribute, or contact the CPAN admins to
+    investigate (yet another) workaround against "Safe" limitations.
+    EOF
+};
+
+pkg_error version_too_long => {
+  header  => 'Not indexed because the version string was too long.',
+  body    => <<~'EOF',
+    The maximum length of a version string is 16 bytes, which is already quite
+    long.  Please consider picking a shorter version.
+    EOF
+};
+
+pkg_error wtf => {
+  header  => 'Not indexed: something surprising happened.',
+  body    => <<~'EOF',
+    The PAUSE indexer couldn't index this package.  It ended up with a weird
+    internal state, like thinking your package name was empty or your version
+    was undefined.  If you see this, you should probably contact the PAUSE
+    admins.
+    EOF
+};
+
+my %DIST_ERROR;
+my %PKG_ERROR;
+
+sub DISTERROR {
+  my ($ident) = @_;
+
+  my $error = $DIST_ERROR{$ident};
+  unless ($error) {
+    Carp::confess("requested unknown distribution error: $ident");
+  }
+
+  return $error;
+}
+
+sub PKGERROR {
   my ($ident) = @_;
 
-  my $error = PAUSE::Indexer::Errors->error_named($ident);
+  my $error = $PKG_ERROR{$ident};
   unless ($error) {
-    Carp::confess("requested unknown error: $ident");
+    Carp::confess("requested unknown package error: $ident");
   }
 
   return $error;
 }
 
-sub error_named {
-  my ($self, $ident) = @_;
+sub dist_error {
+  my ($name, $arg) = @_;
+  $DIST_ERROR{$name} = {
+    ident   => $name,
+    public  => 1,
+    %$arg,
+  };
+}
 
-  return $ERROR{$ident};
+sub pkg_error {
+  my ($name, $arg) = @_;
+  $PKG_ERROR{$name} = {
+    ident   => $name,
+    public  => 1,
+    %$arg,
+  };
 }
 
 1;
diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 02aaaf949..c0bfd2a96 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -306,7 +306,7 @@ sub examine_dist {
     }
   } elsif ($dist =~ /\.pm\.(?:Z|gz|bz2)$/) {
     $self->{SUFFIX} = "N/A";
-    $ctx->abort_indexing_dist(ERROR('single_pm'));
+    $ctx->abort_indexing_dist(DISTERROR('single_pm'));
   } elsif ($dist =~ /\.zip$/) {
     $self->{SUFFIX} = "zip";
     my $unzipbin = $self->hub->{UNZIPBIN};
@@ -590,7 +590,7 @@ sub check_blib {
   my ($self, $ctx) = @_;
   if (grep m|^[^/]+/blib/|, @{$self->{MANIFOUND}}) {
     $self->{HAS_BLIB}++;
-    $ctx->abort_indexing_dist(ERROR('blib'));
+    $ctx->abort_indexing_dist(DISTERROR('blib'));
   }
   # sometimes they package their stuff deep inside a hierarchy
   my @found = @{$self->{MANIFOUND}};
@@ -615,7 +615,7 @@ sub check_blib {
     # more than one entry in this directory means final check
     if (grep m|^blib/|, @found) {
       $self->{HAS_BLIB}++;
-      $ctx->abort_indexing_dist(ERROR('blib'));
+      $ctx->abort_indexing_dist(DISTERROR('blib'));
     }
     last DIRDOWN;
   }
@@ -627,7 +627,7 @@ sub check_multiple_root {
   my @top = grep { s|/.*||; !$seen{$_}++ } map { $_ } @{$self->{MANIFOUND}};
   if (@top > 1) {
     $self->{HAS_MULTIPLE_ROOT} = \@top;
-    $ctx->abort_indexing_dist(ERROR('multiroot'));
+    $ctx->abort_indexing_dist(DISTERROR('multiroot'));
   } else {
     $self->{DISTROOT} = $top[0];
   }
@@ -650,7 +650,7 @@ sub check_world_writable {
 
   $Logger->log([ "archive has world writable files: %s", [ sort @ww ] ]);
   $self->{HAS_WORLD_WRITABLE} = \@ww;
-  $ctx->abort_indexing_dist(ERROR('worldwritable'));
+  $ctx->abort_indexing_dist(DISTERROR('worldwritable'));
 }
 
 sub filter_pms {
@@ -944,7 +944,7 @@ sub extract_readme_and_meta {
 
   unless ($json || $yaml) {
     $self->{METAFILE} = "No META.yml or META.json found";
-    $ctx->abort_indexing_dist(ERROR('no_meta'));
+    $ctx->abort_indexing_dist(DISTERROR('no_meta'));
     return;
   }
 
@@ -998,7 +998,7 @@ sub check_indexability {
 
     if (($self->{META_CONTENT}{release_status} // 'stable') ne 'stable') {
         # META.json / META.yml declares it's not stable; do not index!
-        $ctx->abort_indexing_dist(ERROR('unstable_release'));
+        $ctx->abort_indexing_dist(DISTERROR('unstable_release'));
         return;
     }
 
@@ -1007,7 +1007,7 @@ sub check_indexability {
         # control.  When it's wrong, just abort the whole dist.
         $Logger->log([ "META provides has malformed package names: %s", \@bad_names ]);
         $self->{MALFORMED_PROVIDES} = \@bad_names;
-        $ctx->abort_indexing(ERROR('bad_provides'));
+        $ctx->abort_indexing_dist(DISTERROR('bad_provides'));
     }
 }
 
diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index 58d57ab97..f04d21b3e 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -384,7 +384,7 @@ sub _do_the_database_work {
       $dbh->commit;
     } else {
       $ctx->alert("Uploading user has no permissions on package $main_pkg");
-      $ctx->add_dist_error(ERROR('no_distname_permission'));
+      $ctx->add_dist_error(DISTERROR('no_distname_permission'));
       $dbh->rollback;
     }
 
@@ -508,7 +508,7 @@ sub maybe_index_dist {
       if ($attempt == 3) {
         $Logger->log_debug("tried $attempt times to do db work, but all failed");
         $ctx->alert("database errors while indexing");
-        $ctx->add_dist_error(ERROR('xact_fail'));
+        $ctx->add_dist_error(DISTERROR('xact_fail'));
       }
     }
 

From e2a60877953a86c6b494ac544085f0fccd2aa07c Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 3 May 2023 19:46:25 +0200
Subject: [PATCH 20/49] indexer: clean up a weirdly-formatted comment

---
 lib/PAUSE/package.pm | 17 +++++++----------
 1 file changed, 7 insertions(+), 10 deletions(-)

diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index 899c05a4f..311f8f8ed 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -509,16 +509,13 @@ pmfile[$pmfile]
       }
   } else {
 
-      # 2004-01-04: Stas Bekman asked to change logic here. Up
-      # to rev 478 we did not index files with a version of 0
-      # and with a falling timestamp. These strange timestamps
-      # typically happen for developers who work on more than
-      # one computer. Files that are not changed between
-      # releases keep two different timestamps from some
-      # arbitrary checkout in the past. Stas correctly suggests,
-      # we should check these cases for distmtime, not filemtime.
-
-      # so after rev. 478 we deprecate the EMTIMEFALLING constant
+      # 2004-01-04: Stas Bekman asked to change logic here. Up to rev 478 we
+      # did not index files with a version of 0 and with a falling timestamp.
+      # These strange timestamps typically happen for developers who work on
+      # more than one computer. Files that are not changed between releases
+      # keep two different timestamps from some arbitrary checkout in the past.
+      # Stas correctly suggests, we should check these cases for distmtime, not
+      # filemtime.
 
       if ($pp->{version} eq "undef"||$pp->{version} == 0) { # no version here,
           if ($tdistmtime >= $odistmtime) { # but younger or same-age dist

From 1cf44f2c4a60ff46840126b1b25b5ba8c134bc22 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 3 May 2023 19:47:21 +0200
Subject: [PATCH 21/49] indexer: use ->abort_indexing_package

Here, we replace all the package-level errors, logged with
->index_status, with ->abort_indexing_package.  This lets us put all the
error status text in one place and ensure it exists.  It also means we
can stop worrying about the flow control of package indexing: throw to
stop.
---
 lib/PAUSE/package.pm | 245 ++++++++-----------------------------------
 t/lib/Mock/Dist.pm   |   2 +-
 t/mldistwatch-big.t  |   2 +-
 t/mldistwatch-misc.t |   2 +-
 4 files changed, 48 insertions(+), 203 deletions(-)

diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index 311f8f8ed..3ababbbec 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -6,6 +6,7 @@ use vars qw($AUTOLOAD);
 use PAUSE::Logger '$Logger';
 
 use PAUSE::mldistwatch::Constants;
+use PAUSE::Indexer::Errors;
 use CPAN::DistnameInfo;
 
 =comment
@@ -108,7 +109,7 @@ sub give_regdowner_perms {
 # on Foo is the same as having it on foo
 
 # package PAUSE::package;
-sub perm_check {
+sub assert_permissions_okay {
   my ($self, $ctx) = @_;
   my $dist = $self->{DIST};
   my $package = $self->{PACKAGE};
@@ -159,18 +160,7 @@ sub perm_check {
                     // "unknown";
 
           my $error   = "not owner";
-          my $message = qq{Not indexed because permission missing.
-Current registered primary maintainer is $owner.
-Hint: you can always find the legitimate maintainer(s) on PAUSE under
-"View Permissions".};
-
-          $self->index_status($ctx,
-                              $package,
-                              $pp->{version},
-                              $pp->{infile},
-                              PAUSE::mldistwatch::Constants::EMISSPERM,
-                              $message,
-                              );
+
           $ctx->alert(qq{$error:
 package[$package]
 version[$pp->{version}]
@@ -180,7 +170,8 @@ userid[$userid]
 owners[@owners]
 owner[$owner]
 });
-          return;         # early return
+
+          $ctx->abort_indexing_package($self, PKGERROR('no_permission'));
       }
 
   } else {
@@ -258,17 +249,12 @@ sub examine_pkg {
   # should they be cought earlier? Maybe.
   # but as an ultimate sanity check suggested by Richard Soderberg
   if ($self->_pkg_name_insane($ctx)) {
-      $Logger->log("package[$package] name seems illegal");
-      delete $self->{FIO};    # circular reference
-      return;
+      $ctx->abort_indexing_package($self, "invalid package name");
   }
 
   # Query all users with perms for this package
 
-  unless ($self->perm_check($ctx)) { # (P2.0&P3.0)
-      delete $self->{FIO};           # circular reference
-      return;
-  }
+  $self->assert_permissions_okay($ctx);
 
   # Check that package name matches case of file name
   {
@@ -291,48 +277,19 @@ sub examine_pkg {
   if ($pp->{version} && $pp->{version} =~ /^\{.*\}$/) { # JSON parser error
       my $err = JSON::jsonToObj($pp->{version});
       if ($err->{openerr}) {
-          $self->index_status($ctx,
-                              $package,
-                              "undef",
-                              $pp->{infile},
-                              PAUSE::mldistwatch::Constants::EOPENFILE,
-
-                              qq{The PAUSE indexer was not able to
-        read the file. It issued the following error: C< $err->{openerr} >},
-                              );
+          # TODO: get $err->{openerr} back in here, I guess?
+          $ctx->abort_indexing_package($self, PKGERROR('version_openerr'));
       } else {
-          $self->index_status($ctx,
-                              $package,
-                              "undef",
-                              $pp->{infile},
-                              PAUSE::mldistwatch::Constants::EPARSEVERSION,
-
-                              qq{The PAUSE indexer was not able to
-        parse the following line in that file: C< $err->{line} >
-
-        Note: the indexer is running in a Safe compartement and cannot
-        provide the full functionality of perl in the VERSION line. It
-        is trying hard, but sometime it fails. As a workaround, please
-        consider writing a META.yml that contains a 'provides'
-        attribute or contact the CPAN admins to investigate (yet
-        another) workaround against "Safe" limitations.)},
-
-                              );
+          # TODO: get $err->{line} back in here, I guess?
+          $ctx->abort_indexing_package($self, PKGERROR('version_parse'));
       }
-      delete $self->{FIO};    # circular reference
-      return;
   }
 
   # Sanity checks
-
-  for (
-        $package,
-        $pp->{version},
-        $dist
-      ) {
-      if (!defined || /^\s*$/ || /\s/){  # for whatever reason I come here
-          delete $self->{FIO};    # circular reference
-          return;            # don't screw up 02packages
+  for ($package, $pp->{version}, $dist) {
+      if (!defined || /^\s*$/ || /\s/) {
+          # If we got here, what on earth happened?
+          $ctx->abort_indexing_package($self, PKGERROR('wtf'));
       }
   }
 
@@ -340,27 +297,19 @@ sub examine_pkg {
   delete $self->{FIO};    # circular reference
 }
 
-sub _version_ok {
-  my ($self, $ctx, $pp, $package, $dist) = @_;
-  if (length $pp->{version} > 16) {
-    my $errno = PAUSE::mldistwatch::Constants::ELONGVERSION;
-    my $error = PAUSE::mldistwatch::Constants::heading($errno);
-    $self->index_status($ctx,
-                        $package,
-                        $pp->{version},
-                        $pp->{infile},
-                        $errno,
-                        $error,
-                        );
-    $ctx->alert(qq{$error:
-package[$package]
-version[$pp->{version}]
-file[$pp->{infile}]
-dist[$dist]
+sub assert_version_ok {
+    my ($self, $ctx) = @_;
+
+    return if length $self->{PP}{version} <= 16;
+
+    $ctx->alert(qq{version string was too long:
+package[$self->{PACKAGE}]
+version[$self->{PP}{version}]
+file[$self->{PP}{infile}]
+dist[$self->{DIST}]
 });
-    return;
-  }
-  return 1;
+
+    $ctx->abort_indexing_package($self, PKGERROR('version_too_long'));
 }
 
 # package PAUSE::package;
@@ -375,7 +324,6 @@ sub update_package {
   my $pmfile = $self->{PMFILE};
   my $fio = $self->{FIO};
 
-
   my($opack,$oldversion,$odist,$ofilemtime,$ofile) = @$row{
     qw( package version dist filemtime file )
   };
@@ -461,13 +409,7 @@ sub update_package {
           opack       => $opack,
       });
   } elsif (defined $pp->{version} && ! version::is_lax($pp->{version})) {
-      $self->index_status($ctx,
-                          $package,
-                          $pp->{version},
-                          $pmfile,
-                          PAUSE::mldistwatch::Constants::EBADVERSION,
-                          qq{Not indexed because VERSION [$pp->{version}] is not a valid "lax version" string.},
-      );
+      $ctx->abort_indexing_package($self, PKGERROR('version_invalid'));
   } elsif (CPAN::Version->vgt($pp->{version},$oldversion)) {
       # higher VERSION here
       $Logger->log([
@@ -483,15 +425,6 @@ sub update_package {
   } elsif (CPAN::Version->vgt($oldversion,$pp->{version})) {
       # lower VERSION number here
       if ($odist ne $dist) {
-          $self->index_status($ctx,
-                              $package,
-                              $pp->{version},
-                              $pmfile,
-                              PAUSE::mldistwatch::Constants::EVERFALLING,
-                              qq{Not indexed because $ofile in $odist
-has a higher version number ($oldversion)},
-                              );
-
           delete $self->dist->{CHECKINS}{ lc $package }{ $package };
 
           $ctx->alert(qq{decreasing VERSION number [$pp->{version}]
@@ -500,6 +433,8 @@ dist[$dist]
 oldversion[$oldversion]
 pmfile[$pmfile]
 }); # });
+
+          $ctx->abort_indexing_package($self, PKGERROR('version_fell'));
       } elsif ($older_isa_regular_perl) {
           $ok++;          # new on 2002-08-01
       } else {
@@ -528,14 +463,7 @@ pmfile[$pmfile]
               ]);
               $ok++;
           } else {
-              $self->index_status($ctx,
-                                  $package,
-                                  $pp->{version},
-                                  $pp->{infile},
-                                  PAUSE::mldistwatch::Constants::EOLDRELEASE,
-                                  qq{Not indexed because $ofile in $odist
-also has a zero version number and the distro has a more recent modification time.}
-                                  );
+              $ctx->abort_indexing_package($self, PKGERROR('mtime_fell'));
           }
       } elsif (CPAN::Version->vcmp($pp->{version}, $oldversion)==0) {
           # equal version here
@@ -557,14 +485,7 @@ also has a zero version number and the distro has a more recent modification tim
                   old     => { dist => $odist, mtime => $odistmtime },
                 },
               ]);
-              $self->index_status($ctx,
-                                  $package,
-                                  $pp->{version},
-                                  $pp->{infile},
-                                  PAUSE::mldistwatch::Constants::EOLDRELEASE,
-                                  qq{Not indexed because $ofile in $odist
-has the same version number and the distro has a more recent modification time.}
-                                  );
+              $ctx->abort_indexing_package($self, PKGERROR('mtime_fell'));
           }
       } else {
           $Logger->log(
@@ -610,22 +531,10 @@ has the same version number and the distro has a more recent modification time.}
           [ @$pkg_recs ],
       ]);
 
-      $self->index_status(
-          $ctx,
-          $package,
-          "undef",
-          $pp->{infile},
-          PAUSE::mldistwatch::Constants::EDBCONFLICT,
-          qq{Indexing failed because of conflicting records for $package.
-Please report the case to the PAUSE admins at modules\@perl.org.},
-      );
-
-      return; # XXX Obsolete when the index_status above becomes an
-              # ->abort_indexing_package!
+      $ctx->abort_indexing_package($self, PKGERROR('db_conflict'));
   }
 
-  return unless $self->_version_ok($ctx, $pp, $package, $dist);
-
+  $self->assert_version_ok($ctx);
 
   $Logger->log([
     "updating packages: %s", {
@@ -655,28 +564,10 @@ Please report the case to the PAUSE admins at modules\@perl.org.},
 
   unless ($rows_affected) {
       my $dbherrstr = $dbh->errstr;
-      $self->index_status(
-        $ctx,
-        $package,
-        "undef",
-        $pp->{infile},
-        PAUSE::mldistwatch::Constants::EDBERR,
-        qq{The PAUSE indexer could not store the indexing
-result in the DB due the following error: C< $dbherrstr >.
-Please report the case to the PAUSE admins at modules\@perl.org.},
-      );
-
-      return; # XXX this return obsolete when ->abort_indexing_package is here
+      $ctx->abort_indexing_package($self, PKGERROR('db_error'));
   }
 
-  $self->index_status(
-      $ctx,
-      $package,
-      $pp->{version},
-      $pp->{infile},
-      PAUSE::mldistwatch::Constants::OK,
-      "indexed",
-  );
+  $ctx->record_package_indexing($self);
 }
 
 sub __do_regular_perl_update {
@@ -708,57 +599,15 @@ sub __do_regular_perl_update {
         }
     } else {
         if (CPAN::Version->vgt($pp->{version},$oldversion)) {
-            $self->index_status($ctx,
-                                $package,
-                                $pp->{version},
-                                $pp->{infile},
-                                PAUSE::mldistwatch::Constants::EDUALOLDER,
-
-                                qq{Not indexed because package $opack
-in file $ofile seems to have a dual life in $odist. Although the other
-package is at version [$oldversion], the indexer lets the other dist
-continue to be the reference version, shadowing the one in the core.
-Maybe harmless, maybe needs resolving.},
-
-                            );
+            $ctx->abort_indexing_package($self, PKGERROR('dual_older'));
         } else {
-            $self->index_status($ctx,
-                                $package,
-                                $pp->{version},
-                                $pp->{infile},
-                                PAUSE::mldistwatch::Constants::EDUALYOUNGER,
-
-                                qq{Not indexed because package $opack
-in file $ofile has a dual life in $odist. The other version is at
-$oldversion, so not indexing seems okay.},
-
-                            );
+            $ctx->abort_indexing_package($self, PKGERROR('dual_newer'));
         }
     }
 
     return $ok;
 }
 
-# package PAUSE::package;
-sub index_status {
-  my ($self, $ctx, @rest) = @_;
-  my $dio;
-
-  if (my $fio = $self->{FIO}) {
-      $dio = $fio->{DIO};
-  } else {
-      $dio = $self->{DIO};
-  }
-
-  $dio->index_status($ctx, @rest);
-}
-
-sub get_index_status_status {
-  my ($self, $ctx) = @_;
-
-  return $self->dist->{INDEX_STATUS}{ $self->{PACKAGE} }{status};
-}
-
 # package PAUSE::package;
 sub insert_into_package {
   my ($self, $ctx) = @_;
@@ -785,7 +634,7 @@ sub insert_into_package {
     }
   ]);
 
-  return unless $self->_version_ok($ctx, $pp, $package, $dist);
+  $self->assert_version_ok($ctx);
   $dbh->do($query,
             undef,
             $package,
@@ -797,13 +646,8 @@ sub insert_into_package {
             $self->dist->{TIME},
             $distname,
           );
-  $self->index_status($ctx,
-                      $package,
-                      $pp->{version},
-                      $pp->{infile},
-                      PAUSE::mldistwatch::Constants::OK,
-                      "indexed",
-                      );
+
+  $ctx->record_package_indexing($self);
 }
 
 # package PAUSE::package;
@@ -888,11 +732,12 @@ sub checkin {
       $self->insert_into_package($ctx);
   }
 
-  my $status = $self->get_index_status_status($ctx);
-  if (! $status or $status == PAUSE::mldistwatch::Constants::OK) {
+  # my $status = $self->get_index_status_status($ctx);
+  # if (! $status or $status == PAUSE::mldistwatch::Constants::OK) {
       $self->checkin_into_primeur($ctx); # called in void context!
-  }
+  # }
 
+  return;
 }
 
 1;
diff --git a/t/lib/Mock/Dist.pm b/t/lib/Mock/Dist.pm
index c9e80121a..1c6231d1f 100644
--- a/t/lib/Mock/Dist.pm
+++ b/t/lib/Mock/Dist.pm
@@ -9,7 +9,7 @@ use Test::Deep ();
 
 my $null = sub {};
 
-my @NULL = qw(verbose connect disconnect mlroot);
+my @NULL = qw(verbose connect disconnect mlroot index_packages);
 
 my %ALWAYS = (
   version_from_meta_ok => 1,
diff --git a/t/mldistwatch-big.t b/t/mldistwatch-big.t
index 5d5f17d69..38a43b2cc 100644
--- a/t/mldistwatch-big.t
+++ b/t/mldistwatch-big.t
@@ -236,7 +236,7 @@ subtest "case mismatch, authorized for original, desc. version" => sub {
           sub {
             like(
               $_[0]->{email}->as_string,
-              qr/has\s+a\s+higher\s+version/,
+              qr/decreasing\s+version\s+number/,
               "email looks right",
             );
           }
diff --git a/t/mldistwatch-misc.t b/t/mldistwatch-misc.t
index 862e50a43..8293ce956 100644
--- a/t/mldistwatch-misc.t
+++ b/t/mldistwatch-misc.t
@@ -328,7 +328,7 @@ subtest "check overlong versions" => sub {
   my $etoolong = sub {
     like(
       $_[0]{email}->object->body_str,
-      qr/Version string exceeds maximum allowed length/,
+      qr/version string was too long/,
       "email contains ELONGVERSION string",
     );
   };

From 56a6a3ee34c7db4092daec0f6b9189286773d8f9 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 3 May 2023 19:38:50 +0200
Subject: [PATCH 22/49] replace use of index_status with context in reporting

In the previous commit, we'd replaced all use of ->index_status to set
the current status, and instead used the context methods to record
package status.  Still, though, those methods set *both* the new status
and the old status, and we only read things from the old status.

In this commit, we switch to only reading things from the new status,
and delete the attributes used to store the old status.
---
 lib/PAUSE/Indexer/Context.pm |  20 -------
 lib/PAUSE/dist.pm            | 113 ++++++++++++++---------------------
 2 files changed, 46 insertions(+), 87 deletions(-)

diff --git a/lib/PAUSE/Indexer/Context.pm b/lib/PAUSE/Indexer/Context.pm
index 10f6829e0..6cab85e9e 100644
--- a/lib/PAUSE/Indexer/Context.pm
+++ b/lib/PAUSE/Indexer/Context.pm
@@ -46,16 +46,6 @@ has package_status => (
 sub _set_package_error {
   my ($self, $package_obj, $status) = @_;
 
-  # XXX remove this block when ->index_status is dead
-  $package_obj->{FIO}{DIO}->index_status(
-    $self,
-    $package_obj->{PACKAGE},
-    $package_obj->{PP}{version},
-    $package_obj->{PP}{infile},
-    2, # OK
-    $status->{header},
-  );
-
   $self->_package_status->{ $package_obj->{PACKAGE} } = {
     is_success  => 0,
     filename    => $package_obj->{PP}{infile},
@@ -76,16 +66,6 @@ sub _set_package_error {
 sub record_package_indexing {
   my ($self, $package_obj) = @_;
 
-  # XXX remove this block when ->index_status is dead
-  $package_obj->{FIO}{DIO}->index_status(
-    $self,
-    $package_obj->{PACKAGE},
-    $package_obj->{PP}{version},
-    $package_obj->{PP}{infile},
-    1, # OK
-    "it worked",
-  );
-
   $self->_package_status->{ $package_obj->{PACKAGE} } = {
     is_success  => 1,
     filename    => $package_obj->{PP}{infile},
diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index c0bfd2a96..bf18753bf 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -343,67 +343,61 @@ sub mlroot {
 }
 
 sub _update_mail_content_when_things_were_indexed {
-    my ($self, $ctx, $inxst, $m_ref, $status_ref) = @_;
+    my ($self, $ctx, $statuses, $m_ref, $status_ref) = @_;
 
     my $Lstatus = 0;
     my $intro_written;
-    for my $p (sort {
-        $inxst->{$b}{status} <=> $inxst->{$a}{status}
-          or
-        $a cmp $b
-      } keys %$inxst) {
-      my $status = $inxst->{$p}{status};
-      unless (defined $$status_ref) {
-        if ($status) {
-          if ($status > PAUSE::mldistwatch::Constants::OK) {
-            $$status_ref =
-            PAUSE::mldistwatch::Constants::heading($status)
-            || "UNKNOWN (status=$status)";
-          } else {
-            $$status_ref = "OK";
-          }
-        } else {
-          $$status_ref = "Unknown";
-        }
-        push @$m_ref, "Status of this distro: $$status_ref\n";
-        push @$m_ref, "="x(length($$status_ref)+23), "\n\n";
-      }
-      unless ($intro_written++) {
-        push @$m_ref, qq{\nThe following packages (grouped by }.
-        qq{status) have been found in the distro:\n\n};
-      }
-      if ($status != $Lstatus) {
-        my $heading =
-        PAUSE::mldistwatch::Constants::heading($status) ||
-        "UNKNOWN (status=$status)";
-        push @$m_ref, sprintf "Status: %s\n%s\n\n", $heading, "="x(length($heading)+8);
+
+    my $all_succeeded = @$statuses == grep {; $_->{is_success} } @$statuses;
+
+    unless (defined $$status_ref) {
+      $$status_ref = $all_succeeded ? "OK" : "Failed";
+
+      push @$m_ref, "Status of this distro: $$status_ref\n";
+      push @$m_ref, "="x(length($$status_ref)+23), "\n\n";
+    }
+
+    push @$m_ref, qq{\nThe following packages have been found in the distro:\n\n};
+
+    my $tf14 = Text::Format->new(
+      bodyIndent  => 14,
+      firstIndent => 14,
+    );
+
+    my $last_header = q{};
+
+    for my $status (
+      # First failures, grouped, then success, by description.
+      sort { $b->{is_success} <=> $a->{is_success}
+          || $a->{header} cmp $b->{header} } @$statuses
+    ) {
+      my $header = $status->{header};
+
+      unless ($header eq $last_header) {
+        push @$m_ref, "## $header\n\n";
+        $last_header = $header;
       }
-      my $tf14 = Text::Format->new(
-        bodyIndent => 14,
-        firstIndent => 14,
-      );
-      my $verb_status = $tf14->format($inxst->{$p}{verb_status});
-      $verb_status =~ s/^\s+//; # otherwise this line is too long
-      # magic words, see also report02() around line 573, same wording there,
-      # exception prompted by JOESUF/libapreq2-2.12.tar.gz
-      $inxst->{$p}{infile} ||= "missing in META.yml, tolerated by PAUSE indexer";
-      push @$m_ref, sprintf("     package: %s\n",  $p);
-
-      if (my @warnings = $ctx->warnings_for_package($p)) {
+
+      push @$m_ref, sprintf("     package: %s\n",  $status->{package});
+
+      if (my @warnings = $ctx->warnings_for_package($status->{package})) {
         push @$m_ref, map {;
                sprintf("     WARNING: %s\n", $_->{text}) } @warnings;
       }
 
-      push @$m_ref, sprintf("     version: %s\n", $inxst->{$p}{version});
-      push @$m_ref, sprintf("     in file: %s\n", $inxst->{$p}{infile});
-      push @$m_ref, sprintf("     status : %s\n",  $verb_status);
+      my $body = $tf14->format($status->{body});
+      $body =~ s/\A\s+//; # The first line is indented by the leading text!
+
+      my $file = $status->{filename} // "missing in META, tolerated by PAUSE indexer";
 
-      $Lstatus = $status;
+      push @$m_ref, sprintf("     version: %s\n", $status->{version});
+      push @$m_ref, sprintf("     in file: %s\n", $file);
+      push @$m_ref, sprintf("     status : %s\n", $body);
     }
 }
 
 sub _update_mail_content_when_nothing_was_indexed {
-    my ($self, $ctx, $inxst, $m_ref, $status_ref) = @_;
+    my ($self, $ctx, $m_ref, $status_ref) = @_;
 
     if ($self->version_from_meta_ok($ctx)) {
       push @$m_ref,  qq{Nothing in this distro has been \n}
@@ -492,24 +486,22 @@ sub mail_summary {
   }
 
   if (($status_over_all//'Ok') ne 'Failed') {
-    my $inxst = $self->{INDEX_STATUS};
-    if ($inxst && ref $inxst && %$inxst) {
+    my @statuses = $ctx->package_statuses;
+
+    if (@statuses) {
       $self->_update_mail_content_when_things_were_indexed(
         $ctx,
-        $inxst,
+        \@statuses,
         \@m,
         \$status_over_all,
       );
-
     } else {
-      $Logger->log([ "index status: %s", $inxst ]);
 
       # No files have status, no dist-wide errors.  Nothing to report!
       return unless $pmfiles || $ctx->dist_errors;
 
       $self->_update_mail_content_when_nothing_was_indexed(
         $ctx,
-        $inxst,
         \@m,
         \$status_over_all,
       );
@@ -566,17 +558,6 @@ sub _send_email {
     $Logger->log("sent indexer report email");
 }
 
-sub index_status {
-  my ($self, $ctx, $pack, $version, $infile, $status, $verb_status) = @_;
-
-  $self->{INDEX_STATUS}{$pack} = {
-    version => $version,
-    infile => $infile,
-    status => $status,
-    verb_status => $verb_status,
-  };
-}
-
 sub malformed_provides_names {
   my ($self) = @_;
 
@@ -1315,8 +1296,6 @@ Accessor method. True if perl distro from non-pumpking or a dev release.
 
 =head3 mail_summary
 
-=head3 index_status
-
 =head3 _package_governing_permission
 
 The package used to determine whether the uploader may upload this distro.

From da56d3c0b557b833ff9dccea4930227526876449 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 3 May 2023 20:25:58 +0200
Subject: [PATCH 23/49] 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".
---
 lib/PAUSE/Indexer/Errors.pm | 121 +++++++++++++++++++++++++++---------
 lib/PAUSE/package.pm        |  40 +++++++-----
 2 files changed, 115 insertions(+), 46 deletions(-)

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index 2c2224af5..ee48fa3ab 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -10,6 +10,16 @@ use Sub::Exporter -setup => {
 sub dist_error;
 sub pkg_error;
 
+sub _assert_args_present {
+  my ($ident, $hash, $names_demanded) = @_;
+
+  for my $name (@$names_demanded) {
+    next if exists $hash->{$name};
+
+    Carp::confess("no $name given in PKGERROR($ident)")
+  }
+}
+
 dist_error bad_provides => {
   header  => 'META provides includes a malformed package name',
   body    => sub {
@@ -118,16 +128,23 @@ pkg_error bad_package_name => {
 };
 
 pkg_error db_conflict => {
-  # TODO bring back $package
   header  => "Not indexed because of conflicting record in index",
-  body    => <<~"EOF"
-    Indexing failed because of conflicting records for \$package.  Please
-    report the case to the PAUSE admins at modules\@perl.org.
-    EOF
+  body    => sub {
+    my ($arg) = @_;
+
+    _assert_args_present(db_conflict => $arg, [ qw(package_name) ]);
+
+    return <<~"EOF"
+      Indexing failed because of conflicting records for $arg->{package_name}.
+      Please report the case to the PAUSE admins at modules\@perl.org.
+      EOF
+  },
 };
 
 pkg_error db_error => {
-  # TODO bring back db error string?  seems weird -- rjbs, 2023-05-01
+  # Before PKGERROR existed, this would include the database error.  This felt
+  # like a bad idea to rjbs when he refactored, so he removed it.  Easy to
+  # re-add, if we want to, though!  -- rjbs, 2023-05-03
   header  => 'Not indexed because of database error',
   body    => <<~'EOF',
     The PAUSE indexer could not store the indexing result in the PAUSE
@@ -137,30 +154,49 @@ pkg_error db_error => {
 };
 
 pkg_error dual_newer => {
-  # TODO bring back parameters
   header  => 'Not indexed because of an newer dual-life module',
-  body    => <<~'EOF',
-    Not indexed because package $opack in file $ofile has a dual life in
-    $odist. The other version is at $oldversion, so not indexing seems okay.
-    EOF
+  body    => sub {
+    my ($old) = @_;
+
+    _assert_args_present(db_conflict => $old, [ qw(package file dist version) ]);
+
+    return <<~"EOF";
+      Not indexed because package $old->{pack} in file $old->{file} has a dual
+      life in $old->{dist}.  The other version is at $old->{version}, so not
+      indexing seems okay.
+      EOF
+  },
 };
 
 pkg_error dual_older => {
-  # TODO bring back parameters
   header  => 'Not indexed because of an older dual-life module',
-  body    => <<~'EOF',
-    Not indexed because package $opack in file $ofile seems to have a dual
-    life in $odist. Although the other package is at version [$oldversion],
-    the indexer lets the other dist continue to be the reference version,
-    shadowing the one in the core.  Maybe harmless, maybe needs resolving.
-    EOF
+  body    => sub {
+    my ($old) = @_;
+
+    _assert_args_present(db_conflict => $old, [ qw(package file dist version) ]);
+
+    return <<~"EOF";
+      Not indexed because package $old->{pack} in file $old->{file} seems to
+      have a dual life in $old->{dist}. Although the other package is at
+      version [$old->{version}], the indexer lets the other dist continue to
+      be the reference version, shadowing the one in the core.  Maybe
+      harmless, maybe needs resolving.
+      EOF
+  }
 };
 
 pkg_error mtime_fell => {
-  # TODO bring back ofile/odist in body
   header  => 'Release seems outdated',
-  body    => q{Not indexed because $ofile in $odist also has a zero version
-               number and the distro has a more recent modification time.},
+  body    => sub {
+    my ($old) = @_;
+
+    _assert_args_present(db_conflict => $old, [ qw(package file dist version) ]);
+
+    return <<~"EOF";
+      Not indexed because $old->{file} in $old->{dist} also has a zero version
+      number and the distro has a more recent modification time.
+      EOF
+  }
 };
 
 pkg_error no_permission => {
@@ -173,17 +209,33 @@ pkg_error no_permission => {
 };
 
 pkg_error version_fell => {
-  # TODO bring back "file in $dist", make the q{...} a qq{...}
   header => "Not indexed because of decreasing version number",
-  body   => q{Not indexed because $ofile in $odist has a higher version number
-              ($oldversion)},
+  body   => sub {
+    my ($old) = @_;
+
+    _assert_args_present(db_conflict => $old, [ qw(package file dist version) ]);
+
+    return <<~"EOF";
+      Not indexed because $old->{file} in $old->{dist} has a higher version
+      number ($old->{version})
+      EOF
+  }
 };
 
 pkg_error version_invalid => {
-  # TODO put back $version itself?  It's already in the report.
-  # -- rjbs, 2023-05-01
   header  => 'Not indexed because version is not a valid "lax version" string.',
-  body    => undef,
+  body   => sub {
+    my ($arg) = @_;
+
+    _assert_args_present(db_conflict => $arg, [ qw(version) ]);
+
+    return <<~"EOF";
+      The version present in the file, "$arg->{version}", is not a valid lax
+      version string.  You can read more in "perldoc version".  This
+      restriction would be enforced at compile time if you put your version
+      string within your package declaration.
+      EOF
+  }
 };
 
 pkg_error version_openerr => {
@@ -239,11 +291,16 @@ sub DISTERROR {
 }
 
 sub PKGERROR {
-  my ($ident) = @_;
+  my ($ident, $arg) = @_;
 
-  my $error = $PKG_ERROR{$ident};
-  unless ($error) {
-    Carp::confess("requested unknown package error: $ident");
+  my $template = $PKG_ERROR{$ident}
+    or Carp::confess("requested unknown package error: $ident");
+
+  my $error = { %$template };
+
+  if (ref $error->{body}) {
+    my $body = $error->{body}->($arg);
+    $error->{body} = $body;
   }
 
   return $error;
@@ -251,6 +308,7 @@ sub PKGERROR {
 
 sub dist_error {
   my ($name, $arg) = @_;
+
   $DIST_ERROR{$name} = {
     ident   => $name,
     public  => 1,
@@ -260,6 +318,7 @@ sub dist_error {
 
 sub pkg_error {
   my ($name, $arg) = @_;
+
   $PKG_ERROR{$name} = {
     ident   => $name,
     public  => 1,
diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index 3ababbbec..d9119e068 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -328,15 +328,15 @@ sub update_package {
     qw( package version dist filemtime file )
   };
 
-  $Logger->log([
-    "updating old package data: %s", {
-      package => $opack,
-      version => $oldversion,
-      dist    => $odist,
-      mtime   => $ofilemtime,
-      file    => $ofile,
-    }
-  ]);
+  my $old = {
+    package => $opack,
+    version => $oldversion,
+    dist    => $odist,
+    mtime   => $ofilemtime,
+    file    => $ofile,
+  };
+
+  $Logger->log([ "updating old package data: %s", $old ]);
 
   my $MLROOT = $self->mlroot;
   my $odistmtime = (stat "$MLROOT/$odist")[9];
@@ -409,7 +409,9 @@ sub update_package {
           opack       => $opack,
       });
   } elsif (defined $pp->{version} && ! version::is_lax($pp->{version})) {
-      $ctx->abort_indexing_package($self, PKGERROR('version_invalid'));
+      $ctx->abort_indexing_package($self, PKGERROR('version_invalid', {
+        version => $pp->{version}
+      }));
   } elsif (CPAN::Version->vgt($pp->{version},$oldversion)) {
       # higher VERSION here
       $Logger->log([
@@ -434,7 +436,7 @@ oldversion[$oldversion]
 pmfile[$pmfile]
 }); # });
 
-          $ctx->abort_indexing_package($self, PKGERROR('version_fell'));
+          $ctx->abort_indexing_package($self, PKGERROR('version_fell', $old));
       } elsif ($older_isa_regular_perl) {
           $ok++;          # new on 2002-08-01
       } else {
@@ -463,7 +465,7 @@ pmfile[$pmfile]
               ]);
               $ok++;
           } else {
-              $ctx->abort_indexing_package($self, PKGERROR('mtime_fell'));
+              $ctx->abort_indexing_package($self, PKGERROR('mtime_fell', $old));
           }
       } elsif (CPAN::Version->vcmp($pp->{version}, $oldversion)==0) {
           # equal version here
@@ -485,7 +487,7 @@ pmfile[$pmfile]
                   old     => { dist => $odist, mtime => $odistmtime },
                 },
               ]);
-              $ctx->abort_indexing_package($self, PKGERROR('mtime_fell'));
+              $ctx->abort_indexing_package($self, PKGERROR('mtime_fell', $old));
           }
       } else {
           $Logger->log(
@@ -577,6 +579,14 @@ sub __do_regular_perl_update {
       qw( package version dist filemtime file )
     };
 
+    my $old = {
+      package => $opack,
+      version => $oldversion,
+      dist    => $odist,
+      mtime   => $ofilemtime,
+      file    => $ofile,
+    };
+
     my $older_isa_regular_perl = $arg->{older_isa_regular_perl};
 
     my $odistmtime  = $arg->{odistmtime};
@@ -599,9 +609,9 @@ sub __do_regular_perl_update {
         }
     } else {
         if (CPAN::Version->vgt($pp->{version},$oldversion)) {
-            $ctx->abort_indexing_package($self, PKGERROR('dual_older'));
+            $ctx->abort_indexing_package($self, PKGERROR('dual_older', $old));
         } else {
-            $ctx->abort_indexing_package($self, PKGERROR('dual_newer'));
+            $ctx->abort_indexing_package($self, PKGERROR('dual_newer', $old));
         }
     }
 

From 7486d0bb3576f2e8188eaac17ae0069efc7df59f Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 3 May 2023 20:51:34 +0200
Subject: [PATCH 24/49] indexer: improve what we provide as overall status

---
 lib/PAUSE/dist.pm | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index bf18753bf..9378fb22f 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -348,10 +348,12 @@ sub _update_mail_content_when_things_were_indexed {
     my $Lstatus = 0;
     my $intro_written;
 
-    my $all_succeeded = @$statuses == grep {; $_->{is_success} } @$statuses;
+    my $successes = grep {; $_->{is_success} } @$statuses;
 
     unless (defined $$status_ref) {
-      $$status_ref = $all_succeeded ? "OK" : "Failed";
+      $$status_ref  = $successes == @$statuses  ? "OK"
+                    : $successes                ? "partially successful"
+                    :                             "Failed";
 
       push @$m_ref, "Status of this distro: $$status_ref\n";
       push @$m_ref, "="x(length($$status_ref)+23), "\n\n";

From 5c7a5819d34de2180b74a3bad2b9078acaea9290 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 3 May 2023 20:51:45 +0200
Subject: [PATCH 25/49] indexer: word wrap the "nothing updated" text

It just looks better!
---
 lib/PAUSE/dist.pm | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 9378fb22f..006151574 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -401,16 +401,20 @@ sub _update_mail_content_when_things_were_indexed {
 sub _update_mail_content_when_nothing_was_indexed {
     my ($self, $ctx, $m_ref, $status_ref) = @_;
 
+    my $tf = Text::Format->new(firstIndent=>0);
+
     if ($self->version_from_meta_ok($ctx)) {
-      push @$m_ref,  qq{Nothing in this distro has been \n}
-                  .  qq{indexed, because according to META.yml this\n}
-                  .  qq{package does not provide any modules.\n\n};
+      push @$m_ref, $tf->format(<<'EOF') . "\n";
+Nothing in this distro has been indexed, because according to META.yml this
+package does not provide any modules.
+EOF
 
       $$status_ref = "Empty_provides";
     } else {
-      push @$m_ref,  qq{No or no indexable package statements could be found\n}
-                  .  qq{in the distro (maybe a script or documentation\n}
-                  .  qq{distribution or a developer release?)\n\n};
+      push @$m_ref, $tf->format(<<'EOF') . "\n";
+No or no indexable package statements could be found in the distro (maybe a
+script or documentation distribution or a developer release?)
+EOF
 
       $$status_ref = "Empty_no_pm";
     }

From 4f9bb69b3cc2eabf735af3b2f56598500e336ada Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Mon, 6 May 2024 21:09:51 -0400
Subject: [PATCH 26/49] PAUSE::Indexer::Errors: make sure Carp is loaded, we
 use it!

---
 lib/PAUSE/Indexer/Errors.pm | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index ee48fa3ab..f42a43170 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -2,6 +2,8 @@ package PAUSE::Indexer::Errors;
 use v5.12.0;
 use warnings;
 
+use Carp ();
+
 use Sub::Exporter -setup => {
   exports => [ qw( DISTERROR PKGERROR ) ],
   groups  => { default => [ qw( DISTERROR PKGERROR ) ] },

From 28e0907fee3077987027ed752c23258e98eaece3 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Tue, 7 May 2024 21:20:08 -0400
Subject: [PATCH 27/49] PAUSE::Package: pass older_isa_regular_perl along

---
 lib/PAUSE/package.pm | 1 +
 1 file changed, 1 insertion(+)

diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index d9119e068..39016c14f 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -407,6 +407,7 @@ sub update_package {
           tdistmtime  => $tdistmtime,
           odistmtime  => $odistmtime,
           opack       => $opack,
+          older_isa_regular_perl => $older_isa_regular_perl,
       });
   } elsif (defined $pp->{version} && ! version::is_lax($pp->{version})) {
       $ctx->abort_indexing_package($self, PKGERROR('version_invalid', {

From 370e8d5a2f6af852a03799ada6421899649a095f Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Tue, 7 May 2024 21:21:17 -0400
Subject: [PATCH 28/49] PAUSE::Indexer::Context: make alert and error methods
 look the same

---
 lib/PAUSE/Indexer/Context.pm |  4 ++--
 lib/PAUSE/dist.pm            | 18 +++++++++---------
 lib/PAUSE/mldistwatch.pm     |  8 ++++----
 lib/PAUSE/package.pm         |  8 ++++----
 4 files changed, 19 insertions(+), 19 deletions(-)

diff --git a/lib/PAUSE/Indexer/Context.pm b/lib/PAUSE/Indexer/Context.pm
index 6cab85e9e..399fb8612 100644
--- a/lib/PAUSE/Indexer/Context.pm
+++ b/lib/PAUSE/Indexer/Context.pm
@@ -122,7 +122,7 @@ has alerts => (
   default => sub {  []  },
 );
 
-sub alert {
+sub add_alert {
   my ($self, $alert) = @_;
   $alert =~ s/\v+\z//;
 
@@ -152,7 +152,7 @@ sub add_dist_error {
   return $error;
 }
 
-sub dist_errors {
+sub all_dist_errors {
   my ($self) = @_;
   return $self->_dist_errors->@*;
 }
diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 006151574..0657bb925 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -175,7 +175,7 @@ sub untar {
   while (<TARTEST>) {
     if (m:^\.\./: || m:/\.\./: ) {
       $Logger->log("*** ALERT: updir detected!");
-      $ctx->alert("updir detected!");
+      $ctx->add_alert("updir detected!");
       $self->{COULD_NOT_UNTAR}++;
       return;
     }
@@ -186,7 +186,7 @@ sub untar {
   $self->{PERL_MAJOR_VERSION} = 5 unless defined $self->{PERL_MAJOR_VERSION};
   unless (close TARTEST) {
     $Logger->log("could not untar $dist!");
-    $ctx->alert("could not untar!");
+    $ctx->add_alert("could not untar!");
     $self->{COULD_NOT_UNTAR}++;
     return;
   }
@@ -253,7 +253,7 @@ sub _examine_regular_perl {
     $suffix = $1;
   } else {
     $Logger->log("perl distro ($dist) with an unusual suffix!");
-    $ctx->alert("perl distro ($dist) with an unusual suffix!");
+    $ctx->add_alert("perl distro ($dist) with an unusual suffix!");
   }
 
   unless ($skip) {
@@ -478,7 +478,7 @@ sub mail_summary {
 
   my $status_over_all;
 
-  my @dist_errors = $ctx->dist_errors;
+  my @dist_errors = $ctx->all_dist_errors;
 
   for my $error (@dist_errors) {
     my $header = $error->{header};
@@ -504,7 +504,7 @@ sub mail_summary {
     } else {
 
       # No files have status, no dist-wide errors.  Nothing to report!
-      return unless $pmfiles || $ctx->dist_errors;
+      return unless $pmfiles || $ctx->all_dist_errors;
 
       $self->_update_mail_content_when_nothing_was_indexed(
         $ctx,
@@ -594,7 +594,7 @@ sub check_blib {
       }
       last DIRDOWN unless $success; # no directory to step down anymore
       if (++$endless > 10) {
-        $ctx->alert("ENDLESS LOOP detected!");
+        $ctx->add_alert("ENDLESS LOOP detected!");
         last DIRDOWN;
       }
       next DIRDOWN;
@@ -721,7 +721,7 @@ sub _index_by_files {
 
   for my $pmfile (@$pmfiles) {
     if ($pmfile =~ m|/blib/|) {
-      $ctx->alert("blib directory detected ($pmfile)");
+      $ctx->add_alert("blib directory detected ($pmfile)");
       next;
     }
 
@@ -833,7 +833,7 @@ sub examine_pms {
   if ($indexing_method) {
     $self->$indexing_method($ctx, $pmfiles, $provides);
   } else {
-    $ctx->alert("Couldn't determine an indexing method!");
+    $ctx->add_alert("Couldn't determine an indexing method!");
   }
 }
 
@@ -1189,7 +1189,7 @@ sub p6_index_dist {
   }
   unless (close TARTEST) {
     $Logger->log("could not untar!");
-    $ctx->alert("Could not untar!");
+    $ctx->add_alert("Could not untar!");
     $self->{COULD_NOT_UNTAR}++;
     return "ERROR: Could not untar $dist!";
   }
diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index f04d21b3e..867afd928 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -359,14 +359,14 @@ sub _do_the_database_work {
     if ($dio->perl_major_version == 6) {
       if ($dio->p6_dist_meta_ok) {
         if (my $err = $dio->p6_index_dist($ctx)) {
-          $ctx->alert($err);
+          $ctx->add_alert($err);
           $dbh->rollback;
         } else {
           $dbh->commit;
         }
       }
       else {
-        $ctx->alert("Meta information of Perl 6 dist is invalid");
+        $ctx->add_alert("Meta information of Perl 6 dist is invalid");
         $dbh->rollback;
       }
 
@@ -383,7 +383,7 @@ sub _do_the_database_work {
 
       $dbh->commit;
     } else {
-      $ctx->alert("Uploading user has no permissions on package $main_pkg");
+      $ctx->add_alert("Uploading user has no permissions on package $main_pkg");
       $ctx->add_dist_error(DISTERROR('no_distname_permission'));
       $dbh->rollback;
     }
@@ -507,7 +507,7 @@ sub maybe_index_dist {
       $self->disconnect;
       if ($attempt == 3) {
         $Logger->log_debug("tried $attempt times to do db work, but all failed");
-        $ctx->alert("database errors while indexing");
+        $ctx->add_alert("database errors while indexing");
         $ctx->add_dist_error(DISTERROR('xact_fail'));
       }
     }
diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index 39016c14f..774544d65 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -161,7 +161,7 @@ sub assert_permissions_okay {
 
           my $error   = "not owner";
 
-          $ctx->alert(qq{$error:
+          $ctx->add_alert(qq{$error:
 package[$package]
 version[$pp->{version}]
 file[$pp->{infile}]
@@ -302,7 +302,7 @@ sub assert_version_ok {
 
     return if length $self->{PP}{version} <= 16;
 
-    $ctx->alert(qq{version string was too long:
+    $ctx->add_alert(qq{version string was too long:
 package[$self->{PACKAGE}]
 version[$self->{PP}{version}]
 file[$self->{PP}{infile}]
@@ -430,7 +430,7 @@ sub update_package {
       if ($odist ne $dist) {
           delete $self->dist->{CHECKINS}{ lc $package }{ $package };
 
-          $ctx->alert(qq{decreasing VERSION number [$pp->{version}]
+          $ctx->add_alert(qq{decreasing VERSION number [$pp->{version}]
 in package[$package]
 dist[$dist]
 oldversion[$oldversion]
@@ -442,7 +442,7 @@ pmfile[$pmfile]
           $ok++;          # new on 2002-08-01
       } else {
           # we get a different result now than we got in a previous run
-          $ctx->alert("Taking back previous version calculation. odist[$odist]oversion[$oldversion]dist[$dist]version[$pp->{version}].");
+          $ctx->add_alert("Taking back previous version calculation. odist[$odist]oversion[$oldversion]dist[$dist]version[$pp->{version}].");
           $ok++;
       }
   } else {

From 52c1207a44ccd7b6f5375d987f843b50ba62207c Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 11 May 2024 09:50:17 -0400
Subject: [PATCH 29/49] PAUSE::Indexer::Context: log package errors when
 setting them

---
 lib/PAUSE/Indexer/Context.pm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/lib/PAUSE/Indexer/Context.pm b/lib/PAUSE/Indexer/Context.pm
index 399fb8612..52ef99568 100644
--- a/lib/PAUSE/Indexer/Context.pm
+++ b/lib/PAUSE/Indexer/Context.pm
@@ -56,8 +56,9 @@ sub _set_package_error {
   };
 
   $Logger->log([
-    "set error status for %s",
+    "set error status for %s to %s",
     $package_obj->{PACKAGE},
+    $status,
   ]);
 
   return;

From 851486c9253404b2218f6abf8671f63d6f4e0ef3 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 11 May 2024 09:55:40 -0400
Subject: [PATCH 30/49] PAUSE::package: remove dead, commented-out code

I had commented out some code so that we would only check in a package
update if we were in an OK state.  That is no longer needed, because if
we are not in an OK state, we will have thrown an exception.

Removing the commented-out code just makes things easier to skim.
---
 lib/PAUSE/package.pm | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index 774544d65..aa9edd7ac 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -743,10 +743,7 @@ sub checkin {
       $self->insert_into_package($ctx);
   }
 
-  # my $status = $self->get_index_status_status($ctx);
-  # if (! $status or $status == PAUSE::mldistwatch::Constants::OK) {
-      $self->checkin_into_primeur($ctx); # called in void context!
-  # }
+  $self->checkin_into_primeur($ctx); # called in void context!
 
   return;
 }

From b9e0cfd4aa406b21f4bf5131f8fa4719a84801dd Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 11 May 2024 20:14:12 -0400
Subject: [PATCH 31/49] Mock::Dist: remove this unused code

---
 t/lib/Mock/Dist.pm | 42 ------------------------------------------
 1 file changed, 42 deletions(-)
 delete mode 100644 t/lib/Mock/Dist.pm

diff --git a/t/lib/Mock/Dist.pm b/t/lib/Mock/Dist.pm
deleted file mode 100644
index 1c6231d1f..000000000
--- a/t/lib/Mock/Dist.pm
+++ /dev/null
@@ -1,42 +0,0 @@
-use strict;
-use warnings;
-
-package Mock::Dist;
-
-use base qw(Test::MockObject);
-use Test::More ();
-use Test::Deep ();
-
-my $null = sub {};
-
-my @NULL = qw(verbose connect disconnect mlroot index_packages);
-
-my %ALWAYS = (
-  version_from_meta_ok => 1,
-);
-
-sub new {
-  my $self = shift->SUPER::new(@_);
-
-  $self->mock($_ => $null) for @NULL;
-
-  $self->set_always($_ => $ALWAYS{$_}) for keys %ALWAYS;
-
-  return $self;
-}
-
-sub next_call_ok {
-  my ($self, $method, $args, $label) = @_;
-  unless ($label) {
-    $label = "$method: " . join ", ", @$args;
-    $label =~ s/\n$//;
-    $label =~ s/\n.+$/.../s;
-  }
-  Test::Deep::cmp_deeply(
-    [ $self->next_call ],
-    [ $method => [ $self, @$args ] ],
-    $label,
-  );
-}
-
-1;

From fdf0b30891ba2b152149fb1c3082dd96f9418286 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 11:01:52 -0400
Subject: [PATCH 32/49] PAUSE::Indexer::Errors: fix keys from $old

We pass "package" and not "pack".
---
 lib/PAUSE/Indexer/Errors.pm | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index f42a43170..1225b4f2f 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -163,9 +163,9 @@ pkg_error dual_newer => {
     _assert_args_present(db_conflict => $old, [ qw(package file dist version) ]);
 
     return <<~"EOF";
-      Not indexed because package $old->{pack} in file $old->{file} has a dual
-      life in $old->{dist}.  The other version is at $old->{version}, so not
-      indexing seems okay.
+      Not indexed because package $old->{package} in file $old->{file} has a
+      dual life in $old->{dist}.  The other version is at $old->{version}, so
+      not indexing seems okay.
       EOF
   },
 };
@@ -178,8 +178,8 @@ pkg_error dual_older => {
     _assert_args_present(db_conflict => $old, [ qw(package file dist version) ]);
 
     return <<~"EOF";
-      Not indexed because package $old->{pack} in file $old->{file} seems to
-      have a dual life in $old->{dist}. Although the other package is at
+      Not indexed because package $old->{package} in file $old->{file} seems
+      to have a dual life in $old->{dist}. Although the other package is at
       version [$old->{version}], the indexer lets the other dist continue to
       be the reference version, shadowing the one in the core.  Maybe
       harmless, maybe needs resolving.

From 3f6529abb815ba4d099fe9f8b8008618d91fb3f7 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 11:33:35 -0400
Subject: [PATCH 33/49] PAUSE::Indexer::Context: make add_dist_error only
 accept refs

The old code would promote a string to a hashref, but it did it badly.
Even when done correctly, the code in abort_indexing_dist would look for
$error->{message}, but when passing a DISTERROR result, there was none.
This was just general confusion.

Now, ->abort_indexing_dist, and thus ->add_dist_error, expect a hashref
with, at minimum, a "header" value.
---
 lib/PAUSE/Indexer/Context.pm | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/lib/PAUSE/Indexer/Context.pm b/lib/PAUSE/Indexer/Context.pm
index 52ef99568..785c87933 100644
--- a/lib/PAUSE/Indexer/Context.pm
+++ b/lib/PAUSE/Indexer/Context.pm
@@ -145,12 +145,13 @@ has dist_errors => (
 sub add_dist_error {
   my ($self, $error) = @_;
 
-  $error = ref $error ? $error : { ident => $error, message => $error };
+  $Logger->log_fatal([ "add_dist_error got bogus input: %s", $error ])
+    unless ref $error and $error->{header};
 
-  $Logger->log("adding dist error: " . ($error->{ident} // $error->{message}));
+  $Logger->log([ "adding dist error: %s", $error->{header} ]);
   push $self->_dist_errors->@*, $error;
 
-  return $error;
+  return;
 }
 
 sub all_dist_errors {
@@ -161,10 +162,10 @@ sub all_dist_errors {
 sub abort_indexing_dist {
   my ($self, $error) = @_;
 
-  $error = $self->add_dist_error($error);
+  $self->add_dist_error($error);
 
   die PAUSE::Indexer::Abort::Dist->new({
-    message => $error->{message},
+    message => $error->{header},
     public  => $error->{public},
   });
 }

From 2ea7aaee0ebf8376550eeea0e0450004c8185a02 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 11:36:49 -0400
Subject: [PATCH 34/49] PAUSE::Indexer::Context: pass hashrefs to
 abort_indexing_dist

Now that abort_indexing_dist must be passed a hashref, fix all the
calling code to do so.

This has the side-effect of making all these errors public.  That's okay
because:

1.  we were ignoring "public" anyway!
2.  they're all reasonable to show the user
---
 lib/PAUSE/Indexer/Errors.pm | 47 +++++++++++++++++++++++++++++++++++++
 lib/PAUSE/dist.pm           | 10 ++++----
 t/mldistwatch-misc.t        |  4 ++--
 t/mldistwatch-perl.t        |  2 +-
 4 files changed, 55 insertions(+), 8 deletions(-)

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index 1225b4f2f..6351414e8 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -83,6 +83,35 @@ dist_error no_meta => {
     EOF
 };
 
+dist_error not_a_dist => {
+  header  => 'file does not appear to be a CPAN distribution',
+  body    => <<~'EOF',
+    The file you uploaded doesn't appear to be a CPAN distribution.  Usually
+    that means you didn't upload a .tar.gz or .zip file.  At any rate, PAUSE
+    can't index it.
+    EOF
+};
+
+dist_error perl_unofficial => {
+  header  => 'perl-like archive rejected',
+  body    => <<~'EOF',
+    The archive you uploaded has a name starting with "perl-", but doesn't
+    appear to be an authorized release of Perl.  Pick a different name.  If
+    you're doing an authorized Perl release and you see this error, contact
+    the PAUSE admins!
+    EOF
+};
+
+dist_error perl_rejected => {
+  header  => 'perl release archive rejected',
+  body    => <<~'EOF',
+    The archive you uploaded looks like it's meant to be a release of Perl
+    itself. It won't be indexed, either because you don't have permission to
+    release Perl, or because it looks weird in some way.  If you're doing an
+    authorized Perl release and you see this error, contact the PAUSE admins!
+    EOF
+};
+
 dist_error single_pm => {
   header  => 'dist is a single-.pm-file upload',
   body    => <<~"EOF",
@@ -92,6 +121,16 @@ dist_error single_pm => {
     EOF
 };
 
+dist_error untar_failure => {
+  header => "archive couldn't be untar-ed",
+  body   => <<~"EOF",
+    You uploaded a tar archive, but PAUSE can't untar it to index the
+    contents. This is pretty unusual!  Maybe you named a zip file "tar.gz" by
+    accident. Maybe you're using a weird (and possibly broken) version of tar.
+    At any rate, PAUSE can't index this archive.
+    EOF
+};
+
 dist_error unstable_release => {
   header  => 'META release_status is not stable',
   body    => <<~'EOF',
@@ -100,6 +139,14 @@ dist_error unstable_release => {
     EOF
 };
 
+dist_error version_dev => {
+  header  => 'release has trial-release version',
+  body    => <<~'EOF',
+    The uploaded filename contains an underscore ("_") or the string "-TRIAL",
+    indicating that it shouldn't be indexed.
+    EOF
+};
+
 dist_error worldwritable => {
   header  => 'archive has world writable files',
   body    => sub {
diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 0657bb925..3dfb121b1 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -283,7 +283,7 @@ sub examine_dist {
     $self->{SUFFIX} = $suffix;
 
     if ($skip) {
-      $ctx->abort_indexing_dist("won't process regular perl upload");
+      $ctx->abort_indexing_dist(DISTERROR('perl_rejected'));
     }
 
     return;
@@ -291,18 +291,18 @@ sub examine_dist {
 
   if ($self->isa_dev_version) {
     $self->{SUFFIX} = "N/A";
-    $ctx->abort_indexing_dist("dist is a developer release");
+    $ctx->abort_indexing_dist(DISTERROR('version_dev'));
   }
 
   if ($dist =~ m|/perl-\d+|) {
     $self->{SUFFIX} = "N/A";
-    $ctx->abort_indexing_dist("dist is an unofficial perl-like release");
+    $ctx->abort_indexing_dist(DISTERROR('perl_unofficial'));
   }
 
   if ($dist =~ $SUFFQR) {
     $self->{SUFFIX} = $1;
     unless ($self->untar($ctx)) {
-      $ctx->abort_indexing_dist("can't untar archive");
+      $ctx->abort_indexing_dist(DISTERROR('untar_failure'));
     }
   } elsif ($dist =~ /\.pm\.(?:Z|gz|bz2)$/) {
     $self->{SUFFIX} = "N/A";
@@ -321,7 +321,7 @@ sub examine_dist {
       # system("$unzipbin -t $MLROOT/$dist");
     }
   } else {
-    $ctx->abort_indexing_dist("file does not appear to be a CPAN distribution");
+    $ctx->abort_indexing_dist(DISTERROR('not_a_dist'));
   }
 
   return;
diff --git a/t/mldistwatch-misc.t b/t/mldistwatch-misc.t
index 8293ce956..df81a3c8b 100644
--- a/t/mldistwatch-misc.t
+++ b/t/mldistwatch-misc.t
@@ -569,7 +569,7 @@ subtest "do not index dists without META file" => sub {
   );
 };
 
-subtest "do not index dists without trial versions" => sub {
+subtest "do not index dists with trial versions" => sub {
   for my $test (
     { desc => "low line in version", munger => sub { $_[0] =~ s/22/2_2/r } },
     { desc => "TRIAL in version",    munger => sub { $_[0] =~ s/22/22-TRIAL/r } },
@@ -595,7 +595,7 @@ subtest "do not index dists without trial versions" => sub {
       $result->assert_index_not_updated;
 
       $result->logged_event_like(
-        qr{\Qdist is a developer release},
+        qr{\Qtrial-release version},
         "we do not index trial-like filenames",
       );
     };
diff --git a/t/mldistwatch-perl.t b/t/mldistwatch-perl.t
index ef0a0f064..6956db2ef 100644
--- a/t/mldistwatch-perl.t
+++ b/t/mldistwatch-perl.t
@@ -33,7 +33,7 @@ subtest "perl-\\d should not get indexed (not really perl)" => sub {
   # TODO: send a report saying 'no perl-X allowed'
 
   $result->logged_event_like(
-    qr{dist is an unofficial perl-like release},
+    qr{perl-like archive rejected},
     "perl-6.tar.gz is not a really perl-like file",
   );
 };

From 963b406a84bc7e06ce20484be4e39f6bb5882dc9 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 11:39:27 -0400
Subject: [PATCH 35/49] PAUSE::dist: do not include private errors in report

This case doesn't come up yet, and wasn't handled properly.  This code
will better handle private errors, and also errors with a header and no
body.
---
 lib/PAUSE/dist.pm | 18 +++++++++++++++---
 1 file changed, 15 insertions(+), 3 deletions(-)

diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 3dfb121b1..e092bb03d 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -483,10 +483,22 @@ sub mail_summary {
   for my $error (@dist_errors) {
     my $header = $error->{header};
     my $body   = $error->{body};
-    $body = $body->($self) if ref $body;
 
-    push @m, "## $header\n\n";
-    push @m, $tf->format($body), qq{\n\n};
+    if ($error->{public}) {
+      $body = $body->($self) if ref $body;
+
+      unless ($body) {
+        $Logger->log([
+          "encountered dist error with no body: %s",
+          $error->{header},
+        ]);
+
+        $body = "No further information about this error is available.";
+      }
+
+      push @m, "## $header\n\n";
+      push @m, $tf->format($body), qq{\n\n};
+    }
 
     $status_over_all = "Failed";
   }

From 881c93352dd7dd3fcc5b3d8f2a7ac0b45b5b5fc8 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 11:55:05 -0400
Subject: [PATCH 36/49] PAUSE::DBError: use block-style package

This makes it easier to see that subs in this file are not part of the
top-level package.
---
 lib/PAUSE.pm | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/lib/PAUSE.pm b/lib/PAUSE.pm
index 17574a341..d256049bb 100644
--- a/lib/PAUSE.pm
+++ b/lib/PAUSE.pm
@@ -562,17 +562,17 @@ sub may_overwrite_file {
   return;
 }
 
-package PAUSE::DBError;
+package PAUSE::DBError {
+  sub new {
+      my ($class, $msg) = @_;
+      return bless \$msg, $class;
+  }
 
-sub new {
-    my ($class, $msg) = @_;
-    return bless \$msg, $class;
+  use overload (
+      '""' => sub { ${$_[0]} }
+  );
 }
 
-use overload (
-    '""' => sub { ${$_[0]} }
-);
-
 1;
 
 # Local Variables:

From aa70f352e5364140eb68cb2ac087d77a59a47b3f Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 12:03:08 -0400
Subject: [PATCH 37/49] PAUSE.pm: move email sending into PAUSE.pm

Right now, this has no effect, but it will give us a place to put extra
diagnostic tooling for collecting mail from test runs.
---
 lib/PAUSE.pm             | 7 +++++++
 lib/PAUSE/dist.pm        | 3 +--
 lib/PAUSE/mldistwatch.pm | 3 +--
 3 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/lib/PAUSE.pm b/lib/PAUSE.pm
index d256049bb..6b037ea81 100644
--- a/lib/PAUSE.pm
+++ b/lib/PAUSE.pm
@@ -16,6 +16,7 @@ use File::Basename ();
 use Compress::Zlib ();
 use Cwd ();
 use DBI ();
+use Email::Sender::Simple ();
 use Exporter;
 use Fcntl qw(:flock);
 my $HAVE_RECENTFILE = eval {require File::Rsync::Mirror::Recentfile; 1;};
@@ -562,6 +563,12 @@ sub may_overwrite_file {
   return;
 }
 
+sub sendmail {
+  my ($self, $email) = @_;
+
+  Email::Sender::Simple->send($email);
+}
+
 package PAUSE::DBError {
   sub new {
       my ($class, $msg) = @_;
diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index e092bb03d..4ba623c24 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -3,7 +3,6 @@ use warnings;
 package PAUSE::dist;
 use vars qw(%CHECKSUMDONE $AUTOLOAD);
 
-use Email::Sender::Simple qw(sendmail);
 use File::Copy ();
 use List::MoreUtils ();
 use PAUSE ();
@@ -571,7 +570,7 @@ sub _send_email {
         body_str => join(q{}, @$lines),
     );
 
-    sendmail($email);
+    PAUSE->sendmail($email);
 
     $Logger->log("sent indexer report email");
 }
diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index 867afd928..fa9deb503 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -16,7 +16,6 @@ use DirHandle ();
 use Dumpvalue ();
 use DynaLoader ();
 use Email::MIME;
-use Email::Sender::Simple qw(sendmail);
 use Exporter ();
 use ExtUtils::MakeMaker ();
 use ExtUtils::Manifest;
@@ -605,7 +604,7 @@ sub handle_alerts {
         body_str => $body_str,
     );
 
-    sendmail($email);
+    PAUSE->sendmail($email);
 
     return;
 }

From 62a6c4a9f137df839c4bbbe0b87dd0e41b2cd2dc Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 12:27:35 -0400
Subject: [PATCH 38/49] PAUSE.pm: add "write mail to mbox" facility

...then I used this to get all the emails produced by the mldistwatch
tests to inspect in my MUA!
---
 lib/PAUSE.pm | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/lib/PAUSE.pm b/lib/PAUSE.pm
index 6b037ea81..c025c0568 100644
--- a/lib/PAUSE.pm
+++ b/lib/PAUSE.pm
@@ -566,6 +566,22 @@ sub may_overwrite_file {
 sub sendmail {
   my ($self, $email) = @_;
 
+  if ($ENV{PAUSE_TEST_MAIL_MBOX}) {
+    # This is here for extra testing.  If you set this to a filename, every
+    # email will be written to this mbox.  Make sure it's an *absolute* path,
+    # because the tests change directory. -- rjbs, 2024-06-22
+
+    require Email::Sender::Transport::Mbox;
+    state $mbox = Email::Sender::Transport::Mbox->new({
+      filename => $ENV{PAUSE_TEST_MAIL_MBOX},
+    });
+
+    $mbox->send_email(Email::Abstract->new($email), {
+      from => 'test-system',
+      to   => 'test-system',
+    });
+  }
+
   Email::Sender::Simple->send($email);
 }
 

From 5ab3bcb393d72d7cefb7ea6afa1a850071f6c416 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 13:12:05 -0400
Subject: [PATCH 39/49] indexer: add tests for "nothing to index" email

---
 t/mldistwatch-misc.t | 46 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 46 insertions(+)

diff --git a/t/mldistwatch-misc.t b/t/mldistwatch-misc.t
index df81a3c8b..9b9a77008 100644
--- a/t/mldistwatch-misc.t
+++ b/t/mldistwatch-misc.t
@@ -679,6 +679,52 @@ subtest "the notorious version zero" => sub {
   }
 };
 
+subtest "indexer ran, but nothing indexed" => sub {
+  # This is to test the weird _update_mail_content_when_nothing_was_indexed
+  # case in PAUSE::dist.
+  my $pause = PAUSE::TestPAUSE->init_new;
+
+  {
+    # If we want to upload an Empty-Dist-2.0 with no packages, we need the
+    # uploader to have permissions on Empty::Dist, so we will first upload
+    # Empty-Dist-1.0 with the expected package.
+    $pause->upload_author_fake(CBROWN => 'Empty-Dist-1.0.tar.gz');
+
+    my $result = $pause->test_reindex;
+  }
+
+  my $file = $pause->upload_author_fake(CBROWN => {
+    name      => 'Empty-Dist',
+    version   => '2.0',
+    meta_munger => sub {
+      my ($meta) = @_;
+      $meta->{provides} = {};
+      return $meta;
+    }
+  });
+
+  my $result = $pause->test_reindex;
+
+  # Nothing in this distro has been indexed, because according to META.yml
+  # this package does not provide any modules.
+  $result->email_ok(
+    [
+      {
+        subject  => 'Failed: PAUSE indexer report CBROWN/Empty-Dist-2.0.tar.gz',
+        callbacks => [
+          sub {
+            like(
+              $_[0]{email}->object->body_str,
+              qr/this package does not provide any modules/,
+              "email has the expected content",
+            );
+          },
+        ],
+      },
+    ],
+  );
+};
+
 done_testing;
 
 # Local Variables:

From 00dcfea44333d1b9e00d546bc0ce77ac75204315 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 13:12:43 -0400
Subject: [PATCH 40/49] indexer: be more precise in "nothing to index" email
 text

---
 lib/PAUSE/dist.pm    | 4 ++--
 t/mldistwatch-misc.t | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 4ba623c24..c4532eb58 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -404,8 +404,8 @@ sub _update_mail_content_when_nothing_was_indexed {
 
     if ($self->version_from_meta_ok($ctx)) {
       push @$m_ref, $tf->format(<<'EOF') . "\n";
-Nothing in this distro has been indexed, because according to META.yml this
-package does not provide any modules.
+Nothing in this distribution has been indexed, because according to META.yml
+this distribution does not provide any packages.
 EOF
 
       $$status_ref = "Empty_provides";
diff --git a/t/mldistwatch-misc.t b/t/mldistwatch-misc.t
index 9b9a77008..7c4b49b7d 100644
--- a/t/mldistwatch-misc.t
+++ b/t/mldistwatch-misc.t
@@ -715,7 +715,7 @@ subtest "indexer ran, but nothing indexed" => sub {
           sub {
             like(
               $_[0]{email}->object->body_str,
-              qr/this package does not provide any modules/,
+              qr/this distribution does not provide any packages/,
               "email has the expected content",
             );
           },

From 975c2656a4df149963f5f94e70e8983de3d612f0 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 11 Oct 2026 12:44:09 -0400
Subject: [PATCH 41/49] PAUSE::pmfile: keep packages that pass all no_index
 rules

When filter_ppps was simplified, the push of a surviving package ended
up inside the loop over rule types.  So a package was kept once for
each rule type it didn't match, and dropped entirely when there were no
package or namespace rules (for example, when no_index had only
directory rules, as ExtUtils::MakeMaker writes by default).  It was
also kept if it passed the package rules but matched a namespace rule.

Now we push it once, after checking every rule type.

Co-Authored-By: Claude <noreply@anthropic.com>
---
 lib/PAUSE/pmfile.pm | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/lib/PAUSE/pmfile.pm b/lib/PAUSE/pmfile.pm
index 7215148dd..dc73d4f2b 100644
--- a/lib/PAUSE/pmfile.pm
+++ b/lib/PAUSE/pmfile.pm
@@ -83,9 +83,9 @@ sub filter_ppps {
                     $Logger->log_debug("no_index rule on $type $rule; NOT skipping $pkg");
                 }
             }
-
-            push @res, $pkg;
         }
+
+        push @res, $pkg;
     }
 
     return @res;

From 8a4a378adbae07cf4a92121458b1af0ec931cb81 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 11 Oct 2026 12:44:33 -0400
Subject: [PATCH 42/49] PAUSE::package: abort a bad package name with a real
 package error

examine_pkg passed the string "invalid package name" to
abort_indexing_package, which wants an error hashref.  Dereferencing the
string died, and since that wasn't an Abort::Package exception, it
escaped the indexer entirely, ending the whole run.  Any dist whose META
"provides" named a malformed package could do this.

Use the bad_package_name error, which existed for this but was unused.

Co-Authored-By: Claude <noreply@anthropic.com>
---
 lib/PAUSE/package.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index aa9edd7ac..9c3b6bcda 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -249,7 +249,7 @@ sub examine_pkg {
   # should they be cought earlier? Maybe.
   # but as an ultimate sanity check suggested by Richard Soderberg
   if ($self->_pkg_name_insane($ctx)) {
-      $ctx->abort_indexing_package($self, "invalid package name");
+      $ctx->abort_indexing_package($self, PKGERROR('bad_package_name'));
   }
 
   # Query all users with perms for this package

From 3ee1a2977e126c4ee46aee43145c6526df7e5742 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 11 Oct 2026 12:45:24 -0400
Subject: [PATCH 43/49] indexer: only call ->isa on abort exceptions that are
 objects

When an eval around indexing fails, we rethrow anything that isn't the
Abort exception we expect.  If $@ was an unblessed reference, calling
->isa on it died with "Can't call method isa on unblessed reference",
hiding the real error.  Check blessed first.

Co-Authored-By: Claude <noreply@anthropic.com>
---
 lib/PAUSE/dist.pm        | 4 +++-
 lib/PAUSE/mldistwatch.pm | 4 +++-
 2 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index c4532eb58..39a982243 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -11,6 +11,7 @@ use PAUSE::package ();
 use PAUSE::mldistwatch::Constants;
 use PAUSE::Indexer::Errors;
 use JSON::XS ();
+use Scalar::Util ();
 
 use PAUSE::Logger '$Logger';
 
@@ -810,7 +811,8 @@ sub index_packages {
     PACKAGE: for my $pkg (@$packages) {
         unless (eval { $pkg->examine_pkg($ctx); 1 }) {
             my $abort = $@;
-            die $abort unless $abort->isa('PAUSE::Indexer::Abort::Package');
+            die $abort
+              unless Scalar::Util::blessed($abort) && $abort->isa('PAUSE::Indexer::Abort::Package');
 
             next PACKAGE;
         }
diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index fa9deb503..3a91f654f 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -44,6 +44,7 @@ use PAUSE::MailAddress ();
 use PAUSE::PermsManager ();
 use Process::Status ();
 use Safe;
+use Scalar::Util ();
 use Text::Format;
 
 $Data::Dumper::Indent = 1;
@@ -488,7 +489,8 @@ sub maybe_index_dist {
 
     unless ($examine_dist_ok) {
         my $abort = $@;
-        die $abort unless $abort->isa('PAUSE::Indexer::Abort::Dist');
+        die $abort
+          unless Scalar::Util::blessed($abort) && $abort->isa('PAUSE::Indexer::Abort::Dist');
 
         delete $self->{ALLlasttime}{$dist};
         delete $self->{ALLfound}{$dist};

From 79f1a515e9f80e8e2fd07fcd4254b536223613cd Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 11 Oct 2026 12:49:01 -0400
Subject: [PATCH 44/49] indexer: reject distribution_type "script" dists with a
 report

When the distribution_type check moved into check_indexability, its
"return" stopped skipping the dist and only left check_indexability, so
script dists got indexed.  Now the check aborts indexing with a new
script_dist error.

This also changes behavior from before the refactor: previously, script
dists were skipped silently, but now the author gets a failure report
explaining why nothing was indexed.

Co-Authored-By: Claude <noreply@anthropic.com>
---
 lib/PAUSE/Indexer/Errors.pm | 10 ++++++++++
 lib/PAUSE/dist.pm           |  2 +-
 t/distribution-type.t       |  2 +-
 3 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index 6351414e8..3300cca44 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -112,6 +112,16 @@ dist_error perl_rejected => {
     EOF
 };
 
+dist_error script_dist => {
+  header  => 'META distribution_type is "script"',
+  body    => <<~'EOF',
+    Your META file says that this distribution's distribution_type is
+    "script", meaning that it's a program to run rather than a library, so
+    PAUSE will not index its packages.  The distribution_type field is
+    deprecated, so you can probably just remove it.
+    EOF
+};
+
 dist_error single_pm => {
   header  => 'dist is a single-.pm-file upload',
   body    => <<~"EOF",
diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 39a982243..6474bf304 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -988,7 +988,7 @@ sub check_indexability {
     my ($self, $ctx) = @_;
     if ($self->{META_CONTENT}{distribution_type}
         && $self->{META_CONTENT}{distribution_type} =~ m/^(script)$/) {
-        return;
+        $ctx->abort_indexing_dist(DISTERROR('script_dist'));
     }
 
     $Logger->log([
diff --git a/t/distribution-type.t b/t/distribution-type.t
index 5f6a398ea..4171cd9e6 100644
--- a/t/distribution-type.t
+++ b/t/distribution-type.t
@@ -42,7 +42,7 @@ distribution_type_ok(
 
 distribution_type_ok(
   script => [],
-  [],
+  [ 'Failed: PAUSE indexer report PERSON/Foo-Bar-1.000.tar.gz' ],
 );
 
 done_testing;

From a40870031a2b39a3e899082325f4c063f93b51c2 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 11 Oct 2026 12:52:20 -0400
Subject: [PATCH 45/49] indexer: don't send failure reports for trial releases

Every dist error was public, so the refactor started sending a failure
report for every skipped upload, including all trial releases.  Before
the refactor, several skips (trial releases, non-dist files, perl-like
archives from non-pumpkings, untar failures) sent no report at all.

Trial releases go back to being silent.  The others now send a report,
which is a deliberate change: the uploader should find out why nothing
was indexed.  Later, we may want a gentler "declined" report for some of
these, rather than "Failed".

Co-Authored-By: Claude <noreply@anthropic.com>
---
 lib/PAUSE/Indexer/Errors.pm | 3 +++
 t/skip-reports.t            | 8 ++++++--
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index 3300cca44..d462375b0 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -150,6 +150,9 @@ dist_error unstable_release => {
 };
 
 dist_error version_dev => {
+  # Trial releases are deliberately unindexed, so we don't send the uploader a
+  # failure report about them.
+  public  => 0,
   header  => 'release has trial-release version',
   body    => <<~'EOF',
     The uploaded filename contains an underscore ("_") or the string "-TRIAL",
diff --git a/t/skip-reports.t b/t/skip-reports.t
index ce3a38cd7..2d84e0dce 100644
--- a/t/skip-reports.t
+++ b/t/skip-reports.t
@@ -31,7 +31,11 @@ sub skipped_upload_reports_ok ($new_basename, $want_subjects) {
 
 skipped_upload_reports_ok('Just-Testing-1.2_2.tar.gz',     []);
 skipped_upload_reports_ok('Just-Testing-1.22-TRIAL.tar.gz', []);
-skipped_upload_reports_ok('Just-Testing-1.22.txt',         []);
-skipped_upload_reports_ok('perl-5.99.0.tar.gz',            []);
+skipped_upload_reports_ok('Just-Testing-1.22.txt', [
+  'Failed: PAUSE indexer report PERSON/Just-Testing-1.22.txt',
+]);
+skipped_upload_reports_ok('perl-5.99.0.tar.gz', [
+  'Failed: PAUSE indexer report PERSON/perl-5.99.0.tar.gz',
+]);
 
 done_testing;

From 7ecfe3a22ca1534213eaada111d710e4e448d0e7 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 11 Oct 2026 14:36:13 -0400
Subject: [PATCH 46/49] PAUSE::package: drop dead args to
 __do_regular_perl_update

Nothing used these anymore.
---
 lib/PAUSE/package.pm | 2 --
 1 file changed, 2 deletions(-)

diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index 9c3b6bcda..9a081474d 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -403,10 +403,8 @@ sub update_package {
 
   if ($isa_regular_perl) {
       $ok = $self->__do_regular_perl_update($ctx, $row, {
-          oldversion  => $oldversion,
           tdistmtime  => $tdistmtime,
           odistmtime  => $odistmtime,
-          opack       => $opack,
           older_isa_regular_perl => $older_isa_regular_perl,
       });
   } elsif (defined $pp->{version} && ! version::is_lax($pp->{version})) {

From 8d5b000703e616a2b6ca011c974449bbe3891ab7 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Tue, 20 Oct 2026 19:18:06 -0400
Subject: [PATCH 47/49] PAUSE::Indexer::Errors: name the right error when
 arguments are missing

Each package error's body checks for the arguments it needs with
_assert_args_present, passing its own name so the failure message can
say which error was missing them.  Five of them passed "db_conflict"
instead, so a missing argument for, say, version_fell would be reported
as a problem with db_conflict.

Co-Authored-By: Claude <noreply@anthropic.com>
---
 lib/PAUSE/Indexer/Errors.pm | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index d462375b0..1709fca56 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -220,7 +220,7 @@ pkg_error dual_newer => {
   body    => sub {
     my ($old) = @_;
 
-    _assert_args_present(db_conflict => $old, [ qw(package file dist version) ]);
+    _assert_args_present(dual_newer => $old, [ qw(package file dist version) ]);
 
     return <<~"EOF";
       Not indexed because package $old->{package} in file $old->{file} has a
@@ -235,7 +235,7 @@ pkg_error dual_older => {
   body    => sub {
     my ($old) = @_;
 
-    _assert_args_present(db_conflict => $old, [ qw(package file dist version) ]);
+    _assert_args_present(dual_older => $old, [ qw(package file dist version) ]);
 
     return <<~"EOF";
       Not indexed because package $old->{package} in file $old->{file} seems
@@ -252,7 +252,7 @@ pkg_error mtime_fell => {
   body    => sub {
     my ($old) = @_;
 
-    _assert_args_present(db_conflict => $old, [ qw(package file dist version) ]);
+    _assert_args_present(mtime_fell => $old, [ qw(package file dist version) ]);
 
     return <<~"EOF";
       Not indexed because $old->{file} in $old->{dist} also has a zero version
@@ -275,7 +275,7 @@ pkg_error version_fell => {
   body   => sub {
     my ($old) = @_;
 
-    _assert_args_present(db_conflict => $old, [ qw(package file dist version) ]);
+    _assert_args_present(version_fell => $old, [ qw(package file dist version) ]);
 
     return <<~"EOF";
       Not indexed because $old->{file} in $old->{dist} has a higher version
@@ -289,7 +289,7 @@ pkg_error version_invalid => {
   body   => sub {
     my ($arg) = @_;
 
-    _assert_args_present(db_conflict => $arg, [ qw(version) ]);
+    _assert_args_present(version_invalid => $arg, [ qw(version) ]);
 
     return <<~"EOF";
       The version present in the file, "$arg->{version}", is not a valid lax

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

If the author writes a bare numeric literal as a version, like
$VERSION = 0.000001, perl turns it into 1e-06, which can't become a
version object.  Before, that died inside normalize_version, examine_fio
logged "error with version", and the file was silently skipped: the
author got no explanation.

Now normalize_version returns a JSON error blob for a version that looks
like scientific notation, the same way parse_version does for other
version problems, and examine_pkg maps that blob to a new package error,
version_numeric_literal, so the indexer report tells the author to quote
the version.

This was originally written against a much older indexer, where getting
the message up the call stack was impractical and the test for the
report was a TODO.  Rebased onto the index-context refactor, the error
machinery makes it simple, so the TODO is now a real assertion.

Co-Authored-By: Claude <noreply@anthropic.com>
---
 lib/PAUSE/Indexer/Errors.pm | 16 ++++++++++++++++
 lib/PAUSE/package.pm        |  4 ++++
 lib/PAUSE/pmfile.pm         | 23 +++++++++++++++++++++++
 t/mldistwatch-misc.t        | 33 +++++++++++++++++++++++++++++++++
 4 files changed, 76 insertions(+)

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index 1709fca56..66d378e70 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -300,6 +300,22 @@ pkg_error version_invalid => {
   }
 };
 
+pkg_error version_numeric_literal => {
+  header  => 'Not indexed because version is a very small or large number.',
+  body    => sub {
+    my ($arg) = @_;
+
+    _assert_args_present(version_numeric_literal => $arg, [ qw(version) ]);
+
+    return <<~"EOF";
+      The version in the file is a bare number, not a string, and it is so
+      small or so large that perl turned it into "$arg->{version}", which is
+      not a valid version string.  Quote the version in your source, like
+      \$VERSION = '0.000001', so that it is stored as a string.
+      EOF
+  },
+};
+
 pkg_error version_openerr => {
   header  => 'Not indexed because of version handling error.',
   body    => <<~'EOF',
diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index 9a081474d..7ad6dc832 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -279,6 +279,10 @@ sub examine_pkg {
       if ($err->{openerr}) {
           # TODO: get $err->{openerr} back in here, I guess?
           $ctx->abort_indexing_package($self, PKGERROR('version_openerr'));
+      } elsif ($err->{numeric_literal}) {
+          $ctx->abort_indexing_package($self, PKGERROR('version_numeric_literal', {
+            version => $err->{numeric_literal},
+          }));
       } else {
           # TODO: get $err->{line} back in here, I guess?
           $ctx->abort_indexing_package($self, PKGERROR('version_parse'));
diff --git a/lib/PAUSE/pmfile.pm b/lib/PAUSE/pmfile.pm
index dc73d4f2b..f5194ccbc 100644
--- a/lib/PAUSE/pmfile.pm
+++ b/lib/PAUSE/pmfile.pm
@@ -569,6 +569,29 @@ sub normalize_version {
     my $sdv = $dv->stringify($v,1); # second argument prevents ticks
     $Logger->log("result of normalize_version: $sdv");
 
+    # If the author wrote
+    #
+    #   $VERSION = 0.000001
+    #
+    # ...instead of...
+    #
+    #   $VERSION = '0.000001'
+    #
+    # ...then when we eval the version value, we get a number.  That's bad,
+    # because we 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-06,
+    # which can't be turned into a version object with version->new.
+    #
+    # When the stringified version looks like scientific notation, we return a
+    # JSON error blob, the same way parse_version does for other version
+    # problems, so that examine_pkg can report it to the author instead of
+    # silently skipping the file.
+    #
+    # -- rjbs, 2023-04-28
+    if ($sdv =~ /\A[0-9](?:\.[0-9]+)?e[-+]?[0-9]+\z/a) {
+        return JSON::to_json({ numeric_literal => $sdv });
+    }
+
     return $v if $v eq "undef";
     return $v if $v =~ /^\{.*\}$/; # JSON object
     $v =~ s/^\s+//;
diff --git a/t/mldistwatch-misc.t b/t/mldistwatch-misc.t
index 7c4b49b7d..b092981fe 100644
--- a/t/mldistwatch-misc.t
+++ b/t/mldistwatch-misc.t
@@ -725,6 +725,39 @@ subtest "indexer ran, but nothing indexed" => 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;
+
+  $result->assert_index_not_updated;
+
+  $result->email_ok(
+    [
+      {
+        subject  => 'Failed: PAUSE indexer report PERSON/Tiny-Version-1.002.tar.gz',
+        callbacks => [
+          sub {
+            like(
+              $_[0]{email}->object->body_str,
+              qr/perl turned it into\s+"1e-06"/,
+              "email explains the numeric literal problem",
+            );
+          },
+        ],
+      },
+    ],
+  );
+};
+
 done_testing;
 
 # Local Variables:

From f08967abf89944d5da8d8340b5249ea5352e5cd4 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 21 Oct 2026 20:33:06 -0400
Subject: [PATCH 49/49] indexer: use JSON::to_json and from_json, not the
 obsolete names

objToJson and jsonToObj are JSON 1.x compatibility names, and JSON 4.x
warns on every call that they "will be obsoleted".  The numeric-literal
version test now exercises both the encode and decode sides in the
parent process, so the warnings showed up in test output.

Co-Authored-By: Claude <noreply@anthropic.com>
---
 lib/PAUSE/package.pm | 2 +-
 lib/PAUSE/pmfile.pm  | 6 +++---
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index 7ad6dc832..cfe69a2ed 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -275,7 +275,7 @@ sub examine_pkg {
   # Parser problem
 
   if ($pp->{version} && $pp->{version} =~ /^\{.*\}$/) { # JSON parser error
-      my $err = JSON::jsonToObj($pp->{version});
+      my $err = JSON::from_json($pp->{version});
       if ($err->{openerr}) {
           # TODO: get $err->{openerr} back in here, I guess?
           $ctx->abort_indexing_package($self, PKGERROR('version_openerr'));
diff --git a/lib/PAUSE/pmfile.pm b/lib/PAUSE/pmfile.pm
index f5194ccbc..8b2601e52 100644
--- a/lib/PAUSE/pmfile.pm
+++ b/lib/PAUSE/pmfile.pm
@@ -539,13 +539,13 @@ sub parse_version {
                     }
                     if ($@) {
                         warn sprintf("reval failed: err[%s] for eval[%s]",
-                                      JSON::objToJson($err,{pretty => 1}),
+                                      JSON::to_json($err,{pretty => 1}),
                                       $eval,
                                     );
-                        $v = JSON::objToJson($err);
+                        $v = JSON::to_json($err);
                     }
                 } else {
-                    $v = JSON::objToJson({ openerr => $err });
+                    $v = JSON::to_json({ openerr => $err });
                 }
             }
             if (defined $v) {