view release on metacpan or  search on metacpan

local/lib/perl5/Module/Build/Base.pm  view on Meta::CPAN

  if (my $merge = $self->meta_merge) {
    if (eval { require CPAN::Meta::Merge }) {
      %metadata = %{ CPAN::Meta::Merge->new(default_version => '1.4')->merge(\%metadata, $merge) };
    }
    else {
      $self->log_warn("Can't merge without CPAN::Meta::Merge");
    }
  }

  return \%metadata;
}

# To preserve compatibility with old API, $node *must* be a hashref
# passed in to prepare_metadata.  $keys is an arrayref holding a
# list of keys -- it's use is optional and generally no longer needed
# but kept for back compatibility.  $args is an optional parameter to
# support the new 'fatal' toggle

sub prepare_metadata {
  my ($self, $node, $keys, $args) = @_;
  unless ( ref $node eq 'HASH' ) {
    croak "prepare_metadata() requires a hashref argument to hold output\n";
  }
  croak 'Keys argument to prepare_metadata is no longer supported' if $keys;
  %{$node} = %{ $self->get_meta(%{$args}) };
  return $node;
}

sub _read_manifest {
  my ($self, $file) = @_;
  return undef unless -e $file;

  require ExtUtils::Manifest;  # ExtUtils::Manifest is not warnings clean.
  local ($^W, $ExtUtils::Manifest::Quiet) = (0,1);
  return scalar ExtUtils::Manifest::maniread($file);
}

sub find_dist_packages {
  my $self = shift;

  # Only packages in .pm files are candidates for inclusion here.
  # Only include things in the MANIFEST, not things in developer's
  # private stock.

  my $manifest = $self->_read_manifest('MANIFEST')
    or die "Can't find dist packages without a MANIFEST file\nRun 'Build manifest' to generate one\n";

  # Localize
  my %dist_files = map { $self->localize_file_path($_) => $_ }
                       keys %$manifest;

  my @pm_files = sort grep { $_ !~ m{^t} } # skip things in t/
                   grep {exists $dist_files{$_}}
                     keys %{ $self->find_pm_files };

  return $self->find_packages_in_files(\@pm_files, \%dist_files);
}

# XXX Do not document this function; mst wrote it and now says the API is
# stupid and needs to be fixed and it shouldn't become a public API until then
sub find_packages_in_files {
  my ($self, $file_list, $filename_map) = @_;

  # First, we enumerate all packages & versions,
  # separating into primary & alternative candidates
  my( %prime, %alt );
  foreach my $file (@{$file_list}) {
    my $mapped_filename = $filename_map->{$file};
    my @path = split( /\//, $mapped_filename );
    (my $prime_package = join( '::', @path[1..$#path] )) =~ s/\.pm$//;

    my $pm_info = Module::Metadata->new_from_file( $file );

    foreach my $package ( $pm_info->packages_inside ) {
      next if $package eq 'main';  # main can appear numerous times, ignore
      next if $package eq 'DB';    # special debugging package, ignore
      next if grep /^_/, split( /::/, $package ); # private package, ignore

      my $version = $pm_info->version( $package );

      if ( $package eq $prime_package ) {
        if ( exists( $prime{$package} ) ) {
          # Module::Metadata will handle this conflict
          die "Unexpected conflict in '$package'; multiple versions found.\n";
        } else {
          $prime{$package}{file} = $mapped_filename;
          $prime{$package}{version} = $version if defined( $version );
        }
      } else {
        push( @{$alt{$package}}, {
                                  file    => $mapped_filename,
                                  version => $version,
                                 } );
      }
    }
  }

  # Then we iterate over all the packages found above, identifying conflicts
  # and selecting the "best" candidate for recording the file & version
  # for each package.
  foreach my $package ( sort keys( %alt ) ) {
    my $result = $self->_resolve_module_versions( $alt{$package} );

    if ( exists( $prime{$package} ) ) { # primary package selected

      if ( $result->{err} ) {
        # Use the selected primary package, but there are conflicting
        # errors among multiple alternative packages that need to be
        # reported
        $self->log_warn(
          "Found conflicting versions for package '$package'\n" .
          "  $prime{$package}{file} ($prime{$package}{version})\n" .
          $result->{err}
        );

      } elsif ( defined( $result->{version} ) ) {
        # There is a primary package selected, and exactly one
        # alternative package

        if ( exists( $prime{$package}{version} ) &&