diff options
Diffstat (limited to 'lib/lib_pm.PL')
| -rw-r--r-- | lib/lib_pm.PL | 161 |
1 files changed, 161 insertions, 0 deletions
diff --git a/lib/lib_pm.PL b/lib/lib_pm.PL new file mode 100644 index 0000000000..0d2a73b842 --- /dev/null +++ b/lib/lib_pm.PL @@ -0,0 +1,161 @@ +use Config; +use File::Basename qw(&basename &dirname); +use File::Spec; +use Cwd; + +my $origdir = cwd; +chdir dirname($0); +my $file = basename($0, '.PL'); +$file =~ s!_(pm)$!.$1!i; + +my $Config_archname = defined($Config{'archname'}) ? $Config{'archname'} : ''; +my $Config_ver = defined($Config{'version'}) ? $Config{'version'} : ''; +my @Config_inc_version_list = defined($Config{'inc_version_list'}) ? + reverse split / /, $Config{'inc_version_list'} : (); + +open OUT,">$file" or die "Can't create $file: $!"; + +print "Extracting $file (with variable substitutions)\n"; + +# In this section, perl variables will be expanded during extraction. +# You can use $Config{...} to use Configure variables. + +print OUT <<"!GROK!THIS!"; +package lib; + +use 5.005_64; + +my \$archname = "$Config_archname"; +my \$ver = "$Config_ver"; +my \@inc_version_list = qw(@Config_inc_version_list); + +!GROK!THIS! +print OUT <<'!NO!SUBS!'; + +our @ORIG_INC = @INC; # take a handy copy of 'original' value +our $VERSION = '0.5564'; + +sub import { + shift; + + my %names; + foreach (reverse @_) { + if ($_ eq '') { + require Carp; + Carp::carp("Empty compile time value given to use lib"); + } + if (-e && ! -d _) { + require Carp; + Carp::carp("Parameter to use lib must be directory, not file"); + } + unshift(@INC, $_); + # Add any previous version directories we found at configure time + foreach my $incver (@inc_version_list) + { + unshift(@INC, "$_/$incver") if -d "$_/$incver"; + } + # Put a corresponding archlib directory infront of $_ if it + # looks like $_ has an archlib directory below it. + unshift(@INC, "$_/$ver") if -d "$_/$ver"; + unshift(@INC, "$_/$ver/$archname") if -d "$_/$ver/$archname"; + } + + # remove trailing duplicates + @INC = grep { ++$names{$_} == 1 } @INC; + return; +} + + +sub unimport { + shift; + + my %names; + foreach (@_) { + ++$names{$_}; + ++$names{"$_/$archname"} if -d "$_/$archname/auto"; + } + + # Remove ALL instances of each named directory. + @INC = grep { !exists $names{$_} } @INC; + return; +} + +1; +__END__ + +=head1 NAME + +lib - manipulate @INC at compile time + +=head1 SYNOPSIS + + use lib LIST; + + no lib LIST; + +=head1 DESCRIPTION + +This is a small simple module which simplifies the manipulation of @INC +at compile time. + +It is typically used to add extra directories to perl's search path so +that later C<use> or C<require> statements will find modules which are +not located on perl's default search path. + +=head2 Adding directories to @INC + +The parameters to C<use lib> are added to the start of the perl search +path. Saying + + use lib LIST; + +is I<almost> the same as saying + + BEGIN { unshift(@INC, LIST) } + +For each directory in LIST (called $dir here) the lib module also +checks to see if a directory called $dir/$archname/auto exists. +If so the $dir/$archname directory is assumed to be a corresponding +architecture specific directory and is added to @INC in front of $dir. + +To avoid memory leaks, all trailing duplicate entries in @INC are +removed. + +=head2 Deleting directories from @INC + +You should normally only add directories to @INC. If you need to +delete directories from @INC take care to only delete those which you +added yourself or which you are certain are not needed by other modules +in your script. Other modules may have added directories which they +need for correct operation. + +The C<no lib> statement deletes all instances of each named directory +from @INC. + +For each directory in LIST (called $dir here) the lib module also +checks to see if a directory called $dir/$archname/auto exists. +If so the $dir/$archname directory is assumed to be a corresponding +architecture specific directory and is also deleted from @INC. + +=head2 Restoring original @INC + +When the lib module is first loaded it records the current value of @INC +in an array C<@lib::ORIG_INC>. To restore @INC to that value you +can say + + @INC = @lib::ORIG_INC; + + +=head1 SEE ALSO + +FindBin - optional module which deals with paths relative to the source file. + +=head1 AUTHOR + +Tim Bunce, 2nd June 1995. + +=cut +!NO!SUBS! + +close OUT or die "Can't close $file: $!"; +chdir $origdir; |