nix results from the CPAN

Alien-V8

    # 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, $c->get('perlpath') );

    push( @potential_perls,
          map File::Spec->catfile($_, $perl_basename), File::Spec->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 = $c->get('exe_ext');
  foreach my $thisperl ( @potential_perls ) {

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

    if ( -f $thisperl && $proto->_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 File::Basename::dirname($_), @potential_perls;
  die "Can't locate the perl binary used to run this script " .
      "in (@paths)\n";
}

# Adapted from IPC::Cmd::can_run()
sub find_command {
    my ($self, $command) = @_;

    if( File::Spec->file_name_is_absolute($command) ) {
        return $self->_maybe_command($command);

    } else {
        for my $dir ( File::Spec->path ) {
            my $abs = File::Spec->catfile($dir, $command);
            return $abs if $abs = $self->_maybe_command($abs);
        }
    }
}

# Copied from ExtUtils::MM_Unix::maybe_command
sub _maybe_command {
    my($self,$file) = @_;
    return $file if -x $file && ! -d $file;
    return;
}

sub _is_interactive {
  return -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;   # Pipe?
}

# NOTE this is a blocking operation if(-t STDIN)
sub _is_unattended {
  my $self = shift;
  return $ENV{PERL_MM_USE_DEFAULT} ||
    ( !$self->_is_interactive && eof STDIN );
}

sub _readline {
  my $self = shift;
  return undef if $self->_is_unattended;

  my $answer = <STDIN>;
  chomp $answer if defined $answer;
  return $answer;
}

sub prompt {
  my $self = shift;
  my $mess = shift
    or die "prompt() called without a prompt message";

  # use a list to distinguish a default of undef() from no default
  my @def;
  @def = (shift) if @_;
  # use dispdef for output
  my @dispdef = scalar(@def) ?
    ('[', (defined($def[0]) ? $def[0] . ' ' : ''), ']') :
    (' ', '');

  local $|=1;
  print "$mess ", @dispdef;

  if ( $self->_is_unattended && !@def ) {
    die <<EOF;
ERROR: This build seems to be unattended, but there is no default value
for this question.  Aborting.
EOF
  }

  my $ans = $self->_readline();

  if ( !defined($ans)        # Ctrl-D or unattended
       or !length($ans) ) {  # User hit return
    print "$dispdef[1]\n";
    $ans = scalar(@def) ? $def[0] : '';
  }

  return $ans;
}

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

      return \%status;
    }

    $status{have} = $pm_info->version();
    if ($spec and !defined($status{have})) {
      @status{ qw(have message) } = (undef, "Couldn't find a \$VERSION in prerequisite $modname");
      return \%status;
    }
  }

  my @conditions = $self->_parse_conditions($spec);

  foreach (@conditions) {
    my ($op, $version) = /^\s*  (<=?|>=?|==|!=)  \s*  ([\w.]+)  \s*$/x
      or die "Invalid prerequisite condition '$_' for $modname";

    $version = $self->perl_version_to_float($version)
      if $modname eq 'perl';

    next if $op eq '>=' and !$version;  # Module doesn't have to actually define a $VERSION

    unless ($self->compare_versions( $status{have}, $op, $version )) {
      $status{message} = "$modname ($status{have}) is installed, but we need version $op $version";
      return \%status;
    }
  }

  $status{ok} = 1;
  return \%status;
}

sub compare_versions {
  my $self = shift;
  my ($v1, $op, $v2) = @_;
  $v1 = Module::Build::Version->new($v1)
    unless UNIVERSAL::isa($v1,'Module::Build::Version');

  my $eval_str = "\$v1 $op \$v2";
  my $result   = eval $eval_str;
  $self->log_warn("error comparing versions: '$eval_str' $@") if $@;

  return $result;
}

# I wish I could set $! to a string, but I can't, so I use $@
sub check_installed_version {
  my ($self, $modname, $spec) = @_;

  my $status = $self->check_installed_status($modname, $spec);

  if ($status->{ok}) {
    return $status->{have} if $status->{have} and "$status->{have}" ne '<none>';
    return '0 but true';
  }

  $@ = $status->{message};
  return 0;
}

sub make_executable {
  # Perl's chmod() is mapped to useful things on various non-Unix
  # platforms, so we use it in the base class even though it looks
  # Unixish.

  my $self = shift;
  foreach (@_) {
    my $current_mode = (stat $_)[2];
    chmod $current_mode | oct(111), $_;
  }
}

