view release on metacpan or  search on metacpan

lib/Dist/Zilla/Plugin/PrereqsClean.pm  view on Meta::CPAN

         if ( my $remver = version->parse( Module::CoreList->removed_from($module) ) ) {
            $self->log([ 'Module %s has been removed from core since Perl %s; you should consider alternatives...', $module, $remver->normal ]);
            next;
         }
         next unless ($self->removal_level);

         my $modver = $req->requirements_for_module($module);
         if ( $modver && $modver =~ /\s/ ) {
            # what I really want is $req->is_simple($module)...
            # also, using "complete hack" from is_simple: https://metacpan.org/source/CPAN::Meta::Requirements#L159
            $self->log_debug("Skipping module $module with complex requirements");
            next;
         }
         $modver = version->parse($modver);
         my $modver_log = $module.($modver ? ' '.$modver->normal : '');

         # Core module
         if ( my $release = version->parse( Module::CoreList->first_release($module, $modver) ) ) {
            if ($release > $perlver) {
               $self->log_debug([ 'Skipping core module %s (Perl %s > %s)', $modver_log, $release->normal, $perlver->normal ]);
               next;
            }
            $self->log_debug([ 'Removing core module %s (been available since Perl %s)', $modver_log, $release->normal ]);
            $req->clear_requirement($module);
            next;
         }

         # potentials for culling
         next unless $self->removal_level >= RL_DIST_NO_SPLIT;
         unless ($module_distro{$module}) {
            my ($distro, @modules) = $self->_mcpan_module2distro($module, 1);
            next unless ($distro && @modules > 1);  # must exist in CPAN and be a 2+ module distro
            $module_distro{$_} = $distro for @modules;  # contains all modules vs. $distro_mods
         }

         if (my $distro = $module_distro{$module}) {
            $distro_mods->{$distro} //= {};  # hashes for uniqueness
            $distro_mods->{$distro}{$module} = 1;
            $distro_list{$distro} = 1;
         }
      }
      next unless ($self->removal_level >= RL_DIST_NO_SPLIT);

      # Look through the collected distro lists and figure out which should be removed
      $self->logger->set_prefix("{Pass 2.2: Distros} ");
      my @distros = map { [ $_, keys %{$distro_mods->{$_}} ] } sort keys %distro_list;
      while (my $distro_pair = shift @distros) {
         my $distro = shift @$distro_pair;
         my @modules = sort { length($a) <=> length($b) } @$distro_pair;
         my @dmods   = grep { $module_distro{$_} eq $distro } keys %module_distro;

         # hopefully, we can find a common name to use
         (my $main_module = $distro) =~ s/-/::/g;
         $main_module = $modules[0] unless ($main_module ~~ @dmods);

         # remove any obvious split potentials
         if ($self->removal_level <= RL_DIST_NO_SPLIT) {
            my ($non_ns, $new_mods) = part { /^\Q$main_module\E(?:\:\:|$)/ } @modules;
            @modules = $new_mods ? @$new_mods : ();

            # Add split modules to a "new" distro for further processing
            # (This will clean up both Dist::A::* and Dist::B::* from Dist-A)
            if ($non_ns && $new_mods) {
               @$non_ns = sort { length($a) <=> length($b) } @$non_ns;
               unshift @distros, [ $non_ns->[0], @$non_ns ];
            }

            if (@modules <= 1) {
               $self->log_debug("Skipping module $main_module; distro only has ".scalar @modules." module left since split comparison");
               next;
            }
         }

         my $maxver = max map { version->parse( $req->requirements_for_module($_) || 0 ) } @modules;
         $maxver ||= 0;

         $self->log_debug("Replacing modules from common distro $distro:");
         $self->log_debug('   Using main/replacement module of '.$main_module.($maxver ? ' '.$maxver->normal : ''));
         $self->log_debug("   $_") for @modules;
         $req->clear_requirement($_) for @modules;
         $req->add_minimum( $main_module => $maxver );
      }
   }
}

sub _mcpan_module2distro {
   my ($self, $module, $get_module_list) = @_;

   # faster and less bulky than a straight module/$module pull
   ### XXX: This should be replaced with a ->file() method when those
   ### two pull requests of mine are put into CPAN...
   $self->log_debug("Checking module $module via MetaCPAN");
   my $details = $self->mcpan->fetch("file/_search",
      q      => 'module.name:"'.$module.'" AND status:latest AND module.authorized:true',
      fields => 'distribution,release',
      size   => 1,
   );
   unless ($details && $details->{hits}{total}) {
      $self->log("??? MetaCPAN can't even find module $module!");
      return undef;
   }
   my ($distro, $release) = @{ $details->{hits}{hits}[0]{fields} }{qw(distribution release)};
   return $distro unless $get_module_list;

   $self->log_debug("Checking release $release for module list via MetaCPAN");
   $details = $self->mcpan->fetch("file/_search",
      q      => 'release:"'.$release.'" AND module.name:* AND module.authorized:true',
      fields => 'module.name',
      size   => 500,
   );
   unless ($details && $details->{hits}{total}) {
      $self->log("??? MetaCPAN can't find release $release (even after finding it earlier)!");
      return undef;
   }

   my @modules = map { $_->{fields}{'module.name'} } @{ $details->{hits}{hits} };
   return ($distro, @modules);
}

__PACKAGE__->meta->make_immutable;
42;