Commit | Line | Data |
---|---|---|
60ed1d8c GS |
1 | use Config; |
2 | use File::Basename qw(&basename &dirname); | |
3 | use File::Spec; | |
4 | use Cwd; | |
5 | ||
6 | my $origdir = cwd; | |
7 | chdir dirname($0); | |
8 | my $file = basename($0, '.PL'); | |
a811a5cf | 9 | $file =~ s/_(pm)$/.$1/i; |
60ed1d8c | 10 | |
e9c6cca7 GS |
11 | my $useConfig; |
12 | my $Config_archname; | |
13 | my $Config_version; | |
14 | my $Config_inc_version_list; | |
15 | ||
70f874d3 S |
16 | # Expand the variables only if explicitly requested |
17 | # or if a previously installed lib.pm does this, too | |
18 | # because otherwise relocating Perl becomes much harder. | |
e9c6cca7 | 19 | |
70f874d3 | 20 | my $expand_config_vars = 0; |
e9c6cca7 | 21 | if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) { |
70f874d3 S |
22 | $expand_config_vars = 1; |
23 | } | |
24 | elsif (exists $ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) { | |
25 | $expand_config_vars = 0; | |
26 | } | |
27 | else { | |
28 | eval <<'HERE'; | |
29 | require lib; | |
30 | my $lib_file = $INC{"lib.pm"}; | |
31 | open my $fh, '<', $lib_file | |
32 | or die "Could not open file '$lib_file' for reading: $!"; | |
33 | my $ConfigRegex = qr/(?:use|require)\s+Config(?:\s+|;)/; | |
a811a5cf | 34 | my $found_config = 0; |
70f874d3 S |
35 | while (defined($_ = <$fh>)) { |
36 | # crude heuristics to check that we were using Config | |
37 | if (/^\s*$ConfigRegex/ || /^\s*eval.*$ConfigRegex/) { | |
a811a5cf | 38 | $found_config = 1; |
70f874d3 S |
39 | last; |
40 | } | |
41 | } | |
a811a5cf | 42 | $expand_config_vars = $found_config ? 0 : 1; |
70f874d3 S |
43 | HERE |
44 | $expand_config_vars = 0 if $@; | |
45 | } | |
46 | ||
47 | if ($expand_config_vars) { | |
e9c6cca7 GS |
48 | $useConfig = ''; |
49 | $Config_archname = qq('$Config{archname}'); | |
50 | $Config_version = qq('$Config{version}'); | |
51 | my @Config_inc_version_list = | |
52 | reverse split / /, $Config{inc_version_list}; | |
53 | $Config_inc_version_list = | |
54 | @Config_inc_version_list ? | |
a811a5cf | 55 | qq(qw(@Config_inc_version_list)) : q(()); |
e9c6cca7 GS |
56 | } else { |
57 | $useConfig = 'use Config;'; | |
58 | $Config_archname = q($Config{archname}); | |
59 | $Config_version = q($Config{version}); | |
60 | $Config_inc_version_list = | |
91a12f7d | 61 | q(reverse split / /, $Config{inc_version_list}); |
e9c6cca7 | 62 | } |
60ed1d8c GS |
63 | |
64 | open OUT,">$file" or die "Can't create $file: $!"; | |
65 | ||
66 | print "Extracting $file (with variable substitutions)\n"; | |
67 | ||
68 | # In this section, perl variables will be expanded during extraction. | |
69 | # You can use $Config{...} to use Configure variables. | |
70 | ||
71 | print OUT <<"!GROK!THIS!"; | |
e50aee73 AD |
72 | package lib; |
73 | ||
427f4adb TC |
74 | # THIS FILE IS AUTOMATICALLY GENERATED FROM lib_pm.PL. |
75 | # ANY CHANGES TO THIS FILE WILL BE OVERWRITTEN BY THE NEXT PERL BUILD. | |
4633a7c4 | 76 | |
e9c6cca7 GS |
77 | $useConfig |
78 | ||
fbc36ba3 JH |
79 | use strict; |
80 | ||
e9c6cca7 GS |
81 | my \$archname = $Config_archname; |
82 | my \$version = $Config_version; | |
83 | my \@inc_version_list = $Config_inc_version_list; | |
60ed1d8c GS |
84 | |
85 | !GROK!THIS! | |
86 | print OUT <<'!NO!SUBS!'; | |
4633a7c4 | 87 | |
17f410f9 | 88 | our @ORIG_INC = @INC; # take a handy copy of 'original' value |
6f03633b | 89 | our $VERSION = '0.61'; |
d5201bd2 JH |
90 | my $Is_MacOS = $^O eq 'MacOS'; |
91 | my $Mac_FS; | |
92 | if ($Is_MacOS) { | |
93 | require File::Spec; | |
94 | $Mac_FS = eval { require Mac::FileSpec::Unixish }; | |
95 | } | |
e50aee73 AD |
96 | |
97 | sub import { | |
98 | shift; | |
aeb5d71d GS |
99 | |
100 | my %names; | |
a5f75d66 | 101 | foreach (reverse @_) { |
57797241 AB |
102 | my $path = $_; # we'll be modifying it, so break the alias |
103 | if ($path eq '') { | |
af3dad46 | 104 | require Carp; |
774d564b | 105 | Carp::carp("Empty compile time value given to use lib"); |
af3dad46 | 106 | } |
d5201bd2 | 107 | |
57797241 | 108 | $path = _nativize($path); |
d5201bd2 | 109 | |
4f923b56 | 110 | if ($path !~ /\.par$/i && -e $path && ! -d _) { |
20408e3c GS |
111 | require Carp; |
112 | Carp::carp("Parameter to use lib must be directory, not file"); | |
113 | } | |
57797241 | 114 | unshift(@INC, $path); |
d5201bd2 | 115 | # Add any previous version directories we found at configure time |
e438405d | 116 | foreach my $incver (@inc_version_list) |
d5201bd2 JH |
117 | { |
118 | my $dir = $Is_MacOS | |
57797241 AB |
119 | ? File::Spec->catdir( $path, $incver ) |
120 | : "$path/$incver"; | |
d5201bd2 JH |
121 | unshift(@INC, $dir) if -d $dir; |
122 | } | |
57797241 AB |
123 | # Put a corresponding archlib directory in front of $path if it |
124 | # looks like $path has an archlib directory below it. | |
d5201bd2 | 125 | my($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir) |
57797241 | 126 | = _get_dirs($path); |
d5201bd2 JH |
127 | unshift(@INC, $arch_dir) if -d $arch_auto_dir; |
128 | unshift(@INC, $version_dir) if -d $version_dir; | |
129 | unshift(@INC, $version_arch_dir) if -d $version_arch_dir; | |
4633a7c4 | 130 | } |
abef537a GS |
131 | |
132 | # remove trailing duplicates | |
133 | @INC = grep { ++$names{$_} == 1 } @INC; | |
134 | return; | |
e50aee73 AD |
135 | } |
136 | ||
137 | ||
138 | sub unimport { | |
139 | shift; | |
e50aee73 AD |
140 | |
141 | my %names; | |
aeb5d71d | 142 | foreach (@_) { |
63c6dcc1 | 143 | my $path = _nativize($_); |
d5201bd2 JH |
144 | |
145 | my($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir) | |
63c6dcc1 JH |
146 | = _get_dirs($path); |
147 | ++$names{$path}; | |
d5201bd2 JH |
148 | ++$names{$arch_dir} if -d $arch_auto_dir; |
149 | ++$names{$version_dir} if -d $version_dir; | |
150 | ++$names{$version_arch_dir} if -d $version_arch_dir; | |
4633a7c4 | 151 | } |
e50aee73 | 152 | |
aeb5d71d GS |
153 | # Remove ALL instances of each named directory. |
154 | @INC = grep { !exists $names{$_} } @INC; | |
abef537a | 155 | return; |
e50aee73 AD |
156 | } |
157 | ||
d5201bd2 JH |
158 | sub _get_dirs { |
159 | my($dir) = @_; | |
160 | my($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir); | |
161 | ||
162 | # we could use this for all platforms in the future, but leave it | |
163 | # Mac-only for now, until there is more time for testing it. | |
164 | if ($Is_MacOS) { | |
63c6dcc1 JH |
165 | $arch_auto_dir = File::Spec->catdir( $dir, $archname, 'auto' ); |
166 | $arch_dir = File::Spec->catdir( $dir, $archname, ); | |
167 | $version_dir = File::Spec->catdir( $dir, $version ); | |
168 | $version_arch_dir = File::Spec->catdir( $dir, $version, $archname ); | |
d5201bd2 | 169 | } else { |
63c6dcc1 JH |
170 | $arch_auto_dir = "$dir/$archname/auto"; |
171 | $arch_dir = "$dir/$archname"; | |
172 | $version_dir = "$dir/$version"; | |
173 | $version_arch_dir = "$dir/$version/$archname"; | |
d5201bd2 JH |
174 | } |
175 | return($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir); | |
176 | } | |
177 | ||
178 | sub _nativize { | |
179 | my($dir) = @_; | |
180 | ||
5b865721 | 181 | if ($Is_MacOS && $Mac_FS && ! -d $dir) { |
d5201bd2 JH |
182 | $dir = Mac::FileSpec::Unixish::nativize($dir); |
183 | $dir .= ":" unless $dir =~ /:$/; | |
184 | } | |
185 | ||
186 | return $dir; | |
187 | } | |
188 | ||
4633a7c4 | 189 | 1; |
e50aee73 AD |
190 | __END__ |
191 | ||
192 | =head1 NAME | |
193 | ||
194 | lib - manipulate @INC at compile time | |
195 | ||
196 | =head1 SYNOPSIS | |
197 | ||
198 | use lib LIST; | |
199 | ||
200 | no lib LIST; | |
201 | ||
202 | =head1 DESCRIPTION | |
203 | ||
204 | This is a small simple module which simplifies the manipulation of @INC | |
205 | at compile time. | |
206 | ||
207 | It is typically used to add extra directories to perl's search path so | |
208 | that later C<use> or C<require> statements will find modules which are | |
209 | not located on perl's default search path. | |
210 | ||
aeb5d71d | 211 | =head2 Adding directories to @INC |
e50aee73 AD |
212 | |
213 | The parameters to C<use lib> are added to the start of the perl search | |
214 | path. Saying | |
215 | ||
216 | use lib LIST; | |
217 | ||
4633a7c4 | 218 | is I<almost> the same as saying |
e50aee73 AD |
219 | |
220 | BEGIN { unshift(@INC, LIST) } | |
221 | ||
4633a7c4 LW |
222 | For each directory in LIST (called $dir here) the lib module also |
223 | checks to see if a directory called $dir/$archname/auto exists. | |
224 | If so the $dir/$archname directory is assumed to be a corresponding | |
225 | architecture specific directory and is added to @INC in front of $dir. | |
b11304a1 RB |
226 | lib.pm also checks if directories called $dir/$version and $dir/$version/$archname |
227 | exist and adds these directories to @INC. | |
4633a7c4 | 228 | |
53254699 MS |
229 | The current value of C<$archname> can be found with this command: |
230 | ||
231 | perl -V:archname | |
232 | ||
b11304a1 RB |
233 | The corresponding command to get the current value of C<$version> is: |
234 | ||
235 | perl -V:version | |
236 | ||
aeb5d71d GS |
237 | To avoid memory leaks, all trailing duplicate entries in @INC are |
238 | removed. | |
4633a7c4 | 239 | |
aeb5d71d | 240 | =head2 Deleting directories from @INC |
e50aee73 AD |
241 | |
242 | You should normally only add directories to @INC. If you need to | |
243 | delete directories from @INC take care to only delete those which you | |
244 | added yourself or which you are certain are not needed by other modules | |
245 | in your script. Other modules may have added directories which they | |
246 | need for correct operation. | |
247 | ||
aeb5d71d GS |
248 | The C<no lib> statement deletes all instances of each named directory |
249 | from @INC. | |
e50aee73 | 250 | |
4633a7c4 LW |
251 | For each directory in LIST (called $dir here) the lib module also |
252 | checks to see if a directory called $dir/$archname/auto exists. | |
253 | If so the $dir/$archname directory is assumed to be a corresponding | |
254 | architecture specific directory and is also deleted from @INC. | |
255 | ||
aeb5d71d | 256 | =head2 Restoring original @INC |
e50aee73 AD |
257 | |
258 | When the lib module is first loaded it records the current value of @INC | |
259 | in an array C<@lib::ORIG_INC>. To restore @INC to that value you | |
4633a7c4 | 260 | can say |
e50aee73 AD |
261 | |
262 | @INC = @lib::ORIG_INC; | |
263 | ||
e7bf5e49 MS |
264 | =head1 CAVEATS |
265 | ||
266 | In order to keep lib.pm small and simple, it only works with Unix | |
267 | filepaths. This doesn't mean it only works on Unix, but non-Unix | |
268 | users must first translate their file paths to Unix conventions. | |
269 | ||
270 | # VMS users wanting to put [.stuff.moo] into | |
271 | # their @INC would write | |
272 | use lib 'stuff/moo'; | |
e50aee73 | 273 | |
d5201bd2 JH |
274 | =head1 NOTES |
275 | ||
276 | In the future, this module will likely use File::Spec for determining | |
277 | paths, as it does now for Mac OS (where Unix-style or Mac-style paths | |
278 | work, and Unix-style paths are converted properly to Mac-style paths | |
279 | before being added to @INC). | |
280 | ||
70f874d3 S |
281 | If you try to add a file to @INC as follows: |
282 | ||
283 | use lib 'this_is_a_file.txt'; | |
284 | ||
285 | C<lib> will warn about this. The sole exceptions are files with the | |
286 | C<.par> extension which are intended to be used as libraries. | |
287 | ||
e50aee73 AD |
288 | =head1 SEE ALSO |
289 | ||
af3dad46 | 290 | FindBin - optional module which deals with paths relative to the source file. |
e50aee73 | 291 | |
70f874d3 S |
292 | PAR - optional module which can treat C<.par> files as Perl libraries. |
293 | ||
e50aee73 AD |
294 | =head1 AUTHOR |
295 | ||
296 | Tim Bunce, 2nd June 1995. | |
297 | ||
70f874d3 S |
298 | C<lib> is maintained by the perl5-porters. Please direct |
299 | any questions to the canonical mailing list. Anything that | |
300 | is applicable to the CPAN release can be sent to its maintainer, | |
301 | though. | |
302 | ||
303 | Maintainer: The Perl5-Porters <perl5-porters@perl.org> | |
304 | ||
305 | Maintainer of the CPAN release: Steffen Mueller <smueller@cpan.org> | |
306 | ||
307 | =head1 COPYRIGHT AND LICENSE | |
308 | ||
309 | This package has been part of the perl core since perl 5.001. | |
310 | It has been released separately to CPAN so older installations | |
311 | can benefit from bug fixes. | |
312 | ||
313 | This package has the same copyright and license as the perl core. | |
314 | ||
e50aee73 | 315 | =cut |
60ed1d8c GS |
316 | !NO!SUBS! |
317 | ||
318 | close OUT or die "Can't close $file: $!"; | |
319 | chdir $origdir; |