From a4ecf6d917c3f073a589d228947e4c64c1674ed7 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/42] 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 fa584c731..c807463ce 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -270,9 +270,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;
@@ -842,6 +839,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 0283479ce0273971b83e0f5b63fc584bf482f0e5 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/42] 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     |  27 ++++----
 lib/PAUSE/package.pm         | 131 +++++++++++++++++++----------------
 lib/PAUSE/pmfile.pm          |  16 ++---
 5 files changed, 131 insertions(+), 106 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 6f4af0e14..a7eae81d6 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -167,7 +167,7 @@ sub alert {
 }
 
 sub all_alerts {
-  my ($self) = @_;
+  my ($self, $ctx) = @_;
   return @{ $self->{ALERT} // [] };
 }
 
@@ -282,7 +282,7 @@ sub isa_dev_version {
 }
 
 sub examine_dist {
-  my($self) = @_;
+  my ($self, $ctx) = @_;
   my $dist = $self->{DIST};
   my $MLROOT = $self->mlroot;
   my($suffix,$skip);
@@ -355,7 +355,7 @@ sub mlroot {
 }
 
 sub mail_summary {
-  my($self) = @_;
+  my ($self, $ctx) = @_;
   my $distro = $self->{DIST};
   my $author = $self->{USERID};
   my @m;
@@ -364,7 +364,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";
@@ -384,7 +384,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
@@ -558,7 +558,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;
         }
@@ -584,7 +584,7 @@ sub mail_summary {
                  .  qq{contain a META.yml or META.json file.\n\n};
 
           $status_over_all = "Failed";
-        } 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}
@@ -643,7 +643,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,
@@ -653,19 +654,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};
 
@@ -673,7 +674,7 @@ sub has_indexing_warnings {
 }
 
 sub check_blib {
-  my($self) = @_;
+  my ($self, $ctx) = @_;
   if (grep m|^[^/]+/blib/|, @{$self->{MANIFOUND}}) {
     $self->{HAS_BLIB}++;
     return;
@@ -707,7 +708,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) {
@@ -719,7 +720,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;
@@ -770,7 +771,7 @@ sub check_world_writable {
 }
 
 sub filter_pms {
-  my($self) = @_;
+  my ($self, $ctx) = @_;
   my @pmfile;
 
   # very similar code is in PAUSE::package::filter_ppps
@@ -843,7 +844,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;
@@ -863,12 +864,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;
@@ -914,12 +915,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};
@@ -930,10 +931,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) {
@@ -946,7 +947,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!");
   }
@@ -967,7 +968,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 };
@@ -993,7 +994,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};
@@ -1105,7 +1106,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};
 
@@ -1169,7 +1170,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 180281653..ed7df6c3c 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 ();
@@ -334,7 +335,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,
@@ -368,7 +369,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;
 
@@ -434,6 +435,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)) {
@@ -469,13 +472,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;
       }
@@ -489,16 +492,16 @@ 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;
     }
 
-    $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) {
@@ -508,11 +511,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 c807463ce..72b6e5e6c 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) = @_;
 
     my $package = $self->{PACKAGE};
     return $package !~ /^\w[\w\:\']*\w?\z/
@@ -247,7 +248,7 @@ sub _pkg_name_insane {
 
 # package PAUSE::package;
 sub examine_pkg {
-  my $self = shift;
+  my ($self, $ctx) = @_;
 
   my $dbh = $self->connect;
   my $package = $self->{PACKAGE};
@@ -257,7 +258,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;
@@ -265,8 +266,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;
   }
 
@@ -279,6 +280,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!",
         );
       }