sub is_executable {
  # We assume this does the right thing on generic platforms, though
  # we do some other more specific stuff on Unixish platforms.
  my ($self, $file) = @_;
  return -x $file;
}

sub _startperl { shift()->config('startperl') }

# Return any directories in @INC which are not in the default @INC for
# this perl.  For example, stuff passed in with -I or loaded with "use lib".
sub _added_to_INC {
  my $self = shift;

  my %seen;
  $seen{$_}++ foreach $self->_default_INC;
  return grep !$seen{$_}++, @INC;
}

# Determine the default @INC for this Perl
{
  my @default_inc; # Memoize
  sub _default_INC {
    my $self = shift;
    return @default_inc if @default_inc;

    local $ENV{PERL5LIB};  # this is not considered part of the default.

    my $perl = ref($self) ? $self->perl : $self->find_perl_interpreter;

    my @inc = $self->_backticks($perl, '-le', 'print for @INC');
    chomp @inc;

    return @default_inc = @inc;
  }
}

sub print_build_script {
  my ($self, $fh) = @_;

  my $build_package = $self->build_class;

  my $closedata="";

  my %q = map {$_, $self->$_()} qw(config_dir base_dir);

  my $case_tolerant = 0+(File::Spec->can('case_tolerant')
			 && File::Spec->case_tolerant);
  $q{base_dir} = uc $q{base_dir} if $case_tolerant;
  $q{base_dir} = Win32::GetShortPathName($q{base_dir}) if $self->is_windowsish;

  $q{magic_numfile} = $self->config_file('magicnum');

  my @myINC = $self->_added_to_INC;
  for (@myINC, values %q) {
    $_ = File::Spec->canonpath( $_ );
    s/([\\\'])/\\$1/g;
  }

  my $quoted_INC = join ",\n", map "     '$_'", @myINC;
  my $shebang = $self->_startperl;
  my $magic_number = $self->magic_number;

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

    } elsif ( /^($opt_re)$/ and !defined($action)) {
      $action = $1;
    } else {
      push @argv, $_;
    }
  }
  $args{ARGV} = \@argv;

  for ('extra_compiler_flags', 'extra_linker_flags') {
    $args{$_} = [ $self->split_like_shell($args{$_}) ] if exists $args{$_};
  }

  # Convert to arrays
  for ('include_dirs') {
    $args{$_} = [ $args{$_} ] if exists $args{$_} && !ref $args{$_}
  }

  # Hashify these parameters
  for ($self->hash_properties, 'config') {
    next unless exists $args{$_};
    my %hash;
    $args{$_} ||= [];
    $args{$_} = [ $args{$_} ] unless ref $args{$_};
    foreach my $arg ( @{$args{$_}} ) {
      $arg =~ /(\w+)=(.*)/
	or die "Malformed '$_' argument: '$arg' should be something like 'foo=bar'";
      $hash{$1} = $2;
    }
    $args{$_} = \%hash;
  }

  # De-tilde-ify any path parameters
  for my $key (qw(prefix install_base destdir)) {
    next if !defined $args{$key};
    $args{$key} = $self->_detildefy($args{$key});
  }

  for my $key (qw(install_path)) {
    next if !defined $args{$key};

    for my $subkey (keys %{$args{$key}}) {
      next if !defined $args{$key}{$subkey};
      my $subkey_ext = $self->_detildefy($args{$key}{$subkey});
      if ( $subkey eq 'html' ) { # translate for compatibility
	$args{$key}{binhtml} = $subkey_ext;
	$args{$key}{libhtml} = $subkey_ext;
      } else {
	$args{$key}{$subkey} = $subkey_ext;
      }
    }
  }

  if ($args{makefile_env_macros}) {
    require Module::Build::Compat;
    %args = (%args, Module::Build::Compat->makefile_to_build_macros);
  }

  return \%args, $action;
}

# Default: do nothing.  Overridden for Unix & Windows.
sub _detildefy {}


# merge Module::Build argument lists that have already been parsed
# by read_args(). Takes two references to option hashes and merges
# the contents, giving priority to the first.
sub _merge_arglist {
  my( $self, $opts1, $opts2 ) = @_;

  $opts1 ||= {};
  $opts2 ||= {};
  my %new_opts = %$opts1;
  while (my ($key, $val) = each %$opts2) {
    if ( exists( $opts1->{$key} ) ) {
      if ( ref( $val ) eq 'HASH' ) {
        while (my ($k, $v) = each %$val) {
	  $new_opts{$key}{$k} = $v unless exists( $opts1->{$key}{$k} );
	}
      }
    } else {
      $new_opts{$key} = $val
    }
  }

  return %new_opts;
}

