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