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