#!./bin/perl -w

# setup_perl.pl V1.2
# Perl Binary Distribution setup
# usage BASE [yes]
# BASE is base directory default is .
# yes means confirmed

# this script is run in two modes
# 1) in the build directory to update Config.pm to point to the intended install directory
# 2) in the installed directory to perform all three steps below
#   1 patch Config.pm
#   2 create a replacement 'bin/perl' wrapper shell script
#   3 patch #! lines in bin/*



#use strict;
print "Perl Binary Distribution Setup\n";
my ($VERSION, $V2) = getversion();
print "Perl version is $VERSION\n";

my $cwd = `pwd`; chop $cwd;

my $BASE;
if (@ARGV) { $BASE = shift @ARGV; } else { $BASE = $cwd; }
my $yes = shift @ARGV;
$BASE = $cwd if $BASE eq '.';

print "This will configure Perl for base = $BASE\n";
if (!$yes) {
	yes_or_die();
}
my $file = find_config();
print "Config file = $file\n";

my $config = ReadFile($file);
my $old_config = $config;

my ($ARCHITECTURE) = $config =~ m/^archname='(.*?)'$/m;
print "ARCHITECTURE = $ARCHITECTURE\n";


# 1 Update Config.pm file
my %changelist = get_changelist();
foreach my $dir (keys %changelist) {
	#print "$dir='$changelist{$dir}'\n";
	$config =~ s/\n$dir=[^\n]+/\n$dir='$changelist{$dir}'/gs;
}
if ($config ne $old_config) {
	WriteFile($file, $config);
	print "Updated $file\n";
} else {
	print "No changes required to $file\n";
}

if (!-d "./bin") {
	print "Setup complete\n";
    exit 0;
}


# remaining steps only apply to an installed directory

#   2 create a replacement 'bin/perl' wrapper shell script
my $pw; # perl wrappper script
$pw .= "#!$BASE/bin/perl5.8.0\n";
$pw .= "\$installprivlib='$BASE/lib/$VERSION';\n";
$pw .= "\$installarchlib='$BASE/lib/$VERSION/$ARCHITECTURE';\n";
$pw .= "\$installsitelib='$BASE/lib/site_perl/$V2';\n";
$pw .= "\$installsitearch='$BASE/lib/site_perl/$V2/$ARCHITECTURE';\n";
$pw .= '$ENV{\'PERL5LIB\'}="$ENV{\'PERL5LIB\'}:$installprivlib:$installarchlib:$installsitelib:$installsitearch";' . "\n";
$pw .= "exec {'$BASE/bin/perl5.8.0'} ('$BASE/bin/perl', \@ARGV);\n";

my $f = "$BASE/bin/perl";
my $old_perl_wrap = ReadFile($f) || "";
if ($pw ne $old_perl_wrap) {
    my ($a, $m) = (stat($f))[8,9];
    unlink $f;  # can't write over perl because it is in use
    WriteFile($f, $pw);
    utime ($a, $m, $f);
    chmod (0755, $f);
	print "Updated $f\n";
}
else {
    print "No change to $f required\n";
}

#   3 patch #! lines in bin/*
my @flist = filelist("$BASE/bin");
my $count = 0;
foreach $f (@flist) {
    $f = "$BASE/bin/$f";
    my $old_d = ReadFile($f) || die;
    my $d = $old_d;
    if ($d =~ /^#![^\n]*perl\s/s) {
        $d =~ s|^#![^\n]*perl(\s)|#!$BASE/bin/perl$1|s;
        if ($d ne $old_d) {
            #print "Updating $f\n";
            WriteFile($f, $d, $f);
            $count++;
        }
    }
}
print "Updated $count files in $BASE/bin\n" if ($count);
print "No changes to files in $BASE/bin required\n" if (!$count);



exit;




#print "\nPlease add $BASE/bin to your PATH\n";


sub yes_or_die {
    my $m = shift || "Proceed?";
    print "$m [y] ";
    die "Bailing out\n" if scalar(<STDIN>) !~ /^\s*(y|$)/i;
}


sub ReadFile   # (filename)
{
    # read file in ascii mode
    my ($data);
    open (IN, "$_[0]") || return undef;
    read (IN, $data, (-s $_[0]));
    close IN;
    return $data;
}


sub WriteFile
{
    my ($filename, $data, $time_stamp_file) = @_;

    # save file in ascii mode
    # mode and timestamp is copied from time_stamp_file
    my ($mode) = (stat($time_stamp_file))[2] if (@_ >= 3);
    my ($a, $m) = (stat($time_stamp_file))[8,9] if (@_ >= 3);

    chmod(0666, $filename) if -e $filename;
    open (OUT, ">$filename") || die "Error: Can't write $filename\n";
    print OUT $data;
    close OUT;
    utime ($a, $m, $filename) if (@_ >= 3);
    chmod($mode, $filename) if $mode;
}