@@ -290,7 +292,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,
@@ -299,7 +302,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,
@@ -333,16 +337,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,
@@ -362,9 +367,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};
@@ -460,7 +463,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,
@@ -473,7 +477,8 @@ Maybe harmless, maybe needs resolving.},
 
                               );
           } else {
-              $self->index_status($package,
+              $self->index_status($ctx,
+                                  $package,
                                   $pp->{version},
                                   $pp->{infile},
                                   PAUSE::mldistwatch::Constants::EDUALYOUNGER,
@@ -486,7 +491,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,
@@ -507,7 +513,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,
@@ -554,7 +561,7 @@ pmfile[$pmfile]
               ]);
               $ok++;
           } else {
-              $self->index_status(
+              $self->index_status($ctx,
                                   $package,
                                   $pp->{version},
                                   $pp->{infile},
@@ -584,7 +591,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},
@@ -632,19 +639,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) {
@@ -681,24 +689,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.},
-              );
+          );
       }
 
   }
@@ -707,36 +717,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};
@@ -760,7 +772,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,
@@ -772,7 +784,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,
@@ -783,7 +796,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};
@@ -832,7 +845,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};
@@ -840,7 +853,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};
 
@@ -856,15 +869,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 8b9041b20..ad9dea64b 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};
@@ -290,7 +290,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 dc1264c0c0fefe6805b6a0e5ac61ab3d89966689 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/42] 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 a7eae81d6..d9c231609 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -556,11 +556,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});
@@ -653,13 +653,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} // [] };
@@ -694,7 +687,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 72b6e5e6c..e74e4ab61 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -279,9 +279,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!",
         );
       }
     }
@@ -735,17 +735,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 f313d37ca..3d9863a51 100644
--- a/t/mldistwatch-misc.t
+++ b/t/mldistwatch-misc.t
@@ -187,14 +187,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 9fafeeabb84d1270787760daeff845e93f4decd3 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/42] 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 d9c231609..be1093de1 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -157,22 +157,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};
@@ -185,7 +171,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;
     }
@@ -196,7 +182,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;
   }
@@ -244,7 +230,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};
@@ -265,10 +251,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);
@@ -289,7 +275,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;
@@ -311,7 +297,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";
@@ -495,7 +481,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");
 
     }
 
@@ -844,7 +830,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;
     }
 
@@ -942,7 +928,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!");
   }
 }
 
@@ -1185,7 +1171,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;
@@ -1262,7 +1248,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 ed7df6c3c..5e240dfd7 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -353,15 +353,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;
       }
 
@@ -378,7 +378,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;
     }
@@ -506,7 +506,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;
       }
     }
@@ -515,9 +515,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 e74e4ab61..27c884207 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}]
@@ -353,7 +345,7 @@ sub _version_ok {
                         $errno,
                         $error,
                         );
-    $self->alert(qq{$error:
+    $ctx->alert(qq{$error:
 package[$package]
 version[$pp->{version}]
 file[$pp->{infile}]
@@ -524,7 +516,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]
@@ -534,7 +526,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 ad9dea64b..5e827e287 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 c298e3d0e8cf68365181305e04f588524388ef6a 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/42] indexer: make more dist indexing steps check for skip

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

diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index be1093de1..89dfb8ae4 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -1058,6 +1058,21 @@ 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;
+    }
+}
+
 sub write_updated_meta6_json {
   my($self, $metafile, $MLROOT, $dist, $sans) = @_;
 
diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index 5e240dfd7..218be1394 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -471,7 +471,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};
@@ -484,22 +492,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;
-    }
-
-    $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 7d9386587d777a59c3bbf81906e81c6d5d302808 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/42] 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 ec64c112fba1c9787575e3e0d393aac56704e4bb 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/42] 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.
---
 lib/PAUSE/dist.pm        | 412 +++++++++++++++------------------------
 lib/PAUSE/mldistwatch.pm |  29 +--
 t/mldistwatch-big.t      |  20 +-
 t/mldistwatch-misc.t     |   2 +-
 4 files changed, 177 insertions(+), 286 deletions(-)

diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 89dfb8ae4..15df94ff1 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -9,6 +9,7 @@ use List::MoreUtils ();
 use PAUSE ();
 use Parse::CPAN::Meta;
 use PAUSE::mldistwatch::Constants;
+use PAUSE::Indexer::Errors;
 use JSON::XS ();
 
 use PAUSE::Logger '$Logger';
@@ -217,8 +218,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) = @_;
@@ -253,6 +252,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);
   }
