Hmm, your solution looks really nifty. I might switch to something like that when I've finished this attempt.
My solution is to run a script which targets specific config settings for replacement. For CPAN's Config.pm it does a little bit more than s/?:\\strawberry/$new_prefix/ (mostly pointing to some other include files on the flash drive). Perl's Config.pm on the other hand just needs a search/replace done on it. Config_heavy.pl looks like it needs a combination (and to be honest it hasn't been done properly! there's a lot of references to usr/lib and similar unixisms).
I have a U3 drive because I like UltraEdit32 and the U3 version is pretty much everything you need for non-compiled languages. (I use it for Perl, Javascript, and XHTML).
Here's the script so far, I'll get to work on it more tomorrow. It's a bit niave in some places (uh, like how I haven't used rename) and needs some of the debugging code stripped out.
use strict;
use warnings;
use File::Copy;
use feature "switch";
# This config script is used to reconfigure a number of perl config fi
+les, particularly CPAN's Config.pm, so that they point to the directo
+ry structures on my U3 Flash drive.
# Requires U3 commmand prompt which configures a bunch of really usefu
+l U3 environment variables.
# Version 0.01: Reconfigures CPAN's Config.pm to the 'local' path.
# Version 0.02: Reconfigures Perl's Config.pm to the local path.
# Version 0.03: Code cleanup. Move a few things to subs. reduced doubl
+e looping.
# Version 0.04: Reconfigures Config_heavy.pl
print "Starting U3 Perl configuration\n";
my $debug = undef;
# Find, check and nofify U3_DEVICE_PATH
my $u3drive = $ENV{'U3_DEVICE_PATH'};
die "HALTED: U3_DEVICE_PATH is empty or null\n" unless $u3drive;
print "U3_DEVICE_PATH found, set to \"$u3drive\".\n" if $debug;
# Set directories, I may not need all of these but at this stage I'm n
+ot sure which are needed.
my $strawberryDir = $u3drive."\\strawberry";
my $perlDir = $strawberryDir."\\perl";
my $cpanDir = $strawberryDir."\\cpan";
my $cpanLibDir = $perlDir."\\lib\\cpan";
my $cpanBuildDir = $cpanDir."\\build";
my $cpanSourceDir = $cpanDir."\\sources";
my $sysRoot = $ENV{"SYSTEMROOT"};
# include paths
my $strawberry_include = $strawberryDir."\\c\\include";
my $GTK_include = $u3drive."\\GTK\\include";
my $glib_include = $GTK_include."\\glib-2.0";
my $usr_include = $u3drive."\\usr\\include";
# lib paths
my $strawberry_lib = $strawberryDir."\\c\\lib";
my $GTK_lib = $u3drive."\\GTK\\lib";
my $usr_lib = $u3drive."\\usr\\lib";
# Debug notification
if ($debug){
print "Expected Strawberry directory :\"$strawberryDir\".\n";
print "Expected Perl directory \"$perlDir\".\n";
print "Expected CPAN directory \"$cpanDir\".\n";
print "Expected CPAN lib directory \"$cpanLibDir\".\n";
print "Expected CPAN build directory \"$cpanBuildDir\".\n";
print "Expected CPAN source directory \"$cpanSourceDir\".\n";
print "Expected System Root directory \"$sysRoot\".\n";
}
#Checking those directories are there
checkDir(($strawberryDir, $perlDir, $cpanDir, $cpanLibDir, $cpanBuildD
+ir, $cpanSourceDir, $sysRoot, $strawberry_include, $GTK_include, $usr
+_include, $glib_include, $strawberry_lib, $GTK_lib, $usr_lib));
my $perlConfig = $perlDir."\\lib\\Config.pm";
# Reconfiguring Config.pm
print "Reconfiguring Perl, $perlConfig\n";
{ # Closure used to limit scope... and my editor collapses them...
# Stick the file contents in an array, still small enough for this
+ to be sane
my @content = load_array($perlConfig);
backup ($perlConfig);
if (open PERLCONFIG, ">", $perlConfig){
print "Perl's Config.pm file \"$perlConfig\" opened successful
+ly.\n" if $debug;
}
else {
die "HALT! Could not open \"$perlConfig\": $!\n";
}
$strawberryDir =~ s/\\/\\\\/g; # need to write \\ instead of \
for(@content){
s/.:\\\\strawberry/$strawberryDir/g;
print PERLCONFIG;
}
$strawberryDir =~ s/\\\\/\\/g; # change it back
close PERLCONFIG;
}
print "Done configuring Perl's Config.pm\n";
my $perl_heavy = $perlDir."\\lib\\Config_heavy.pl";
# Config_heavy.pl is... large ~1200 lines of code and comments,
print "Recongfiguring Config_heavy.pl, $perl_heavy\n";
{ # Closure used to limit scope... and my editor collapses them...
my @content = load_array($perl_heavy);
backup($perl_heavy);
# Config_heavy.pl uses the slash in file names... which may not be
+ strictly correct since some of the errors I've seen involve paths li
+ke "X:\strawberry\perl\lib/foo/baa", I'll preserve the status quo for
+ now.
map s!\\!/!g , ($strawberryDir, $strawberry_include, $GTK_include,
+ $usr_include, $strawberry_lib, $GTK_lib, $usr_lib, $glib_include);
if (open CONFIGHEAVY, ">", $perl_heavy){ # wallop original!
print "CPAN config file \"$perl_heavy\" opened successfully.\n
+" if $debug;
}
else {
die "HALT! Could not open \"$perl_heavy\": $!\n";
}
for (@content){
s!.:/strawberry!$strawberryDir!g;
when (/^(glibpth|locincpth|xlibpth)=/){
print "Old: $_" if $debug;
s/'.*'/'$strawberry_include $GTK_include $usr_include $gli
+b_include'/;
print "New: $_" if $debug;
continue;
}
when(/^strings=/){
print "Old: $_" if $debug;
my $strings_dir = $strawberry_include."/string.h";
s/'.*'/'$strings_dir'/;
print "New: $_" if $debug;
continue;
}
when(/^timeincl=/){
print "Old: $_" if $debug;
my $time_dir = $strawberry_include."/time.h";
s/'.*'/'$time_dir'/;
print "New: $_" if $debug;
continue;
}
when(/^sysman=/){
print "Old: $_" if $debug;
my $sysman_dir = $u3drive."/usr/man/man1";
s/'.*'/'$sysman_dir'/;
print "New: $_" if $debug;
continue;
}
when(/^loclibpth=/){
print "Old: $_" if $debug;
s/'.*'/'$strawberry_lib $GTK_lib $usr_lib'/;
print "New: $_" if $debug;
continue;
}
print CONFIGHEAVY;
}
close CONFIGHEAVY;
map s!/!\\!g , ($strawberryDir, $strawberry_include, $GTK_include,
+ $usr_include, $strawberry_lib, $GTK_lib, $usr_lib, $glib_include);
}
print "Done configuring Config_heavy.pl\n";
# Creating file locations
my $cpanConfig = $cpanLibDir."\\Config.pm";
print "Reconfiguring CPAN config file, $cpanConfig\n";
{ # Closure used to limit scope... and my editor collapses them...
# Load the contents into an array, it should be small enough for t
+his to be a sane thing to do.
my @contents = load_array($cpanConfig);
backup ($cpanConfig);
# double those \\ to \\\\ for CPAN's Config.pm
map s/\\/\\\\/g,($strawberryDir, $perlDir, $cpanDir, $cpanLibDir,
+$cpanBuildDir, $cpanSourceDir, $sysRoot, $strawberry_include, $GTK_in
+clude, $usr_include, $strawberry_lib, $GTK_lib, $usr_lib, $glib_inclu
+de);
# Now we're ready to parse the file and change the settings. Using
+ for and where.
# You could just set up a s/$old/$new/g but I think it would be un
+wise, and this method allows you to redirect these to other things e.
+g. I could stick my own preferred ftp command on my flash drive and u
+sed that.
# this for could probably be condensed somewhat...
for(@contents){
when (/build_dir\s/) {
print "old: $_\n" if $debug;
s/\[.*\]/\[$cpanBuildDir\]/;
print "new: $_\n" if $debug;
}
when (/cpan_home\s/){
print "old: $_\n" if $debug;
s/\[.*\]/\[$cpanDir\]/;
print "new: $_\n" if $debug;
}
when (/\sftp\s/){
print "old: $_\n" if $debug;
s/\[.*\]/\[$sysRoot\\\\system32\\\\ftp.exe\]/;
print "new: $_\n" if $debug;
}
when (/histfile\s/){
print "old: $_\n" if $debug;
s/\[.*\]/\[$cpanDir\\\\histfile\]/;
print "new: $_\n" if $debug;
}
when (/keep_source_where\s/){
print "old: $_\n" if $debug;
s/\[.*\]/\[$cpanSourceDir\]/;
print "new: $_\n" if $debug;
}
when (/\smake\s/){
print "old: $_\n" if $debug;
s/\[.*\]/\[$strawberryDir\\c\\bin\\dmake.exe\]/;
print "new: $_\n" if $debug;
}
when (/make_install_arg\s/){
print "old: $_\n" if $debug;
s/\[.*\]/\[PREFIX=$perlDir]/;
print "new: $_\n" if $debug;
}
when (/makepl_arg\s/){ #Note: This one might need to be modifi
+ed further to find other lib and include directories!
print "old: $_\n" if $debug;
s/\[.*\]/\[PREFIX=$perlDir LIBS=$strawberry_lib INC="-I$st
+rawberry_include -I$GTK_include -I$usr_include -I$glib_include"\]/;
print "new: $_\n" if $debug;
}
when (/pager\s/){
print "old: $_\n" if $debug;
s/\[.*\]/\[$sysRoot\\\\system32\\\\more.com]/;
print "new: $_\n" if $debug;
}
when (/prefs_dir\s/){
print "old: $_\n" if $debug;
s/\[.*\]/\[$cpanDir\\\\prefs]/;
print "new: $_\n" if $debug;
}
when (/shell\s/){ # This one probably needs to be changed to u
+se the U3 command prompt
print "old: $_\n" if $debug;
s/\[.*\]/\[$sysRoot\\\\system32\\\\cmd.exe]/;
print "new: $_\n" if $debug;
}
}
# Print back to config file, yes this is a double loop... should i
+ntegrate it into the search/replace loop above.
if (open CPANCONFIG, ">", $cpanConfig){ # wallop original!
print "CPAN config file \"$cpanConfig\" opened successfully.\n
+" if $debug;
}
else {
die "HALT! Could not open \"$cpanConfig\": $!\n";
}
print "Writing to $cpanConfig\n" if $debug;
for (@contents){
print CPANCONFIG;
}
close CPANCONFIG;
# Undo the doubleup
map s/\\\\/\\/g,($strawberryDir, $perlDir, $cpanDir, $cpanLibDir,
+$cpanBuildDir, $cpanSourceDir, $sysRoot, $strawberry_include, $GTK_in
+clude, $usr_include, $strawberry_lib, $GTK_lib, $usr_lib, $glib_inclu
+de);
}
print "Done configuring CPAN\n";
print "Done configuring Perl for U3\n";
# Subroutines only after this
# Checks that a list of names are indeed directories
sub checkDir {
for(@_){
if(-d $_){
print "The directory \"$_\" exists.\n" if $debug;
}
else {
die "HALT! The directory \"$_\" fails: $!\n";
}
}
}
# Returns a files contents in an array. No chomping we need those newl
+ines.
sub load_array{
my $file_name = shift;
if (open THEFILE, "<", $file_name){
print "File \"$file_name\" opened successfully.\n" if $debug;
}
else {
die "HALT! Could not open \"$file_name\": $!\n";
}
my @content = ();
while (<THEFILE>){
push @content, $_;
}
close THEFILE;
@content;
}
# Back it up! If there is no file appended .orig back it up to there,
+otherwise back it up to .last
sub backup {
for my $original (@_){
my $backup = $original.".orig";
if (-e $backup){
$backup = $original.".last";
print "$backup of original exists, using \"$backup\" inste
+ad.\n" if $debug;
}
else {
print "$backup doesn't exist, assuming $original is the or
+iginal.\n" if $debug;
}
unlink $backup; # yes, we don't care if this fails.
if(copy $original, $backup){
print "Renamed to \"$backup\" successfully.\n" if $debug;
}
else {
die "HALT! Could not copy to \"$backup\": $!\n";
}
}
}