view release on metacpan or  search on metacpan

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

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 = 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);
}

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.  Can't use exists() here because of bug in YAML::Node.
  # XXX "bug in YAML::Node" comment seems irrelvant -- dagolden, 2009-05-18
  for (grep defined $_->{version}, values %prime) {
    $_->{version} = $self->normalize_version( $_->{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 = (
    file    => $file,
    version => $version,
    err     => $err
  );