# Look for a home directory on various systems.
sub _home_dir {
  my @home_dirs;
  push( @home_dirs, $ENV{HOME} ) if $ENV{HOME};

  push( @home_dirs, File::Spec->catpath($ENV{HOMEDRIVE}, $ENV{HOMEPATH}, '') )
      if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};

  my @other_home_envs = qw( USERPROFILE APPDATA WINDIR SYS$LOGIN );
  push( @home_dirs, map $ENV{$_}, grep $ENV{$_}, @other_home_envs );

  my @real_home_dirs = grep -d, @home_dirs;

  return wantarray ? @real_home_dirs : shift( @real_home_dirs );
}

sub _find_user_config {
  my $self = shift;
  my $file = shift;
  foreach my $dir ( $self->_home_dir ) {
    my $path = File::Spec->catfile( $dir, $file );
    return $path if -e $path;
  }
  return undef;
}

# read ~/.modulebuildrc returning global options '*' and
# options specific to the currently executing $action.
sub read_modulebuildrc {
  my( $self, $action ) = @_;

  return () unless $self->use_rcfile;

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

  return { @file_map };
}

sub _share_dir_map {
  my ($self, $prefix, $list) = @_;
  my %files;
  for my $dir ( @$list ) {
    for my $f ( @{ $self->rscan_dir( $dir, sub {-f} )} ) {
      $f =~ s{\A.*\Q$dir\E/}{};
      $files{"$dir/$f"} = "$prefix/$f";
    }
  }
  return %files;
}

sub process_PL_files {
  my ($self) = @_;
  my $files = $self->find_PL_files;

  while (my ($file, $to) = each %$files) {
    unless ($self->up_to_date( $file, $to )) {
      $self->run_perl_script($file, [], [@$to]) or die "$file failed";
      $self->add_to_cleanup(@$to);
    }
  }
}

sub process_xs_files {
  my $self = shift;
  my $files = $self->find_xs_files;
  while (my ($from, $to) = each %$files) {
    unless ($from eq $to) {
      $self->add_to_cleanup($to);
      $self->copy_if_modified( from => $from, to => $to );
    }
    $self->process_xs($to);
  }
}

sub process_pod_files { shift()->process_files_by_extension(shift()) }
sub process_pm_files  { shift()->process_files_by_extension(shift()) }

sub process_script_files {
  my $self = shift;
  my $files = $self->find_script_files;
  return unless keys %$files;

  my $script_dir = File::Spec->catdir($self->blib, 'script');
  File::Path::mkpath( $script_dir );

  foreach my $file (keys %$files) {
    my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next;
    $self->fix_shebang_line($result) unless $self->is_vmsish;
    $self->make_executable($result);
  }
}

sub find_PL_files {
  my $self = shift;
  if (my $files = $self->{properties}{PL_files}) {
    # 'PL_files' is given as a Unix file spec, so we localize_file_path().

    if (UNIVERSAL::isa($files, 'ARRAY')) {
      return { map {$_, [/^(.*)\.PL$/]}
	       map $self->localize_file_path($_),
	       @$files };

    } elsif (UNIVERSAL::isa($files, 'HASH')) {
      my %out;
      while (my ($file, $to) = each %$files) {
	$out{ $self->localize_file_path($file) } = [ map $self->localize_file_path($_),
						     ref $to ? @$to : ($to) ];
      }
      return \%out;

    } else {
      die "'PL_files' must be a hash reference or array reference";
    }
  }

  return unless -d 'lib';
  return { map {$_, [/^(.*)\.PL$/i ]} @{ $self->rscan_dir('lib',
                                                          file_qr('\.PL$')) } };
}

sub find_pm_files  { shift->_find_file_by_type('pm',  'lib') }
sub find_pod_files { shift->_find_file_by_type('pod', 'lib') }
sub find_xs_files  { shift->_find_file_by_type('xs',  'lib') }

sub find_script_files {
  my $self = shift;
  if (my $files = $self->script_files) {
    # Always given as a Unix file spec.  Values in the hash are
    # meaningless, but we preserve if present.
    return { map {$self->localize_file_path($_), $files->{$_}} keys %$files };
  }

  # No default location for script files
  return {};
}

