#! perl -w use strict; # Quick script to help manage multiple environments of Perl. # Allows you to capture the state of various Perl distributions # in directories and switch the combination in use without editing # anything. This script customises the environment. # This version needs a 'Win32' (Windows 95 or Windows NT) machine. # Martin.Cleaver@BCS.org.uk. Comments welcome # # C:\win32app\perl-extra-libs\ # dev\ # standard # LWP # IO # FTP # override # adhoc # # prod\ # standard # LWP # IO # FTP # override # adhoc package main; require "NT.ph"; @argv = @ARGV; # Something wipes @ARGV before I use it. sub usage { print <<'EOM' perllib standard_lib adhoc_lib override_lib where standard_lib adhoc_lib override_lib are names of directories in directory c:\win32app\perl-extra-libs\ and all default to 'prod'. typing perllib by itself shows current setting. eg. perllib prod // switch to prod mode eg. perllib dev prod dev // use dev libraries for standard and override EOM } sub log { ( $message ) = @_; # print LOG $message; print $message; } sub gripe { ( $message ) = @_; # print LOG $message; warn $message; } if ($#argv>-1 && $argv[0] eq '-h') { usage(); exit 0; } NTRegCreateKeyEx( &HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Resource Kit\PERL5', &NULL, 'NT Perl 5', ®_OPTION_NON_VOLATILE, &KEY_ALL_ACCESS, &NULL, $hkey, $disposition ) || &gripe( "Couldn't add key for Perl 5 to NT Registry Database!!\n" ); if ( $disposition == ®_OPENED_EXISTING_KEY ) { &gripe( "Key exists...\n" ); } NTRegQueryValueEx( $hkey, 'PRIVLIB', &NULL, $type, $current_lib ); if ($#argv != -1) { print "Old PRIVLIB setting:\n".split_lib($current_lib)."\n"; $stdlib = $argv[0]; $adlib = $argv[1] || 'prod'; $ovlib = $argv[2] || 'prod'; $libdir = 'C:/win32app/perl-extra-libs/'.$ovlib.'/override;'. 'C:/win32app/perl5/lib;'. 'C:/win32app/perl-extra-libs/'.$adlib.'/adhoc;'. 'C:/win32app/perl-extra-libs/'.$stdlib.'/standard;'; $libdir =~ s(\\)(/); NTRegSetValueEx( $hkey, 'PRIVLIB', &NULL, ®_SZ, "$libdir" ) ? &log( "Adding ".split_lib($libdir)." to library include path information\n" ): &gripe( "Couldn't add library path to registry!!\n" ); NTRegQueryValueEx( $hkey, 'PRIVLIB', &NULL, $type, $current_lib ); } print "\n\nCurrent PRIVLIB setting:\n".split_lib($current_lib)."\n"; print "\nType perllib -h for help\n"; NTRegCloseKey( $hkey ); sub split_lib { my ($current_lib) = @_; $current_lib =~ s/\;/\n\t/g; return "\t".$current_lib; }