[perl #68708] Add "CARP_NOT" section to Carp's POD
[p5sagit/p5-mst-13.2.git] / lib / lib_pm.PL
CommitLineData
60ed1d8c 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');
a811a5cf 9$file =~ s/_(pm)$/.$1/i;
60ed1d8c 10
e9c6cca7 11my $useConfig;
12my $Config_archname;
13my $Config_version;
14my $Config_inc_version_list;
15
70f874d3 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 20my $expand_config_vars = 0;
e9c6cca7 21if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) {
70f874d3 22 $expand_config_vars = 1;
23}
24elsif (exists $ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) {
25 $expand_config_vars = 0;
26}
27else {
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 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 39 last;
40 }
41 }
a811a5cf 42 $expand_config_vars = $found_config ? 0 : 1;
70f874d3 43HERE
44 $expand_config_vars = 0 if $@;
45}
46
47if ($expand_config_vars) {
e9c6cca7 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 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 63
64open OUT,">$file" or die "Can't create $file: $!";
65
66print "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
71print OUT <<"!GROK!THIS!";
e50aee73 72package lib;
73
427f4adb 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 77$useConfig
78
fbc36ba3 79use strict;
80
e9c6cca7 81my \$archname = $Config_archname;
82my \$version = $Config_version;
83my \@inc_version_list = $Config_inc_version_list;
60ed1d8c 84
85!GROK!THIS!
86print OUT <<'!NO!SUBS!';
4633a7c4 87
17f410f9 88our @ORIG_INC = @INC; # take a handy copy of 'original' value
c081cc94 89our $VERSION = '0.62';
d5201bd2 90my $Is_MacOS = $^O eq 'MacOS';
91my $Mac_FS;
92if ($Is_MacOS) {
93 require File::Spec;
94 $Mac_FS = eval { require Mac::FileSpec::Unixish };
95}
e50aee73 96
97sub import {
98 shift;
aeb5d71d 99
100 my %names;
a5f75d66 101 foreach (reverse @_) {
57797241 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 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 117 {
118 my $dir = $Is_MacOS
57797241 119 ? File::Spec->catdir( $path, $incver )
120 : "$path/$incver";
d5201bd2 121 unshift(@INC, $dir) if -d $dir;
122 }
57797241 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 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 131
132 # remove trailing duplicates
133 @INC = grep { ++$names{$_} == 1 } @INC;
134 return;
e50aee73 135}
136
137
138sub unimport {
139 shift;
e50aee73 140
141 my %names;
aeb5d71d 142 foreach (@_) {
63c6dcc1 143 my $path = _nativize($_);
d5201bd2 144
145 my($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir)
63c6dcc1 146 = _get_dirs($path);
147 ++$names{$path};
d5201bd2 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 153 # Remove ALL instances of each named directory.
154 @INC = grep { !exists $names{$_} } @INC;
abef537a 155 return;
e50aee73 156}
157
d5201bd2 158sub _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 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 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 174 }
175 return($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir);
176}
177
178sub _nativize {
179 my($dir) = @_;
180
5b865721 181 if ($Is_MacOS && $Mac_FS && ! -d $dir) {
d5201bd2 182 $dir = Mac::FileSpec::Unixish::nativize($dir);
183 $dir .= ":" unless $dir =~ /:$/;
184 }
185
186 return $dir;
187}
188
4633a7c4 1891;
e50aee73 190__END__
191
192=head1 NAME
193
194lib - manipulate @INC at compile time
195
196=head1 SYNOPSIS
197
198 use lib LIST;
199
200 no lib LIST;
201
202=head1 DESCRIPTION
203
204This is a small simple module which simplifies the manipulation of @INC
205at compile time.
206
207It is typically used to add extra directories to perl's search path so
208that later C<use> or C<require> statements will find modules which are
209not located on perl's default search path.
210
aeb5d71d 211=head2 Adding directories to @INC
e50aee73 212
213The parameters to C<use lib> are added to the start of the perl search
214path. Saying
215
216 use lib LIST;
217
4633a7c4 218is I<almost> the same as saying
e50aee73 219
220 BEGIN { unshift(@INC, LIST) }
221
4633a7c4 222For each directory in LIST (called $dir here) the lib module also
223checks to see if a directory called $dir/$archname/auto exists.
224If so the $dir/$archname directory is assumed to be a corresponding
225architecture specific directory and is added to @INC in front of $dir.
b11304a1 226lib.pm also checks if directories called $dir/$version and $dir/$version/$archname
227exist and adds these directories to @INC.
4633a7c4 228
53254699 229The current value of C<$archname> can be found with this command:
230
231 perl -V:archname
232
b11304a1 233The corresponding command to get the current value of C<$version> is:
234
235 perl -V:version
236
aeb5d71d 237To avoid memory leaks, all trailing duplicate entries in @INC are
238removed.
4633a7c4 239
aeb5d71d 240=head2 Deleting directories from @INC
e50aee73 241
242You should normally only add directories to @INC. If you need to
243delete directories from @INC take care to only delete those which you
244added yourself or which you are certain are not needed by other modules
245in your script. Other modules may have added directories which they
246need for correct operation.
247
aeb5d71d 248The C<no lib> statement deletes all instances of each named directory
249from @INC.
e50aee73 250
4633a7c4 251For each directory in LIST (called $dir here) the lib module also
252checks to see if a directory called $dir/$archname/auto exists.
253If so the $dir/$archname directory is assumed to be a corresponding
254architecture specific directory and is also deleted from @INC.
255
aeb5d71d 256=head2 Restoring original @INC
e50aee73 257
258When the lib module is first loaded it records the current value of @INC
259in an array C<@lib::ORIG_INC>. To restore @INC to that value you
4633a7c4 260can say
e50aee73 261
262 @INC = @lib::ORIG_INC;
263
e7bf5e49 264=head1 CAVEATS
265
266In order to keep lib.pm small and simple, it only works with Unix
267filepaths. This doesn't mean it only works on Unix, but non-Unix
268users 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 274=head1 NOTES
275
276In the future, this module will likely use File::Spec for determining
277paths, as it does now for Mac OS (where Unix-style or Mac-style paths
278work, and Unix-style paths are converted properly to Mac-style paths
279before being added to @INC).
280
70f874d3 281If you try to add a file to @INC as follows:
282
283 use lib 'this_is_a_file.txt';
284
285C<lib> will warn about this. The sole exceptions are files with the
286C<.par> extension which are intended to be used as libraries.
287
e50aee73 288=head1 SEE ALSO
289
af3dad46 290FindBin - optional module which deals with paths relative to the source file.
e50aee73 291
70f874d3 292PAR - optional module which can treat C<.par> files as Perl libraries.
293
e50aee73 294=head1 AUTHOR
295
296Tim Bunce, 2nd June 1995.
297
70f874d3 298C<lib> is maintained by the perl5-porters. Please direct
299any questions to the canonical mailing list. Anything that
300is applicable to the CPAN release can be sent to its maintainer,
301though.
302
303Maintainer: The Perl5-Porters <perl5-porters@perl.org>
304
305Maintainer of the CPAN release: Steffen Mueller <smueller@cpan.org>
306
307=head1 COPYRIGHT AND LICENSE
308
309This package has been part of the perl core since perl 5.001.
310It has been released separately to CPAN so older installations
311can benefit from bug fixes.
312
313This package has the same copyright and license as the perl core.
314
e50aee73 315=cut
60ed1d8c 316!NO!SUBS!
317
318close OUT or die "Can't close $file: $!";
319chdir $origdir;