sub find_test_files {
  my $self = shift;
  my $p = $self->{properties};

  if (my $files = $p->{test_files}) {
    $files = [keys %$files] if UNIVERSAL::isa($files, 'HASH');
    $files = [map { -d $_ ? $self->expand_test_dir($_) : $_ }
	      map glob,
	      $self->split_like_shell($files)];

    # Always given as a Unix file spec.
    return [ map $self->localize_file_path($_), @$files ];

  } else {
    # Find all possible tests in t/ or test.pl
    my @tests;
    push @tests, 'test.pl'                          if -e 'test.pl';
    push @tests, $self->expand_test_dir('t')        if -e 't' and -d _;
    return \@tests;
  }
}

sub _find_file_by_type {
  my ($self, $type, $dir) = @_;

  if (my $files = $self->{properties}{"${type}_files"}) {
    # Always given as a Unix file spec
    return { map $self->localize_file_path($_), %$files };
  }

  return {} unless -d $dir;
  return { map {$_, $_}
	   map $self->localize_file_path($_),
	   grep !/\.\#/,
	   @{ $self->rscan_dir($dir, file_qr("\\.$type\$")) } };
}

sub localize_file_path {
  my ($self, $path) = @_;
  return File::Spec->catfile( split m{/}, $path );
}

sub localize_dir_path {
  my ($self, $path) = @_;
  return File::Spec->catdir( split m{/}, $path );
}

sub fix_shebang_line { # Adapted from fixin() in ExtUtils::MM_Unix 1.35
  my ($self, @files) = @_;
  my $c = ref($self) ? $self->{config} : 'Module::Build::Config';

  my ($does_shbang) = $c->get('sharpbang') =~ /^\s*\#\!/;
  for my $file (@files) {
    my $FIXIN = IO::File->new($file) or die "Can't process '$file': $!";
    local $/ = "\n";
    chomp(my $line = <$FIXIN>);
    next unless $line =~ s/^\s*\#!\s*//;     # Not a shbang file.

    my ($cmd, $arg) = (split(' ', $line, 2), '');
    next unless $cmd =~ /perl/i;
    my $interpreter = $self->{properties}{perl};

    $self->log_verbose("Changing sharpbang in $file to $interpreter");
    my $shb = '';
    $shb .= $c->get('sharpbang')."$interpreter $arg\n" if $does_shbang;

    # I'm not smart enough to know the ramifications of changing the
    # embedded newlines here to \n, so I leave 'em in.
    $shb .= qq{
eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
    if 0; # not running under some shell
} unless $self->is_windowsish; # this won't work on win32, so don't

    my $FIXOUT = IO::File->new(">$file.new")
      or die "Can't create new $file: $!\n";

    # Print out the new #! line (or equivalent).
    local $\;
    undef $/; # Was localized above
    print $FIXOUT $shb, <$FIXIN>;
    close $FIXIN;
    close $FIXOUT;

    rename($file, "$file.bak")
      or die "Can't rename $file to $file.bak: $!";

    rename("$file.new", $file)
      or die "Can't rename $file.new to $file: $!";

    $self->delete_filetree("$file.bak")
      or $self->log_warn("Couldn't clean up $file.bak, leaving it there");

    $self->do_system($c->get('eunicefix'), $file) if $c->get('eunicefix') ne ':';
  }
}