@@ -276,35 +276,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) {
@@ -317,12 +318,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 {
@@ -340,6 +339,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};
@@ -396,214 +473,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";
-  }
-
-  # 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";
-
-    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}) {
+  my @dist_errors = $ctx->dist_errors;
 
-      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.]);
+  for my $error (@dist_errors) {
+    my $header = $error->{header};
+    my $body   = $error->{body};
+    $body = $body->($self) if ref $body;
 
-      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->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: ";
     }
@@ -619,13 +553,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 {
@@ -656,7 +589,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}};
@@ -681,6 +614,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;
   }
@@ -691,8 +625,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];
   }
@@ -710,43 +644,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 {
@@ -900,9 +803,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
@@ -1020,9 +920,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;
   }
 
@@ -1065,10 +963,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;
     }
 }
diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index 218be1394..e69a3513b 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 ();
@@ -379,7 +380,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;
     }
 
@@ -480,16 +481,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) {
@@ -499,7 +506,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/t/mldistwatch-big.t b/t/mldistwatch-big.t
index 753b160fd..59c4ab516 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 3d9863a51..561433976 100644
--- a/t/mldistwatch-misc.t
+++ b/t/mldistwatch-misc.t
@@ -547,7 +547,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 415fc4b02d526c2463c4caa4d674ee52a86419e0 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/42] 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 f177b3f1374e33a66e17f26fafeb30094dbfc040 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 11:45:19 +0200
Subject: [PATCH 09/42] support v5.16: stop using indented heredocs

Sorry, Matthew.
---
 lib/PAUSE/Indexer/Errors.pm | 77 ++++++++++++++++++-------------------
 1 file changed, 38 insertions(+), 39 deletions(-)

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index 1d5dafdf3..10a197e55 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -20,21 +20,21 @@ sub public_error {
 
 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
+  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
+    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
   },
 };
 
