view release on metacpan or  search on metacpan

inc/inc_Module-Build/Module/Build/Base.pm  view on Meta::CPAN

  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 = 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::Build::ModuleInfo->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} ) ) {
          # M::B::ModuleInfo 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 ( 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} ) &&
             defined( $prime{$package}{version} ) ) {
          # Unless the version of the primary package agrees with the
          # version of the alternative package, report a conflict
          if ( $self->compare_versions( $prime{$package}{version}, '!=',
                                        $result->{version} ) ) {
            $self->log_warn(
              "Found conflicting versions for package '$package'\n" .
              "  $prime{$package}{file} ($prime{$package}{version})\n" .
              "  $result->{file} ($result->{version})\n"
            );
          }

        } else {
          # The prime package selected has no version so, we choose to
          # use any alternative package that does have a version
          $prime{$package}{file}    = $result->{file};
          $prime{$package}{version} = $result->{version};
        }

      } else {
        # no alt package found with a version, but we have a prime
        # package so we use it whether it has a version or not
      }

    } else { # No primary package was selected, use the best alternative

      if ( $result->{err} ) {
        $self->log_warn(
          "Found conflicting versions for package '$package'\n" .
          $result->{err}
        );
      }

      # Despite possible conflicting versions, we choose to record
      # something rather than nothing
      $prime{$package}{file}    = $result->{file};
      $prime{$package}{version} = $result->{version}
          if defined( $result->{version} );
    }
  }

  # Normalize versions or delete them if undef/0
  for my $provides ( values %prime ) {
    if ( $provides->{version} ) {
      $provides->{version} = $self->normalize_version( $provides->{version} )
    }
    else {
      delete $provides->{version};
    }
  }

  return \%prime;
}

# separate out some of the conflict resolution logic from
# $self->find_dist_packages(), above, into a helper function.
#
sub _resolve_module_versions {
  my $self = shift;

  my $packages = shift;

  my( $file, $version );
  my $err = '';
    foreach my $p ( @$packages ) {
      if ( defined( $p->{version} ) ) {
        if ( defined( $version ) ) {
          if ( $self->compare_versions( $version, '!=', $p->{version} ) ) {
            $err .= "  $p->{file} ($p->{version})\n";
          } else {
            # same version declared multiple times, ignore
          }
        } else {
          $file    = $p->{file};
          $version = $p->{version};
        }
      }
      $file ||= $p->{file} if defined( $p->{file} );
    }

  if ( $err ) {
    $err = "  $file ($version)\n" . $err;
  }

  my %result = (