sub ACTION_testpod {
  my $self = shift;
  $self->depends_on('docs');

  eval q{use Test::Pod 0.95; 1}
    or die "The 'testpod' action requires Test::Pod version 0.95";

  my @files = sort keys %{$self->_find_pods($self->libdoc_dirs)},
                   keys %{$self->_find_pods
                             ($self->bindoc_dirs,
                              exclude => [ file_qr('\.bat$') ])}

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

      $self->installdirs eq 'core' ? qw(lib) : qw(site lib);

  my $podpath = join ':',
                map  $_->[1],
                grep -e $_->[0],
                map  [File::Spec->catdir($self->blib, $_), $_],
                qw( script lib );

  foreach my $pod ( keys %$pods ) {

    my ($name, $path) = File::Basename::fileparse($pods->{$pod},
                                                 file_qr('\.(?:pm|plx?|pod)$'));
    my @dirs = File::Spec->splitdir( File::Spec->canonpath( $path ) );
    pop( @dirs ) if scalar(@dirs) && $dirs[-1] eq File::Spec->curdir;

    my $fulldir = File::Spec->catfile($htmldir, @rootdirs, @dirs);
    my $outfile = File::Spec->catfile($fulldir, "${name}.html");
    my $infile  = File::Spec->abs2rel($pod);

    next if $self->up_to_date($infile, $outfile);

    unless ( -d $fulldir ){
      File::Path::mkpath($fulldir, 0, oct(755))
        or die "Couldn't mkdir $fulldir: $!";
    }

    my $path2root = join( '/', ('..') x (@rootdirs+@dirs) );
    my $htmlroot = join( '/',
			 ($path2root,
			  $self->installdirs eq 'core' ? () : qw(site) ) );

    my $fh = IO::File->new($infile) or die "Can't read $infile: $!";
    my $abstract = Module::Build::PodParser->new(fh => $fh)->get_abstract();

    my $title = join( '::', (@dirs, $name) );
    $title .= " - $abstract" if $abstract;

    my @opts = (
                '--flush',
                "--title=$title",
                "--podpath=$podpath",
                "--infile=$infile",
                "--outfile=$outfile",
                '--podroot=' . $self->blib,
                "--htmlroot=$htmlroot",
               );

    if ( eval{Pod::Html->VERSION(1.03)} ) {
      push( @opts, ('--header', '--backlink=Back to Top') );
      push( @opts, "--css=$path2root/" . $self->html_css) if $self->html_css;
    }

    $self->log_verbose("HTMLifying $infile -> $outfile\n");
    $self->log_verbose("pod2html @opts\n");
    eval { Pod::Html::pod2html(@opts); 1 }
      or $self->log_warn("pod2html @opts failed: $@");
  }

}

# Adapted from ExtUtils::MM_Unix
sub man1page_name {
  my $self = shift;
  return File::Basename::basename( shift );
}

# Adapted from ExtUtils::MM_Unix and Pod::Man
# Depending on M::B's dependency policy, it might make more sense to refactor
# Pod::Man::begin_pod() to extract a name() methods, and use them...
#    -spurkis
sub man3page_name {
  my $self = shift;
  my ($vol, $dirs, $file) = File::Spec->splitpath( shift );
  my @dirs = File::Spec->splitdir( File::Spec->canonpath($dirs) );

  # Remove known exts from the base name
  $file =~ s/\.p(?:od|m|l)\z//i;

  return join( $self->manpage_separator, @dirs, $file );
}

sub manpage_separator {
  return '::';
}

