/usr/share/perl5/above.pm is in libur-perl 0.410-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 | package above;
use strict;
use warnings;
our $VERSION = '0.02';
sub import {
my $package = shift;
for (@_) {
use_package($_);
}
}
our %used_libs;
BEGIN {
%used_libs = ($ENV{PERL_USED_ABOVE} ? (map { $_ => 1 } split(":",$ENV{PERL_USED_ABOVE})) : ());
for my $path (keys %used_libs) {
#print STDERR "Using (parent process') libraries at $path\n";
eval "use lib '$path';";
die "Failed to use library path '$path' from the environment PERL_USED_ABOVE?: $@" if $@;
}
};
sub use_package {
my $class = shift;
my $caller = (caller(1))[0];
my $module = $class;
$module =~ s/::/\//g;
$module .= ".pm";
## paths already found in %used_above have
## higher priority than paths based on cwd
for my $path (keys %used_libs) {
if (-e "$path/$module") {
eval "package $caller; use $class";
die $@ if $@;
return;
}
}
require Cwd;
my $cwd = Cwd::cwd();
my @parts = ($cwd =~ /\//g);
my $dirs_above = scalar(@parts);
my $path=$cwd.'/';
until (-e "$path./$module") {
if ($dirs_above == 0) {
# Not found. Use the one out under test.
# When deployed.
$path = "";
last;
};
#print "Didn't find it in $path, trying higher\n";
$path .= "../";
$dirs_above--;
}
# Get the special path in place
if (length($path)) {
while ($path =~ s:/[^/]+/\.\./:/:) { 1 } # simplify
unless ($used_libs{$path}) {
print STDERR "Using libraries at $path\n" unless $ENV{PERL_ABOVE_QUIET} or $ENV{COMP_LINE};
eval "use lib '$path';";
die $@ if $@;
$used_libs{$path} = 1;
my $env_value = join(":",sort keys %used_libs);
$ENV{PERL_USED_ABOVE} = $env_value;
}
}
# Now use the module.
eval "package $caller; use $class";
die $@ if $@;
};
1;
=pod
=head1 NAME
above - auto "use lib" when a module is in the tree of the PWD
=head1 SYNOPSIS
use above "My::Module";
=head1 DESCRIPTION
Used by the command-line wrappers for Command modules which are developer tools.
Do NOT use this in modules, or user applications.
Uses a module as though the cwd and each of its parent directories were at the beginnig of @INC.
If found in that path, the parent directory is kept as though by "use lib".
=head1 EXAMPLES
# given
/home/me/perlsrc/My/Module.pm
# in
/home/me/perlsrc/My/Module/Some/Path/
# in myapp.pl:
use above "My::Module";
# does this ..if run anywhere under /home/me/perlsrc:
use lib '/home/me/perlsrc/'
use My::Module;
=head1 AUTHOR
Scott Smith
=cut
|