@@ -45,60 +45,59 @@ 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.
-      EOF
+    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
+  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
+  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
+  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
+    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
+  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 {

From f35ccc3fdb61e48d24689722ebe3a316b3ef27ef Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 11:51:05 +0200
Subject: [PATCH 10/42] support v5.16: remove postfix deref

:'(
---
 lib/PAUSE/Indexer/Context.pm | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/lib/PAUSE/Indexer/Context.pm b/lib/PAUSE/Indexer/Context.pm
index 724584a29..c49fbf3be 100644
--- a/lib/PAUSE/Indexer/Context.pm
+++ b/lib/PAUSE/Indexer/Context.pm
@@ -33,14 +33,14 @@ sub add_package_warning {
 sub warnings_for_all_packages {
   my ($self) = @_;
 
-  return map {; @$_ } values $self->_package_warnings->%*;
+  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->%*;
+         map  {; @$_ } values %{ $self->_package_warnings };
 }
 
 has alerts => (
@@ -53,13 +53,13 @@ sub alert {
   my ($self, $alert) = @_;
   $alert =~ s/\v+\z//;
 
-  push $self->_alerts->@*, $alert;
+  push @{ $self->_alerts }, $alert;
   return;
 }
 
 sub all_alerts {
   my ($self) = @_;
-  return $self->_alerts->@*;
+  return @{ $self->_alerts };
 }
 
 has dist_errors => (
@@ -74,14 +74,14 @@ sub add_dist_error {
   $error = ref $error ? $error : { ident => $error, message => $error };
 
   $Logger->log("adding dist error: " . ($error->{ident} // $error->{message}));
-  push $self->_dist_errors->@*, $error;
+  push @{ $self->_dist_errors }, $error;
 
   return $error;
 }
 
 sub dist_errors {
   my ($self) = @_;
-  return $self->_dist_errors->@*;
+  return @{ $self->_dist_errors };
 }
 
 sub abort_indexing {

From 186ee6b8281db95785b40d635f63c7a61674b608 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 12:19:07 +0200
Subject: [PATCH 11/42] 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 c49fbf3be..581705af9 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 d5bb3a3d7bd362d4f9e93b6f6a6a159687bffd36 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 12:21:26 +0200
Subject: [PATCH 12/42] indexer: improve the no_distname_permissions error

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

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index 10a197e55..400d68384 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -46,10 +46,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 59c4ab516..f8a810a37 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 28763861fbf1540ea2e333ce6fad0ba6a672b7d0 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 12:35:38 +0200
Subject: [PATCH 13/42] 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 e69a3513b..fab5cb4e9 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -472,31 +472,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 a2a4d15d7e4b1a7e9f7d0ec27cd4c1b30784bff0 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 12:50:52 +0200
Subject: [PATCH 14/42] 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 15df94ff1..bfdb70d98 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -427,7 +427,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";
@@ -572,19 +574,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 check_blib {
   my ($self, $ctx) = @_;
   if (grep m|^[^/]+/blib/|, @{$self->{MANIFOUND}}) {
@@ -1280,12 +1269,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 54efa06388a391f128091fa5d1efb5805cab6cd7 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 16:22:04 +0200
Subject: [PATCH 15/42] 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 5e827e287..6daa275cb 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 28ff4b6789ec322d76724fbaf219cae8a606a37d Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 17:08:19 +0200
Subject: [PATCH 16/42] 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 581705af9..5eed3a6e5 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 bfdb70d98..1f7ec17a9 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -280,7 +280,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;
@@ -288,22 +288,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};
@@ -318,7 +318,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;
@@ -578,7 +578,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}};
@@ -603,7 +603,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;
   }
@@ -615,7 +615,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];
   }
@@ -638,7 +638,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 {
@@ -909,7 +909,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;
   }
 
@@ -959,7 +959,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 fab5cb4e9..251bb0530 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -485,7 +485,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 0096a18059bf2eec12044195b854079a2f7c263a Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 17:13:42 +0200
Subject: [PATCH 17/42] 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 1f7ec17a9..c7c72e9a1 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -745,8 +745,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}) {
@@ -786,6 +787,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 6daa275cb..0f28ec863 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 4905131cc80d083fc755e4feefd3d789dfb3132f Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 17:25:35 +0200
Subject: [PATCH 18/42] 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 c7c72e9a1..8a5236250 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -791,9 +791,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 0f28ec863..b931fa2f9 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 8dda205f71df292b22d3270ca7b9c398dc2557d4 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 23:31:05 +0200
Subject: [PATCH 19/42] 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 27c884207..6f3bac20a 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -419,6 +419,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
@@ -442,46 +446,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,
@@ -562,9 +533,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([
@@ -599,8 +569,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
@@ -707,6 +677,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 c01d16d963ee67f2462aec1f9ae6df95db1701ee Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sun, 30 Apr 2023 23:41:02 +0200
Subject: [PATCH 20/42] 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 6f3bac20a..3844d2897 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -569,112 +569,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 0ce0d54a717b76b47b86727387dfd0f8ed466db8 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 3 May 2023 19:43:34 +0200
Subject: [PATCH 21/42] 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  | 185 ++++++++++++++++++++++++++++++-----
 lib/PAUSE/dist.pm            |  14 +--
 lib/PAUSE/mldistwatch.pm     |   4 +-
 4 files changed, 260 insertions(+), 35 deletions(-)

diff --git a/lib/PAUSE/Indexer/Context.pm b/lib/PAUSE/Indexer/Context.pm
index 5eed3a6e5..c8d223898 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 400d68384..88d3c6942 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 blib => {
+dist_error blib => {
   header  => 'archive contains a "blib" directory',
   body    => <<'EOF'
 The distribution contains a blib/ directory and is therefore not being indexed.
@@ -26,7 +18,7 @@ Hint: try 'make dist'.
 EOF
 };
 
-public_error multiroot => {
+dist_error multiroot => {
   header  => 'archive has multiple roots',
   body    => sub {
     my ($dist) = @_;
@@ -38,7 +30,7 @@ EOF
   },
 };
 
-public_error no_distname_permission => {
+dist_error no_distname_permission => {
   header  => 'missing permissions on distname package',
   body    => sub {
     my ($dist) = @_;
@@ -57,7 +49,7 @@ EOF
   },
 };
 
-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 include
@@ -66,7 +58,7 @@ ExtUtils::MakeMaker can help with this.
 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 the
@@ -75,7 +67,7 @@ no longer is.  Please use a CPAN distribution building tool.
 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
@@ -83,7 +75,7 @@ distribution will not be indexed.
 EOF
 };
 
-public_error worldwritable => {
+dist_error worldwritable => {
   header  => 'archive has world writable files',
   body    => sub {
     my ($dist) = @_;
@@ -95,7 +87,7 @@ EOF
   },
 };
 
-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
@@ -103,21 +95,162 @@ another indexing attempt be made by logging into https://pause.perl.org/
 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 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.
+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 8a5236250..f5e21195b 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -303,7 +303,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};
@@ -578,7 +578,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}};
@@ -603,7 +603,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;
   }
@@ -615,7 +615,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];
   }
@@ -638,7 +638,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 {
@@ -926,7 +926,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;
   }
 
@@ -976,7 +976,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;
     }
 }
diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index 251bb0530..5f504b6ec 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -380,7 +380,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;
     }
 
@@ -504,7 +504,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 584c0866d39638e1bc5969e7635446fff4f0d4a4 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 3 May 2023 19:46:25 +0200
Subject: [PATCH 22/42] 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 3844d2897..3a8b9901c 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -502,16 +502,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 4d13f4953244a74b9752b516a467794c3152e03c Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 3 May 2023 19:47:21 +0200
Subject: [PATCH 23/42] 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 | 247 ++++++++-----------------------------------
 t/lib/Mock/Dist.pm   |   2 +-
 t/mldistwatch-big.t  |   2 +-
 t/mldistwatch-misc.t |   2 +-
 4 files changed, 49 insertions(+), 204 deletions(-)

diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm
index 3a8b9901c..1f864e885 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 {
@@ -251,17 +242,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
   {
@@ -284,48 +270,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} >},
-                              );
-      } 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->{openerr} back in here, I guess?
+          $ctx->abort_indexing_package($self, PKGERROR('version_openerr'));
       }
-      delete $self->{FIO};    # circular reference
-      return;
+
+      # TODO: get $err->{line} back in here, I guess?
+      $ctx->abort_indexing_package($self, PKGERROR('version_parse'));
   }
 
   # 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'));
       }
   }
 
@@ -333,27 +290,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;
@@ -368,7 +317,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 )
   };
@@ -454,13 +402,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([
@@ -476,15 +418,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}]
@@ -493,6 +426,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 {
@@ -521,14 +456,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
@@ -550,14 +478,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(
@@ -603,22 +524,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", {
@@ -648,28 +557,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 {
@@ -701,57 +592,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) = @_;
@@ -778,7 +627,7 @@ sub insert_into_package {
     }
   ]);
 
-  return unless $self->_version_ok($ctx, $pp, $package, $dist);
+  $self->assert_version_ok($ctx);
   $dbh->do($query,
             undef,
             $package,
@@ -790,13 +639,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;
@@ -881,11 +725,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 f8a810a37..4cfe8636c 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 561433976..a83876703 100644
--- a/t/mldistwatch-misc.t
+++ b/t/mldistwatch-misc.t
@@ -321,7 +321,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 24a2a61af9d2f2f38c93aa7ed1426171d34c5451 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 3 May 2023 19:38:50 +0200
Subject: [PATCH 24/42] 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 c8d223898..2837b68b0 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 f5e21195b..676b32091 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -340,67 +340,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}
@@ -489,24 +483,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,
       );
