#! perl

use Config;
use File::Basename qw/basename dirname/;
use File::Spec::Functions qw/catfile catdir path/;

my $perl_path;

sub find_perl {
	$perl_path ||= _discover_perl()
}

sub _discover_perl_interpreter {
	my $perl = $^X;
	my $perl_basename = basename($perl);

	my @potential_perls;

	# Try 1, Check $^X for absolute path
	push @potential_perls, $perl if File::Spec->file_name_is_absolute($perl);

	# Try 2, Check $^X for a valid relative path
	my $abs_perl = File::Spec->rel2abs($perl);
	push @potential_perls, $abs_perl;

	# Try 3, Last ditch effort: These two option use hackery to try to locate
	# a suitable perl. The hack varies depending on whether we are running
	# from an installed perl or an uninstalled perl in the perl source dist.
	if ($ENV{PERL_CORE}) {
		# Try 3.A, If we are in a perl source tree, running an uninstalled
		# perl, we can keep moving up the directory tree until we find our
		# binary. We wouldn't do this under any other circumstances.

		# CBuilder is also in the core, so it should be available here
		require ExtUtils::CBuilder;
		my $perl_src = Cwd::realpath( ExtUtils::CBuilder->perl_src );
		if (defined $perl_src && length $perl_src) {
			my $uninstperl = File::Spec->rel2abs(File::Spec->catfile( $perl_src, $perl_basename ));
			push @potential_perls, $uninstperl;
		}
	}
	else {
		# Try 3.B, First look in $Config{perlpath}, then search the user's
		# PATH. We do not want to do either if we are running from an
		# uninstalled perl in a perl source tree.

		push @potential_perls, $Config{perlpath};

		push @potential_perls, map { catfile($_, $perl_basename) } path();
	}

	# Now that we've enumerated the potential perls, it's time to test
	# them to see if any of them match our configuration, returning the
	# absolute path of the first successful match.
	my $exe = $Config{exe_ext};
	for my $thisperl (@potential_perls) {

		if (defined $exe) {
			$thisperl .= $exe unless $thisperl =~ m/$exe$/i;
		}

		if ( -f $thisperl && _perl_is_same($thisperl) ) {
			return $thisperl;
		}
	}

	# We've tried all alternatives, and didn't find a perl that matches
	# our configuration. Throw an exception, and list alternatives we tried.
	my @paths = map { dirname($_) } @potential_perls;
	die "Can't locate the perl binary used to run this script in (@paths)\n";
}

sub _perl_is_same {
  my $perl = shift;
  my @cmd = $perl;

  # When run from the perl core, @INC will include the directories
  # where perl is yet to be installed. We need to reference the
  # absolute path within the source distribution where it can find
  # it's Config.pm This also prevents us from picking up a Config.pm
  # from a different configuration that happens to be already
  # installed in @INC.
  if ($ENV{PERL_CORE}) {
    push @cmd, '-I' . catdir(File::Basename::dirname($perl), 'lib');
  }

  push @cmd, qw(-MConfig=myconfig -e print -e myconfig);
  return `@cmd` eq Config->myconfig;
}