perl5.000 patch.0i: fix glaring mistakes in patches a-h

[perl5.git] / installperl

#!./perl
BEGIN { @INC=('./lib', '../lib') }
use Config;
use File::Find;

$mainperldir = "/usr/bin";

while (@ARGV) {
    $nonono = 1 if $ARGV[0] eq '-n';
    $versiononly = 1 if $ARGV[0] eq '-v';
    shift;
}

umask 022;

@scripts = ('cppstdin', 'c2ph', 'pstruct', 'x2p/s2p', 'x2p/find2perl');
@manpages = (<pod/*.man>, 'x2p/a2p.man', 'x2p/s2p.man');

# Read in the config file.

open(CONFIG, "config.sh") || die "You haven't run Configure yet!\n";
while (<CONFIG>) {
    if (s/^(\w+=)/\$$1/) {
	$accum =~ s/'undef'/undef/g;
	eval $accum;
	$accum = '';
    }
    $accum .= $_;
}
close CONFIG;

$ver = sprintf("%5.3f", $] + 0);
$release = substr($ver,0,3);
$patchlevel = substr($ver,3,2);

# Do some quick sanity checks.

if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; }

   $installbin		|| die "No installbin directory in config.sh\n";
-d $installbin		|| die "$installbin is not a directory\n";
-w $installbin		|| die "$installbin is not writable by you\n"
	unless $installbin =~ m#^/afs/# || $nonono;

-x 'perl'		|| die "perl isn't executable!\n";
-x 'suidperl'		|| die "suidperl isn't executable!\n" if $d_dosuid;

-x 't/TEST'		|| warn "WARNING: You've never run 'make test'!!!",
	"  (Installing anyway.)\n";

if ($d_shrplib) {
    if (!<libperl*.$so*>) {
	warn "WARNING: Can't find libperl*.$so* to install into $shrpdir.",
	    "  (Installing other things anyway.)\n";
    } else {
	&makedir($shrpdir);
	-w $shrpdir	|| die "$shrpdir is not writable by you\n";
	&cmd("cp libperl*.$so* $shrpdir");
    }
}

# First we install the version-numbered executables.

&unlink("$installbin/perl$ver");
&cmd("cp perl $installbin/perl$ver");

&unlink("$installbin/sperl$ver");
if ($d_dosuid) {
    &cmd("cp suidperl $installbin/sperl$ver");
    &chmod(04711, "$installbin/sperl$ver");
}

exit 0 if $versiononly;

# Make links to ordinary names if installbin directory isn't current directory.

if (! &samepath($installbin, '.')) {
    &unlink("$installbin/perl", "$installbin/suidperl");
    &link("$installbin/perl$ver", "$installbin/perl");
    &link("$installbin/sperl$ver", "$installbin/suidperl") if $d_dosuid;
}

if (! &samepath($installbin, 'x2p')) {
    &unlink("$installbin/a2p");
    &cmd("cp x2p/a2p $installbin/a2p");
    &chmod(0755, "$installbin/a2p");
}

# Install scripts.

&makedir($installscript);

for (@scripts) {
    if (-f $_) {   # cppstdin might not exist on this system.
	&cmd("cp $_ $installscript");
	s#.*/##; &chmod(0755, "$installscript/$_");
    }
}

# Install man pages.

if ($installmansrc ne '') {
    &makedir($installmansrc);

    if (! &samepath($installmansrc, '.')) {
	for (@manpages) {
	    ($new = $_) =~ s/man$/$manext/;
	    $new =~ s#.*/##;
	    print STDERR "  Installing $installmansrc/$new\n";
	    next if $nonono;
	    open(MI,$_) || warn "Can't open $_: $!\n";
	    open(MO,">$installmansrc/$new") || warn "Can't install $installmansrc/$new: $!\n";
	    print MO ".ds RP Release $release Patchlevel $patchlevel\n";
	    while (<MI>) {
		print MO;
	    }
	    close MI;
	    close MO;
	}
    }
}

# Install library files.

$do_installarchlib = $do_installprivlib = 0;
    
&makedir($installprivlib);
&makedir($installarchlib);
if (chdir "lib") {
    $do_installarchlib = ! &samepath($installarchlib, '.');
    $do_installprivlib = ! &samepath($installprivlib, '.');

    if ($do_installarchlib || $do_installprivlib) {
	find(\&installlib, '.');
    }
    chdir ".." || die "Can't cd back to source directory: $!\n";
}
else {
    warn "Can't cd to lib to install lib files: $!\n";
}

# Install header files and libraries
makedir("$installarchlib/CORE");
foreach $file (<*.h libperl*.*>) {
    cp_if_diff($file,"$installarchlib/CORE/$file");
    if ($file =~ /\.a$/ && $Config{'osname'} eq 'next') { 
       #on NeXTs we have to rerun ranlib after copying libraries
       &cmd("$Config{'ranlib'} $installarchlib/CORE/$file");
    }
}

# Offer to install perl in a "standard" location

$mainperl_is_instperl = 0;

