#!./perl5/bin/perl5.26.1 -I./perl5/lib
use strict;
use warnings;
use Config;


my $verbose = 0;
my $oldprefix = $Config{prefix};

my $cwd = `pwd`; chomp $cwd;
my $newprefix = "$cwd/perl5";

print "oldprefix = $oldprefix\n" if ($verbose);
print "newprefix = $newprefix\n" if ($verbose);
print "This will setup your perl installation for directory:\n$newprefix\n";


my @files = dirlist_recursive("./perl5");
@files = grep (-f $_, @files);

if (0) {
    # This block of code was used to discover file that need to be patched
    foreach my $f (@files) {
        my $d = readfile("$f");
        if ($d =~ /$oldprefix/) {
            my $count = $d =~ s/$oldprefix/$newprefix/g;
            print "$f LIB $count changes\n";
        }
    }
    exit(0);
}


my $count_files_changed = 0;

my @lib_files = ("Config.pm", "Config_heavy.pl", "perllocal.pod", "CORE/config.h");
@lib_files = map { "./perl5/lib/$_" } @lib_files;

foreach my $f (@lib_files) {
    my $d = readfile("$f");
    die "ERROR file not found $f\n" if (!defined $d);
    if ($d =~ /$oldprefix/) {
        my $old_data = $d;
        my $count = $d =~ s/$oldprefix/$newprefix/g;
        if ($d ne $old_data) {
            print "$f LIB $count changes\n" if ($verbose);
            writefile($f, $d, $f);
            $count_files_changed++;
        }
    }
    else {
        # ignore binary files
        print "$f LIB NO CHANGES\n";
    }
}

my @bin_files = filelist("./perl5/bin");
@bin_files = map { "./perl5/bin/$_" } @bin_files;
foreach my $f (@bin_files) {
    my $d = readfile("$f");
    if ($d =~ /^#!/) {
        my $old_data = $d;
        my $count = $d =~ s/$oldprefix/$newprefix/g;
        if ($d ne $old_data) {
            print "$f SCRIPT $count changes\n" if ($verbose);
            writefile($f, $d, $f);  # preserve mode and time - need exec permission
            $count_files_changed++;
        }
    }
    else {
        # ignore binary files
        # print "$f BINARY NO CHANGES\n";
    }
}

print "Files changed: $count_files_changed\n";
print "\nUpdate your PATH as follows:\n";
print "PATH=$cwd:$cwd/perl5/bin:\$PATH\n";

sub filelist
{
    # get bare list of file in specified directory
    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);
}


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 optionally 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 dirlist_recursive
{
    my($maindir, $pattern) = @_;

    # recursively get list of files and directories
    # dir = starting directory, $pattern = regular expression
    # to get files only use: @files = grep (-f $_, DirList($dir, $pattern));
    # to remove leading directory path use: my $l = length($dir); @files = map(substr($_, $l+1), @files);

    my $dir;
    my @subdirs = $maindir;
    my(@files, $e);

    while (@subdirs) {
        $dir = shift @subdirs;

        # read all the entries for this directory
        opendir(DIR, $dir) || die "$0: error opening directory $dir: $!\n";
        my (@e) = ();
        while (defined($e = readdir(DIR))) {
            push(@e, $e) if ($e ne "." && $e ne "..");
        }
        closedir(DIR);
        # it only makes sense to sort within a directory, if at all
        #@e = sort @e;

        foreach $e (@e) {
            if (-d "$dir/$e") {  # directory
                push(@subdirs, "$dir/$e");
                push(@files, "$dir/$e");
            } elsif ((!$pattern) || $e =~ /$pattern/) {
                push(@files, "$dir/$e");
            }
        }
    }

    return @files;
}