# For systems that don't have 'diff' executable, should use Algorithm::Diff
sub ACTION_diff {
  my $self = shift;
  $self->depends_on('build');
  my $local_lib = File::Spec->rel2abs('lib');
  my @myINC = grep {$_ ne $local_lib} @INC;

  # The actual install destination might not be in @INC, so check there too.
  push @myINC, map $self->install_destination($_), qw(lib arch);

  my @flags = @{$self->{args}{ARGV}};
  @flags = $self->split_like_shell($self->{args}{flags} || '') unless @flags;

  my $installmap = $self->install_map;
  delete $installmap->{read};
  delete $installmap->{write};

  my $text_suffix = file_qr('\.(pm|pod)$');

  while (my $localdir = each %$installmap) {
    my @localparts = File::Spec->splitdir($localdir);
    my $files = $self->rscan_dir($localdir, sub {-f});

    foreach my $file (@$files) {
      my @parts = File::Spec->splitdir($file);
      @parts = @parts[@localparts .. $#parts]; # Get rid of blib/lib or similar

      my $installed = Module::Build::ModuleInfo->find_module_by_name(
                        join('::', @parts), \@myINC );
      if (not $installed) {
	print "Only in lib: $file\n";
	next;
      }

      my $status = File::Compare::compare($installed, $file);
      next if $status == 0;  # Files are the same
      die "Can't compare $installed and $file: $!" if $status == -1;

      if ($file =~ $text_suffix) {
	$self->do_system('diff', @flags, $installed, $file);
      } else {
	print "Binary files $file and $installed differ\n";

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

  }
  my $map = { $self->_merge_arglist(
    $self->{properties}{original_prefix},
    $self->_default_install_paths->{original_prefix}
  )};
  return $map unless defined $key;
  return $map->{$key}
}

sub install_base_relpaths {
  # Usage: install_base_relpaths(), install_base_relpaths('lib'),
  #   or install_base_relpaths('lib' => $value);
  my $self = shift;
  if ( @_ > 1 ) { # change values before merge
    $self->_set_relpaths($self->{properties}{install_base_relpaths}, @_);
  }
  my $map = { $self->_merge_arglist(
    $self->{properties}{install_base_relpaths},
    $self->_default_install_paths->{install_base_relpaths}
  )};
  return $map unless @_;
  my $relpath = $map->{$_[0]};
  return defined $relpath ? File::Spec->catdir( @$relpath ) : undef;
}

# Defaults to use in case the config install paths cannot be prefixified.
sub prefix_relpaths {
  # Usage: prefix_relpaths('site'), prefix_relpaths('site', 'lib'),
  #   or prefix_relpaths('site', 'lib' => $value);
  my $self = shift;
  my $installdirs = shift || $self->installdirs
    or croak "Can't determine installdirs for prefix_relpaths()";
  if ( @_ > 1 ) { # change values before merge
    $self->{properties}{prefix_relpaths}{$installdirs} ||= {};
    $self->_set_relpaths($self->{properties}{prefix_relpaths}{$installdirs}, @_);
  }
  my $map = {$self->_merge_arglist(
    $self->{properties}{prefix_relpaths}{$installdirs},
    $self->_default_install_paths->{prefix_relpaths}{$installdirs}
  )};
  return $map unless @_;
  my $relpath = $map->{$_[0]};
  return defined $relpath ? File::Spec->catdir( @$relpath ) : undef;
}

sub _set_relpaths {
  my $self = shift;
  my( $map, $type, $value ) = @_;

  Carp::croak( 'Type argument missing' )
    unless defined( $type );

  # set undef if $value is literal undef()
  if ( ! defined( $value ) ) {
    $map->{$type} = undef;
    return;
  }
  # set value if $value is a valid relative path
  else {
    Carp::croak( "Value must be a relative path" )
      if File::Spec::Unix->file_name_is_absolute($value);

    my @value = split( /\//, $value );
    $map->{$type} = \@value;
  }
}

# Translated from ExtUtils::MM_Any::init_INSTALL_from_PREFIX
sub prefix_relative {
  my ($self, $type) = @_;
  my $installdirs = $self->installdirs;

  my $relpath = $self->install_sets($installdirs)->{$type};

  return $self->_prefixify($relpath,
			   $self->original_prefix($installdirs),
			   $type,
			  );
}

# Translated from ExtUtils::MM_Unix::prefixify()
sub _prefixify {
  my($self, $path, $sprefix, $type) = @_;

  my $rprefix = $self->prefix;
  $rprefix .= '/' if $sprefix =~ m|/$|;

  $self->log_verbose("  prefixify $path from $sprefix to $rprefix\n")
    if defined( $path ) && length( $path );

  if( !defined( $path ) || ( length( $path ) == 0 ) ) {
    $self->log_verbose("  no path to prefixify, falling back to default.\n");
    return $self->_prefixify_default( $type, $rprefix );
  } elsif( !File::Spec->file_name_is_absolute($path) ) {
    $self->log_verbose("    path is relative, not prefixifying.\n");
  } elsif( $path !~ s{^\Q$sprefix\E\b}{}s ) {
    $self->log_verbose("    cannot prefixify, falling back to default.\n");
    return $self->_prefixify_default( $type, $rprefix );
  }

  $self->log_verbose("    now $path in $rprefix\n");

  return $path;
}

sub _prefixify_default {
  my $self = shift;
  my $type = shift;
  my $rprefix = shift;

  my $default = $self->prefix_relpaths($self->installdirs, $type);
  if( !$default ) {
    $self->log_verbose("    no default install location for type '$type', using prefix '$rprefix'.\n");
    return $rprefix;
  } else {
    return $default;
  }
}

sub install_destination {
  my ($self, $type) = @_;

  return $self->install_path($type) if $self->install_path($type);

  if ( $self->install_base ) {
    my $relpath = $self->install_base_relpaths($type);
    return $relpath ? File::Spec->catdir($self->install_base, $relpath) : undef;
  }

  if ( $self->prefix ) {
    my $relpath = $self->prefix_relative($type);
    return $relpath ? File::Spec->catdir($self->prefix, $relpath) : undef;
  }

  return $self->install_sets($self->installdirs)->{$type};
}

sub install_types {
  my $self = shift;

  my %types;

( run in 0.612 second using v1.01-cache-2.11-cpan-39bf76dae61 )