view release on metacpan or  search on metacpan

share/perl-5.20/installperl  view on Meta::CPAN

	while (exists $ENV{'DCL$PATH' . $i}) {
	    my $dir = unixpath($ENV{'DCL$PATH' . $i});  $dir =~ s-/$--;
	    push(@path,$dir);
	}
    }
    my @otherperls;
    my %otherperls;
    for (@path) {
	next unless m,^/,;
	# Use &samepath here because some systems have other dirs linked
	# to $mainperldir (like SunOS)
	next unless -d;
	next if samepath($_, $binexp);
	next if samepath($_, cwd());
	next if ($mainperl_is_instperl && samepath($_, $mainperldir));
	my $otherperl = "$_/$perl$exe_ext";
	next if $otherperls{$otherperl}++;
	push(@otherperls, $otherperl)
	    if (-x $otherperl && ! -d $otherperl);
    }
    if (@otherperls) {
	warn "\nWarning: $perl appears in your path in the following " .
	    "locations beyond where\nwe just installed it:\n";
	for (@otherperls) {
	    warn "    ", $_, "\n";
	}
	warn "\n";
    }

}

$packlist->write() unless $opts{notify};
print "  Installation complete\n" if $opts{verbose};

exit 0;

###############################################################################

# If these are needed elsewhere, move them into install_lib.pl rather than
# copying them.

sub yn {
    my($prompt) = @_;
    my($answer);
    my($default) = $prompt =~ m/\[([yn])\]\s*$/i;
    print STDERR $prompt;
    chop($answer = <STDIN>);
    $answer = $default if $answer =~ m/^\s*$/;
    ($answer =~ m/^[yY]/);
}

sub safe_unlink {
    return if $opts{notify} or $Is_VMS;
    my @names = @_;
    foreach my $name (@names) {
	next unless -e $name;
	chmod 0777, $name if ($Is_OS2 || $Is_W32 || $Is_NetWare);
	print "  unlink $name\n" if $opts{verbose};
	next if CORE::unlink($name);
	warn "Couldn't unlink $name: $!\n";
	if ($! =~ /busy/i) {
	    print "  mv $name $name.old\n" if $opts{verbose};
	    safe_rename($name, "$name.old")
		or warn "Couldn't rename $name: $!\n";
	}
    }
}

sub copy {
    my($from,$to) = @_;

    my $xto = $to;
    $xto =~ s/^\Q$opts{destdir}\E//;
    print $opts{verbose} ? "  cp $from $xto\n" : "  $xto\n"
	unless $opts{silent};
    print "  creating new version of $xto\n"
	if $Is_VMS and -e $to and !$opts{silent};
    unless ($opts{notify} or File::Copy::copy($from, $to)) {
	# Might have been that F::C::c can't overwrite the target
	warn "Couldn't copy $from to $to: $!\n"
	    unless -f $to and (chmod(0666, $to), unlink $to)
		   and File::Copy::copy($from, $to);
    }
    $packlist->{$xto} = { type => 'file' };
}

sub installlib {
    my $dir = $File::Find::dir;
    $dir =~ s!\Alib/?!!;

    m!([^/]+)\z!;
    my $name = $1;

    # This remains ugly, and in need of refactoring.

    # $name always starts as the leafname
    # $dir is the directory *within* lib
    # $name later has $dir pre-pended, to give the relative path in lib/
    # which is used to create the path in the target directory.

    # $_ was always the filename to use on disk. Adding no_chdir doesn't change
    # this, as $_ becomes a pathname, and so still works. However, it's not
    # obvious that $_ is needed later, and hence $_ must not be modified.

    # Also, many of the regex exclusion tests below are now superfluous, as the
    # files in question are either no longer in blead, or now in ext/, dist/ or
    # cpan/ and not copied into lib/

    # Ignore version control directories.
    if ($name =~ /^(?:CVS|RCS|SCCS|\.svn)\z/ and -d $name) {
	$File::Find::prune = 1;
	return;
    }

    # ignore patch backups, RCS files, emacs backup & temp files and the
    # .exists files, .PL files, and test files.
    return if $name =~ m{\.orig$|\.rej$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.plc$|\.t$|^test\.pl$|^dbm_filter_util\.pl$|^filter-util\.pl$|^uupacktool\.pl$|^\.gitignore$} ||
	      $dir  =~ m{/t(?:/|$)};
    # ignore the cpan script in lib/CPAN/bin, the instmodsh and xsubpp
    # scripts in lib/ExtUtils, the prove script in lib/Test/Harness,
    # the corelist script from lib/Module/CoreList/bin and ptar* in