Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses

Re^2: Changing Perl compile-time configuration settings

by Bloodrage (Monk)
on Feb 21, 2008 at 02:28 UTC ( #669172=note: print w/replies, xml ) Need Help??

in reply to Re: Changing Perl compile-time configuration settings
in thread Changing Perl compile-time configuration settings

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 it does a little bit more than s/?:\\strawberry/$new_prefix/ (mostly pointing to some other include files on the flash drive). Perl's on the other hand just needs a search/replace done on it. 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, 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 to the 'local' path. # Version 0.02: Reconfigures Perl's to the local path. # Version 0.03: Code cleanup. Move a few things to subs. reduced doubl +e looping. # Version 0.04: Reconfigures 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\\"; # Reconfiguring 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 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\n"; my $perl_heavy = $perlDir."\\lib\\"; # is... large ~1200 lines of code and comments, print "Recongfiguring, $perl_heavy\n"; { # Closure used to limit scope... and my editor collapses them... my @content = load_array($perl_heavy); backup($perl_heavy); # 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\n"; # Creating file locations my $cpanConfig = $cpanLibDir."\\"; 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 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\\\\]/; 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"; } } }
Updated: Now does Perl's Updated again: Now does

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://669172]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (5)
As of 2018-03-21 09:09 GMT
Find Nodes?
    Voting Booth?
    When I think of a mole I think of:

    Results (265 votes). Check out past polls.