sub getversion
{
    # get perl version directories from $]

    my ($VERSION, $V2);
    $VERSION = $];
    $VERSION = "5.6.0" if ($VERSION eq "5.006");
    $VERSION = "5.6.1" if ($VERSION eq "5.006001");
    $VERSION = "5.8.0" if ($VERSION eq "5.008");
    
    if ($VERSION eq "5.00503") {
        $V2 = "5.005";
    }
    elsif ($VERSION eq "5.6.0") {
        $V2 = $VERSION;
    }
    elsif ($VERSION eq "5.6.1") {
        $V2 = $VERSION;
    }
    elsif ($VERSION eq "5.8.0") {
        $V2 = $VERSION;
    }
    else {
        $V2 = $VERSION;
        die "Untested version $VERSION\n";
    }
    return ($VERSION, $V2);
}


sub find_config
{
    # find config.pm file, below current directory
    my $file;
    my $flist = `find . -name Config.pm`;
    $flist = join(" ", split("\n", $flist));
    # /dev/null is a hack to deal with problem on libc5 systems	
    my @files = `grep -l archname= /dev/null $flist`;
    if (@files > 1) {
     ($file) = grep { /$^O\// } @files;
    } else {
      $file = $files[0];
    }
    chop $file if $file =~ /\n$/s;

    if (! -f $file) {
        die "Can't locate Config.pm\nPlease run $0 from the top level directory of the Perl binary distribution.\n";
     }
    return $file;
}


sub get_changelist
{
    my %changelist = ( 
     'installbin' => "$BASE/bin",
     'installscript' => "$BASE/bin",
     'bin' => "$BASE/bin",
     'binexp' => "$BASE/bin",
     'scriptdir' => "$BASE/bin",
     'scriptdirexp' => "$BASE/bin",
    
     'installprivlib' => "$BASE/lib/$VERSION",
     'privlib' => "$BASE/lib/$VERSION",
     'privlibexp' => "$BASE/lib/$VERSION",
    
     'installarchlib' => "$BASE/lib/$VERSION/$ARCHITECTURE",
     'archlib' => "$BASE/lib/$VERSION/$ARCHITECTURE",
     'archlibexp' => "$BASE/lib/$VERSION/$ARCHITECTURE",
    
     'installsitelib' => "$BASE/lib/site_perl/$V2",
     'sitelib' => "$BASE/lib/site_perl/$V2",
     'sitelibexp' => "$BASE/lib/site_perl/$V2",
    
     'installsitearch' => "$BASE/lib/site_perl/$V2/$ARCHITECTURE",
     'sitearch' => "$BASE/lib/site_perl/$V2/$ARCHITECTURE",
     'sitearchexp' => "$BASE/lib/site_perl/$V2/$ARCHITECTURE",
    
     'perlpath' => "$BASE/bin/perl",
     
     'installman1dir' => "$BASE/man/man1",
     'man1dir' => "$BASE/man/man1",
     'man1direxp' => "$BASE/man/man1",
     'installman3dir' => "$BASE/man/man3",
     'man3dir' => "$BASE/man/man3'",
     'man3direxp' => "$BASE/man/man3",
    
     'prefix' => "$BASE",
     'prefixexp' => "$BASE",
     'installprefix' => "$BASE",
     'installprefixexp' => "$BASE",
     'installsitebin' => "$BASE",
     'sitebin' => "$BASE",
     'sitebinexp' => "$BASE",
     'siteprefix' => "$BASE",
     'siteprefixexp' => "$BASE",
     );
    return %changelist;

    #linux paths look like this
    #installprivlib='/usr/lib/perl5/5.00503'
    #installarchlib='/usr/lib/perl5/5.00503/i686-linux'
    
    #installsitelib='/usr/lib/perl5/site_perl/5.005'
    #installsitearch='/usr/lib/perl5/site_perl/5.005/i686-linux'
    #installman1dir='/usr/man/man1'
    #installman3dir='/usr/lib/perl5/5.00503/man/man3'
}



sub filelist
{
    # get bare list of file
    my ($dir) = @_;
    my @flist;
    opendir(DIR, $dir) || die "can't opendir $dir: $!";
    @flist = readdir(DIR);
    closedir DIR;
    @flist = grep ( !/^(\.|\.\.)$/ , @flist);
    @flist = sort @flist;
    @flist = grep (-f "$dir/$_", @flist);
}
