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 $Config_archname = defined($Config{'archname'}) ? $Config{'archname'} : '';
  12 my $Config_ver = defined($Config{'version'}) ? $Config{'version'} : '';
  13 my @Config_inc_version_list = defined($Config{'inc_version_list'}) ?
  14   reverse split / /, $Config{'inc_version_list'} : ();
  15
  16 open OUT,">$file" or die "Can't create $file: $!";
  17
  18 print "Extracting $file (with variable substitutions)\n";
  19
  20 # In this section, perl variables will be expanded during extraction.
  21 # You can use $Config{...} to use Configure variables.
  22
  23 print OUT <<"!GROK!THIS!";
  24 package lib;
  25
  26 # THIS FILE IS AUTOMATICALLY GENERATED FROM lib_pm.PL.
  27 # ANY CHANGES TO THIS FILE WILL BE OVERWRITTEN BY THE NEXT PERL BUILD.
  28
  29 my \$archname = "$Config_archname";
  30 my \$ver = "$Config_ver";
  31 my \@inc_version_list = qw(@Config_inc_version_list);
  32
  33 !GROK!THIS!
  34 print OUT <<'!NO!SUBS!';
  35
  36 our @ORIG_INC = @INC;   # take a handy copy of 'original' value
  37 our $VERSION = '0.5564';
  38
  39 sub import {
  40     shift;
  41
  42     my %names;
  43     foreach (reverse @_) {
  44         if ($_ eq '') {
  45             require Carp;
  46             Carp::carp("Empty compile time value given to use lib");
  47         }
  48         if (-e && ! -d _) {
  49             require Carp;
  50             Carp::carp("Parameter to use lib must be directory, not file");
  51         }
  52         unshift(@INC, $_);
  53         # Add any previous version directories we found at configure time
  54         foreach my $incver (@inc_version_list)
  55         {
  56             unshift(@INC, "$_/$incver") if -d "$_/$incver";
  57         }
  58         # Put a corresponding archlib directory infront of $_ if it
  59         # looks like $_ has an archlib directory below it.
  60         unshift(@INC, "$_/$archname") if -d "$_/$archname/auto";
  61         unshift(@INC, "$_/$ver") if -d "$_/$ver";
  62         unshift(@INC, "$_/$ver/$archname") if -d "$_/$ver/$archname";
  63     }
  64
  65     # remove trailing duplicates
  66     @INC = grep { ++$names{$_} == 1 } @INC;
  67     return;
  68 }
  69
  70
  71 sub unimport {
  72     shift;
  73
  74     my %names;
  75     foreach (@_) {
  76         ++$names{$_};
  77         ++$names{"$_/$archname"} if -d "$_/$archname/auto";
  78         ++$names{"$_/$ver"} if -d "$_/$ver";
  79         ++$names{"$_/$ver/$archname"} if -d "$_/$ver/$archname";
  80     }
  81
  82     # Remove ALL instances of each named directory.
  83     @INC = grep { !exists $names{$_} } @INC;
  84     return;
  85 }
  86
  87 1;
  88 __END__
  89
  90 =head1 NAME
  91
  92 lib - manipulate @INC at compile time
  93
  94 =head1 SYNOPSIS
  95
  96     use lib LIST;
  97
  98     no lib LIST;
  99
 100 =head1 DESCRIPTION
 101
 102 This is a small simple module which simplifies the manipulation of @INC
 103 at compile time.
 104
 105 It is typically used to add extra directories to perl's search path so
 106 that later C<use> or C<require> statements will find modules which are
 107 not located on perl's default search path.
 108
 109 =head2 Adding directories to @INC
 110
 111 The parameters to C<use lib> are added to the start of the perl search
 112 path. Saying
 113
 114     use lib LIST;
 115
 116 is I<almost> the same as saying
 117
 118     BEGIN { unshift(@INC, LIST) }
 119
 120 For each directory in LIST (called $dir here) the lib module also
 121 checks to see if a directory called $dir/$archname/auto exists.
 122 If so the $dir/$archname directory is assumed to be a corresponding
 123 architecture specific directory and is added to @INC in front of $dir.
 124
 125 To avoid memory leaks, all trailing duplicate entries in @INC are
 126 removed.
 127
 128 =head2 Deleting directories from @INC
 129
 130 You should normally only add directories to @INC.  If you need to
 131 delete directories from @INC take care to only delete those which you
 132 added yourself or which you are certain are not needed by other modules
 133 in your script.  Other modules may have added directories which they
 134 need for correct operation.
 135
 136 The C<no lib> statement deletes all instances of each named directory
 137 from @INC.
 138
 139 For each directory in LIST (called $dir here) the lib module also
 140 checks to see if a directory called $dir/$archname/auto exists.
 141 If so the $dir/$archname directory is assumed to be a corresponding
 142 architecture specific directory and is also deleted from @INC.
 143
 144 =head2 Restoring original @INC
 145
 146 When the lib module is first loaded it records the current value of @INC
 147 in an array C<@lib::ORIG_INC>. To restore @INC to that value you
 148 can say
 149
 150     @INC = @lib::ORIG_INC;
 151
 152
 153 =head1 SEE ALSO
 154
 155 FindBin - optional module which deals with paths relative to the source file.
 156
 157 =head1 AUTHOR
 158
 159 Tim Bunce, 2nd June 1995.
 160
 161 =cut
 162 !NO!SUBS!
 163
 164 close OUT or die "Can't close $file: $!";
 165 chdir $origdir;