@@ -563,17 +555,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 check_blib {
   my ($self, $ctx) = @_;
   if (grep m|^[^/]+/blib/|, @{$self->{MANIFOUND}}) {
@@ -1284,8 +1265,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 39bb0b59fb85c9c4590a703028e454ccc44cc7bf Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 3 May 2023 20:25:58 +0200
Subject: [PATCH 25/42] 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 | 115 +++++++++++++++++++++++++++---------
 lib/PAUSE/package.pm        |  40 ++++++++-----
 2 files changed, 113 insertions(+), 42 deletions(-)

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index 88d3c6942..a2febf6d6 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 blib => {
   header  => 'archive contains a "blib" directory',
   body    => <<'EOF'
@@ -105,16 +115,23 @@ 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.
+  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 database due
@@ -124,30 +141,48 @@ 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.
+  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.
+  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 => {
@@ -160,17 +195,33 @@ 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)},
+  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 => {
@@ -225,18 +276,27 @@ sub DISTERROR {
 }
 
 sub PKGERROR {
-  my ($ident) = @_;
+  my ($ident, $arg) = @_;
 
-  my $error = $PKG_ERROR{$ident};
-  unless ($error) {
+  my $template = { $PKG_ERROR{$ident}->%* };
+
+  unless ($template) {
     Carp::confess("requested unknown package error: $ident");
   }
 
+  my $error = { %$template };
+
+  if (ref $error->{body}) {
+    my $body = $error->{body}->($arg);
+    $error->{body} = $body;
+  }
+
   return $error;
 }
 
 sub dist_error {
   my ($name, $arg) = @_;
+
   $DIST_ERROR{$name} = {
     ident   => $name,
     public  => 1,
@@ -246,6 +306,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 1f864e885..399386457 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -321,15 +321,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];
@@ -402,7 +402,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([
@@ -427,7 +429,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 {
@@ -456,7 +458,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
@@ -478,7 +480,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(
@@ -570,6 +572,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};
@@ -592,9 +602,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 5325b8ddc810c489f7133d573ce6f4b50605b7c2 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 3 May 2023 20:51:34 +0200
Subject: [PATCH 26/42] 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 676b32091..9912ee1ac 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -345,10 +345,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 e97b6348508c10072eed80ecfd61ab7a15df0be2 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Wed, 3 May 2023 20:51:45 +0200
Subject: [PATCH 27/42] 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 9912ee1ac..e8573b375 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -398,16 +398,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 ce6d39105e3568cd60b382cf281b41c1b49ee40b Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Mon, 6 May 2024 21:09:51 -0400
Subject: [PATCH 28/42] 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 a2febf6d6..1e83d6ed7 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 05a0beff388ae2668768982293d6ebcc27206e1d Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Tue, 7 May 2024 21:20:08 -0400
Subject: [PATCH 29/42] 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 399386457..ce0ec7823 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -400,6 +400,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 46dad7baa9745fa1ba9665e633a0c4cfc06ba94c Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Tue, 7 May 2024 21:21:17 -0400
Subject: [PATCH 30/42] 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 2837b68b0..79c97cdc0 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 e8573b375..791a1b268 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -172,7 +172,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;
     }
@@ -183,7 +183,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;
   }
@@ -250,7 +250,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) {
@@ -475,7 +475,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};
@@ -501,7 +501,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,
@@ -582,7 +582,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;
@@ -709,7 +709,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;
     }
 
@@ -821,7 +821,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!");
   }
 }
 
@@ -1158,7 +1158,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 5f504b6ec..4ad018d26 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -355,14 +355,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;
       }
 
@@ -379,7 +379,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;
     }
@@ -503,7 +503,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 ce0ec7823..e225aaac0 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}]
@@ -295,7 +295,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}]
@@ -423,7 +423,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]
@@ -435,7 +435,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 1f56eb654ef1e2126d3ae454b1b86008fd8d80b7 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 11 May 2024 09:50:17 -0400
Subject: [PATCH 31/42] 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 79c97cdc0..05a101113 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 826ab375de2bd2f363b9ceff3b2db62cb529eae5 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 11 May 2024 09:55:40 -0400
Subject: [PATCH 32/42] 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 e225aaac0..057eac5e7 100644
--- a/lib/PAUSE/package.pm
+++ b/lib/PAUSE/package.pm
@@ -736,10 +736,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 9d94118479236dadeb5cc67f3896b6e5820a8696 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 11 May 2024 20:14:12 -0400
Subject: [PATCH 33/42] 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 7996eec63e46b8a576135b1bbe4025e19648c96b Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 11:01:52 -0400
Subject: [PATCH 34/42] PAUSE::Indexer::Errors: fix keys from $old

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

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index 1e83d6ed7..ba250d1a7 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -150,8 +150,8 @@ 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
+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
   },
