/usr/share/perl5/lib/abs.pm is in liblib-abs-perl 0.92-3.
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 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 | #
# Copyright (c) 2007-2010 Mons Anderson <mons@cpan.org>. All rights reserved
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
package lib::abs;
=head1 NAME
lib::abs - C<lib> that makes relative path absolute to caller.
=cut
our $VERSION = '0.92';
=head1 SYNOPSIS
Simple use like C<use lib ...>:
use lib::abs qw(./mylibs1 ../mylibs2);
use lib::abs 'mylibs';
Extended syntax (glob)
use lib::abs 'modules/*/lib';
There are also may be used helper function from lib::abs (see example/ex4):
use lib::abs;
# ...
my $path = lib::abs::path('../path/relative/to/me'); # returns absolute path
=head1 DESCRIPTION
The main reason of this library is transformate relative paths to absolute at the C<BEGIN> stage, and push transformed to C<@INC>.
Relative path basis is not the current working directory, but the location of file, where the statement is (caller file).
When using common C<lib>, relative paths stays relative to curernt working directory,
# For ex:
# script: /opt/scripts/my.pl
use lib::abs '../lib';
# We run `/opt/scripts/my.pl` having cwd /home/mons
# The @INC will contain '/opt/lib';
# We run `./my.pl` having cwd /opt
# The @INC will contain '/opt/lib';
# We run `../my.pl` having cwd /opt/lib
# The @INC will contain '/opt/lib';
Also this module is useful when writing tests, when you want to load strictly the module from ../lib, respecting the test file.
# t/00-test.t
use lib::abs '../lib';
Also this is useful, when you running under C<mod_perl>, use something like C<Apache::StatINC>, and your application may change working directory.
So in case of chdir C<StatINC> fails to reload module if the @INC contain relative paths.
=head1 RATIONALE
Q: We already have C<FindBin> and C<lib>, why we need this module?
A: There are several reasons:
=over 4
=item 1) C<FindBin> could find path incorrectly under C<mod_perl>
=item 2) C<FindBin> works relatively to executed binary instead of relatively to caller
=item 3) Perl is linguistic language, and C<`use lib::abs "..."'> semantically more clear and looks more beautiful than C<`use FindBin; use lib "$FindBin::Bin/../lib";'>
=item 4) C<FindBin> b<will> work incorrectly, if will be called not from executed binary (see L<http://github.com/Mons/lib-abs-vs-findbin> comparison for details)
=back
=head1 BUGS
None known
=head1 COPYRIGHT & LICENSE
Copyright 2007-2010 Mons Anderson.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 AUTHOR
Mons Anderson, C<< <mons@cpan.org> >>
=head1 CONTRIBUTORS
Oleg Kostyuk, C<< <cub@cpan.org> >>
=cut
use 5.006;
use strict;
use warnings;
use lib ();
use Cwd 3.12 qw(abs_path);
$lib::abs::sep = {
( map { $_ => qr{[^\\/]+$}o } qw(mswin32 netware symbian dos) ),
( map { $_ => qr{[^:]+:?$}o } qw(macos) ),
}->{lc$^O} || qr{[^/]+$}o;
BEGIN { *DEBUG = sub () { 0 } unless defined &DEBUG } # use constants is heavy
sub _carp { require Carp; goto &Carp::carp }
sub _croak { require Carp; goto &Carp::croak }
sub _debug ($@) { printf STDERR shift()." at @{[ (caller)[1,2] ]}\n",@_ }
sub mkapath($) {
my $depth = shift;
# Prepare absolute base bath
my ($pkg,$file) = (caller($depth))[0,1];
_debug "file = $file " if DEBUG > 1;
$file =~ s/${lib::abs::sep}//s;
$file = '.' unless length $file;
_debug "base path = $file" if DEBUG > 1;
my $f = abs_path($file) . '/';
_debug "source dir = $f " if DEBUG > 1;
$f;
}
sub path {
local $_ = shift;
s{^\./+}{};
local $!;
my $abs = mkapath(1) . $_;
my $ret = abs_path( $abs ) or _carp("Bad path specification: `$_' => `$abs'" . ($! ? " ($!)" : ''));
_debug "$_ => $ret" if DEBUG > 1;
$ret;
}
sub transform {
my $prefix;
map {
ref || m{^/} ? $_ : do {
my $lib = $_;
s{^\./+}{};
local $!;
my $abs = ( $prefix ||= mkapath(2) ) . $_;
if (index($abs,'*') != -1 or index($abs,'?') !=-1) {
_debug "transforming $abs using glob" if DEBUG > 1;
map {
abs_path( $_ )
or _croak("Bad path specification: `$lib' => `$_'" . ($! ? " ($!)" : ''))
} glob $abs;
} else {
$_ = abs_path( $abs ) or _croak("Bad path specification: `$lib' => `$abs'" . ($! ? " ($!)" : ''));
_debug "$lib => $_" if DEBUG > 1;
($_);
}
}
} @_;
}
sub import {
shift;
return unless @_;
@_ = ( lib => transform @_ = @_ );
_debug "use @_\n" if DEBUG > 0;
goto &lib::import;
return;
}
sub unimport {
shift;
return unless @_;
@_ = ( lib => transform @_ = @_ );
_debug "no @_\n" if DEBUG > 0;
goto &lib::unimport;
return;
}
1;
|