lib/lib_pm.PL

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