if (-w $mainperldir && ! &samepath($mainperldir, $installbin) && !$nonono) {
    # First make sure $mainperldir/perl is not already the same as
    # the perl we just installed
    if (-x "$mainperldir/perl") {
	# Try to be clever about mainperl being a symbolic link
	# to binexp/perl if binexp and installbin are different.
	$mainperl_is_instperl =
	    &samepath("$mainperldir/perl", "$installbin/perl") ||
	     (($binexp ne $installbin) &&
	      (-l "$mainperldir/perl") &&
	      ((readlink "$mainperldir/perl") eq "$binexp/perl"));
    }
    if ((! $mainperl_is_instperl) &&
	(&yn("Many scripts expect perl to be installed as " .
	     "$mainperldir/perl.\n" . 
	     "Do you wish to have $mainperldir/perl be the same as\n" .
	     "$binexp/perl? [y] ")))
    {	
	unlink("$mainperldir/perl");
	eval 'link("$installbin/perl", "$mainperldir/perl")' ||
	eval 'symlink("$binexp/perl", "$mainperldir/perl")' ||
	&cmd("cp $installbin/perl $mainperldir");
	$mainperl_is_instperl = 1;
    }
}

# Check to make sure there aren't other perls around in installer's
# path.  This is probably UNIX-specific.  Check all absolute directories
# in the path except for where public executables are supposed to live.
# Also skip $mainperl if the user opted to have it be a link to the
# installed perl.

@path = split(/:/, $ENV{"PATH"});
@otherperls = ();
for (@path) {
    next unless m,^/,;
    next if ($_ eq $binexp);
    # Use &samepath here because some systems have other dirs linked
    # to $mainperldir (like SunOS)
    next if ($mainperl_is_instperl && &samepath($_, $mainperldir));
    push(@otherperls, "$_/perl") if (-x "$_/perl" && ! -d "$_/perl");
}
if (@otherperls) {
    print STDERR "\nWarning: perl appears in your path in the following " .
	"locations beyond where\nwe just installed it:\n";
    for (@otherperls) {
	print STDERR "    ", $_, "\n";
    }
    print STDERR "\n";
}

print STDERR "  Installation complete\n";

exit 0;

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

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

sub unlink {
    local(@names) = @_;

    foreach $name (@names) {
	next unless -e $name;
	print STDERR "  unlink $name\n";
	unlink($name) || warn "Couldn't unlink $name: $!\n" unless $nonono;
    }
}

sub cmd {
    local($cmd) = @_;
    print STDERR "  $cmd\n";
    unless ($nonono) {
	system $cmd;
	warn "Command failed!!!\n" if $?;
    }
}

sub link {
    local($from,$to) = @_;

    print STDERR "  ln $from $to\n";
    link($from,$to) || warn "Couldn't link $from to $to: $!\n" unless $nonono;
}

sub chmod {
    local($mode,$name) = @_;

    printf STDERR "  chmod %o %s\n", $mode, $name;
    chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n",$mode,$name)
	unless $nonono;
}

sub makedir {
    local($dir) = @_;
    unless (-d $dir) {
	local($shortdir) = $dir;

	$shortdir =~ s#(.*)/.*#$1#;
	&makedir($shortdir);

	print STDERR "  mkdir $dir\n";
	mkdir($dir, 0777) || warn "Couldn't create $dir: $!\n" unless $nonono;
    }
}

sub samepath {
    local($p1, $p2) = @_;
    local($dev1, $ino1, $dev2, $ino2);

    if ($p1 ne $p2) {
	($dev1, $ino1) = stat($p1);
	($dev2, $ino2) = stat($p2);
	($dev1 == $dev2 && $ino1 == $ino2);
    }
    else {
	1;
    }
}

sub installlib {
    my $dir = $File::Find::dir;
    $dir =~ s#^\.(?![^/])/?##;

    my $name = $_;
    $name = "$dir/$name" if $dir ne '';

    my $installlib = $installprivlib;
    if ((substr($dir, 0, 4) eq 'auto') || ($name eq 'Config.pm')) {
        $installlib = $installarchlib;
	return unless $do_installarchlib;
    } else {
	return unless $do_installprivlib;
    }

    if (-f $_) {
	if (/\.al$/ || /\.ix$/) {
	    $installlib = $installprivlib;
	    #We're installing *.al and *.ix files into $installprivlib,
	    #but we have to delete old *.al and *.ix files from the 5.000
	    #distribution:
	    #This might not work because $archname might have changed.
	    &unlink("$installarchlib/$name");
	}
	system "cmp", "-s", $_, "$installlib/$name";
	if ($?) {
	    &unlink("$installlib/$name");
	    &makedir("$installlib/$dir");
	    &cmd("cp $_ $installlib/$dir");
	    if (/\.a$/ && $Config{'osname'} eq 'next') { 
		#on NeXTs we have to rerun ranlib after copying libraries
		&cmd("$Config{'ranlib'} $installlib/$dir/$_");
	    }
	    # HP-UX (at least) needs to maintain execute permissions
	    # on dynamically-loaded libraries.
	    &chmod(0644, "$installlib/$name") 
		unless (/\.$so$/ || /\.$dlext$/);
	}
    } elsif (-d $_) {
	&makedir("$installlib/$name");
    }
}

sub cp_if_diff {
    my($from,$to)=@_;
    -f $from || die "$0: $from not found";
    system "cmp", "-s", $from, $to;
    if ($?) {
	cmd("cp $from $to");
    }
}