1use Config; 2use File::Basename qw(&basename &dirname); 3use File::Spec; 4use Cwd; 5 6my $origdir = cwd; 7chdir dirname($0); 8my $file = basename($0, '.PL'); 9$file =~ s!_(pm)$!.$1!i; 10 11my $useConfig; 12my $Config_archname; 13my $Config_version; 14my $Config_inc_version_list; 15 16# Expand the variables only if explicitly requested because 17# otherwise relocating Perl becomes much harder. 18 19if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) { 20 $useConfig = ''; 21 $Config_archname = qq('$Config{archname}'); 22 $Config_version = qq('$Config{version}'); 23 my @Config_inc_version_list = 24 reverse split / /, $Config{inc_version_list}; 25 $Config_inc_version_list = 26 @Config_inc_version_list ? 27 qq(@Config_inc_version_list) : q(()); 28} else { 29 $useConfig = 'use Config;'; 30 $Config_archname = q($Config{archname}); 31 $Config_version = q($Config{version}); 32 $Config_inc_version_list = 33 q(reverse split / /, $Config{inc_version_list}); 34} 35 36open OUT,">$file" or die "Can't create $file: $!"; 37 38print "Extracting $file (with variable substitutions)\n"; 39 40# In this section, perl variables will be expanded during extraction. 41# You can use $Config{...} to use Configure variables. 42 43print OUT <<"!GROK!THIS!"; 44package lib; 45 46# THIS FILE IS AUTOMATICALLY GENERATED FROM lib_pm.PL. 47# ANY CHANGES TO THIS FILE WILL BE OVERWRITTEN BY THE NEXT PERL BUILD. 48 49$useConfig 50 51use strict; 52 53my \$archname = $Config_archname; 54my \$version = $Config_version; 55my \@inc_version_list = $Config_inc_version_list; 56 57!GROK!THIS! 58print OUT <<'!NO!SUBS!'; 59 60our @ORIG_INC = @INC; # take a handy copy of 'original' value 61our $VERSION = '0.5565'; 62my $Is_MacOS = $^O eq 'MacOS'; 63my $Mac_FS; 64if ($Is_MacOS) { 65 require File::Spec; 66 $Mac_FS = eval { require Mac::FileSpec::Unixish }; 67} 68 69sub import { 70 shift; 71 72 my %names; 73 foreach (reverse @_) { 74 my $path = $_; # we'll be modifying it, so break the alias 75 if ($path eq '') { 76 require Carp; 77 Carp::carp("Empty compile time value given to use lib"); 78 } 79 80 $path = _nativize($path); 81 82 if (-e $path && ! -d _) { 83 require Carp; 84 Carp::carp("Parameter to use lib must be directory, not file"); 85 } 86 unshift(@INC, $path); 87 # Add any previous version directories we found at configure time 88 foreach my $incver (@inc_version_list) 89 { 90 my $dir = $Is_MacOS 91 ? File::Spec->catdir( $path, $incver ) 92 : "$path/$incver"; 93 unshift(@INC, $dir) if -d $dir; 94 } 95 # Put a corresponding archlib directory in front of $path if it 96 # looks like $path has an archlib directory below it. 97 my($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir) 98 = _get_dirs($path); 99 unshift(@INC, $arch_dir) if -d $arch_auto_dir; 100 unshift(@INC, $version_dir) if -d $version_dir; 101 unshift(@INC, $version_arch_dir) if -d $version_arch_dir; 102 } 103 104 # remove trailing duplicates 105 @INC = grep { ++$names{$_} == 1 } @INC; 106 return; 107} 108 109 110sub unimport { 111 shift; 112 113 my %names; 114 foreach (@_) { 115 my $path = _nativize($_); 116 117 my($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir) 118 = _get_dirs($path); 119 ++$names{$path}; 120 ++$names{$arch_dir} if -d $arch_auto_dir; 121 ++$names{$version_dir} if -d $version_dir; 122 ++$names{$version_arch_dir} if -d $version_arch_dir; 123 } 124 125 # Remove ALL instances of each named directory. 126 @INC = grep { !exists $names{$_} } @INC; 127 return; 128} 129 130sub _get_dirs { 131 my($dir) = @_; 132 my($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir); 133 134 # we could use this for all platforms in the future, but leave it 135 # Mac-only for now, until there is more time for testing it. 136 if ($Is_MacOS) { 137 $arch_auto_dir = File::Spec->catdir( $dir, $archname, 'auto' ); 138 $arch_dir = File::Spec->catdir( $dir, $archname, ); 139 $version_dir = File::Spec->catdir( $dir, $version ); 140 $version_arch_dir = File::Spec->catdir( $dir, $version, $archname ); 141 } else { 142 $arch_auto_dir = "$dir/$archname/auto"; 143 $arch_dir = "$dir/$archname"; 144 $version_dir = "$dir/$version"; 145 $version_arch_dir = "$dir/$version/$archname"; 146 } 147 return($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir); 148} 149 150sub _nativize { 151 my($dir) = @_; 152 153 if ($Is_MacOS && $Mac_FS && ! -d $dir) { 154 $dir = Mac::FileSpec::Unixish::nativize($dir); 155 $dir .= ":" unless $dir =~ /:$/; 156 } 157 158 return $dir; 159} 160 1611; 162__END__ 163 164=head1 NAME 165 166lib - manipulate @INC at compile time 167 168=head1 SYNOPSIS 169 170 use lib LIST; 171 172 no lib LIST; 173 174=head1 DESCRIPTION 175 176This is a small simple module which simplifies the manipulation of @INC 177at compile time. 178 179It is typically used to add extra directories to perl's search path so 180that later C<use> or C<require> statements will find modules which are 181not located on perl's default search path. 182 183=head2 Adding directories to @INC 184 185The parameters to C<use lib> are added to the start of the perl search 186path. Saying 187 188 use lib LIST; 189 190is I<almost> the same as saying 191 192 BEGIN { unshift(@INC, LIST) } 193 194For each directory in LIST (called $dir here) the lib module also 195checks to see if a directory called $dir/$archname/auto exists. 196If so the $dir/$archname directory is assumed to be a corresponding 197architecture specific directory and is added to @INC in front of $dir. 198 199To avoid memory leaks, all trailing duplicate entries in @INC are 200removed. 201 202=head2 Deleting directories from @INC 203 204You should normally only add directories to @INC. If you need to 205delete directories from @INC take care to only delete those which you 206added yourself or which you are certain are not needed by other modules 207in your script. Other modules may have added directories which they 208need for correct operation. 209 210The C<no lib> statement deletes all instances of each named directory 211from @INC. 212 213For each directory in LIST (called $dir here) the lib module also 214checks to see if a directory called $dir/$archname/auto exists. 215If so the $dir/$archname directory is assumed to be a corresponding 216architecture specific directory and is also deleted from @INC. 217 218=head2 Restoring original @INC 219 220When the lib module is first loaded it records the current value of @INC 221in an array C<@lib::ORIG_INC>. To restore @INC to that value you 222can say 223 224 @INC = @lib::ORIG_INC; 225 226=head1 CAVEATS 227 228In order to keep lib.pm small and simple, it only works with Unix 229filepaths. This doesn't mean it only works on Unix, but non-Unix 230users must first translate their file paths to Unix conventions. 231 232 # VMS users wanting to put [.stuff.moo] into 233 # their @INC would write 234 use lib 'stuff/moo'; 235 236=head1 NOTES 237 238In the future, this module will likely use File::Spec for determining 239paths, as it does now for Mac OS (where Unix-style or Mac-style paths 240work, and Unix-style paths are converted properly to Mac-style paths 241before being added to @INC). 242 243=head1 SEE ALSO 244 245FindBin - optional module which deals with paths relative to the source file. 246 247=head1 AUTHOR 248 249Tim Bunce, 2nd June 1995. 250 251=cut 252!NO!SUBS! 253 254close OUT or die "Can't close $file: $!"; 255chdir $origdir; 256