@@ -165,8 +165,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 version
+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.
 EOF

From 8c9c5c0f1b4a8c4d7f50d4958cb002154d168c89 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 11:33:35 -0400
Subject: [PATCH 35/42] 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 05a101113..abbe985ad 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 393a5ea4ec72ea6a4d906d0450f2cb6832ced54b Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 11:36:49 -0400
Subject: [PATCH 36/42] 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 | 46 +++++++++++++++++++++++++++++++++++++
 lib/PAUSE/dist.pm           | 10 ++++----
 t/mldistwatch-misc.t        |  4 ++--
 t/mldistwatch-perl.t        |  2 +-
 4 files changed, 54 insertions(+), 8 deletions(-)

diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm
index ba250d1a7..4dae9f549 100644
--- a/lib/PAUSE/Indexer/Errors.pm
+++ b/lib/PAUSE/Indexer/Errors.pm
@@ -70,6 +70,34 @@ ExtUtils::MakeMaker can help with this.
 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 diong
+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",
@@ -79,6 +107,16 @@ no longer is.  Please use a CPAN distribution building tool.
 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',
@@ -87,6 +125,14 @@ distribution will not be indexed.
 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 791a1b268..9eb63b8ff 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -280,7 +280,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;
@@ -288,18 +288,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";
@@ -318,7 +318,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 a83876703..17955e820 100644
--- a/t/mldistwatch-misc.t
+++ b/t/mldistwatch-misc.t
@@ -562,7 +562,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 } },
@@ -588,7 +588,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 6758a601824d0acb9edde978ac58e36f64187c3a Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 11:39:27 -0400
Subject: [PATCH 37/42] 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 9eb63b8ff..e8eb4cb40 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -480,10 +480,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 46627146b27fbffb410dde3ff0cfd78264d17a7a Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 11:55:05 -0400
Subject: [PATCH 38/42] 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 d46dd69d4..95462ab16 100644
--- a/lib/PAUSE.pm
+++ b/lib/PAUSE.pm
@@ -559,17 +559,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 344f6a0f8c0a090b5f0be71e4ff3098014b5d692 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 12:03:08 -0400
Subject: [PATCH 39/42] 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 95462ab16..5093249fe 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;};
@@ -559,6 +560,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 e8eb4cb40..8e193761d 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 ();
@@ -568,7 +567,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 4ad018d26..64e40ba3f 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;
@@ -601,7 +600,7 @@ sub handle_alerts {
         body_str => $body_str,
     );
 
-    sendmail($email);
+    PAUSE->sendmail($email);
 
     return;
 }

From fac746347915e934a6be6d5fd131a1199ab0e1fd Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 12:27:35 -0400
Subject: [PATCH 40/42] 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 5093249fe..34a56ff9d 100644
--- a/lib/PAUSE.pm
+++ b/lib/PAUSE.pm
@@ -563,6 +563,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 a6e19d14a0d0e74d5cb54819955a824104ddd8be Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 13:12:05 -0400
Subject: [PATCH 41/42] 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 17955e820..902f5dd77 100644
--- a/t/mldistwatch-misc.t
+++ b/t/mldistwatch-misc.t
@@ -672,6 +672,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 3fbb036f23d31bc0958a715b1790cee6c5a2b6ca Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@semiotic.systems>
Date: Sat, 22 Jun 2024 13:12:43 -0400
Subject: [PATCH 42/42] 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 8e193761d..146b6aa21 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -401,8 +401,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 902f5dd77..584a6f5bc 100644
--- a/t/mldistwatch-misc.t
+++ b/t/mldistwatch-misc.t
@@ -708,7 +708,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",
             );
           },