File Coverage

blib/lib/vendorlib.pm
Criterion Covered Total %
statement 29 30 96.6
branch 8 12 66.6
condition 2 3 66.6
subroutine 5 5 100.0
pod n/a
total 44 50 88.0


line stmt bran cond sub pod time code
1 1     1   14931 use utf8;
  1         8  
  1         4  
2             package vendorlib;
3             our $AUTHORITY = 'cpan:RKITOVER';
4             $vendorlib::VERSION = '0.12';
5 1     1   54 use strict;
  1         1  
  1         15  
6 1     1   3 use warnings;
  1         2  
  1         20  
7 1     1   2 use Config;
  1         2  
  1         253  
8              
9             =encoding UTF-8
10              
11             =head1 NAME
12              
13             vendorlib - Use Only Core and Vendor Libraries in @INC
14              
15             =head1 SYNOPSIS
16              
17             #!/usr/bin/perl
18              
19             use vendorlib;
20             use strict;
21             use warnings;
22             use SomeModule; # will only search in core and vendor paths
23             ...
24              
25             =head1 DESCRIPTION
26              
27             In a system distribution such as Debian, it may be advisable for Perl programs
28             to ignore the user's CPAN-installed modules and only use the
29             distribution-provided modules to avoid possible breakage with newer and
30             unpackaged versions of modules.
31              
32             To that end, this pragma will replace your C<@INC> with only the core and vendor
33             C<@INC> paths, ignoring site_perl and C<$ENV{PERL5LIB}> entirely.
34              
35             It is recommended that you put C as the first statement in your
36             program, before even C and C.
37              
38             =cut
39              
40             sub import {
41 3 50   3   105134 my @paths = (($^O ne 'MSWin32' ? ('/etc/perl') : ()), @Config{qw/
42             vendorarch
43             vendorlib
44             archlib
45             privlib
46             /});
47              
48             # This grep MUST BE on copies of the paths to not trigger Config overload
49             # magic.
50 3         15 @paths = grep $_, @paths;
51              
52             # remove duplicates
53 3         4 my @result;
54 3         12 while (my $path = shift @paths) {
55 11 50 66     33 if (@paths && $path eq $paths[0]) {
56             # ignore
57             }
58             else {
59 11         19 push @result, $path;
60             }
61             }
62 3         6 @paths = @result;
63              
64             # fixup slashes for @INC on Win32
65 3 50       8 if ($^O eq 'MSWin32') {
66 0         0 s{\\}{/}g for @paths;
67             }
68              
69             # expand tildes
70 3 50       6 if ($^O ne 'MSWin32') {
71 3         7 for my $path (@paths) {
72 11 100       38 if ($path =~ m{^~/+}) {
    100          
73 1         661 my $home = (getpwuid($<))[7];
74 1         12 $path =~ s|^~/+|${home}/|;
75             }
76             elsif (my ($user) = $path =~ /^~(\w+)/) {
77 1         139 my $home = (getpwnam($user))[7];
78 1         32 $path =~ s|^~${user}/+|${home}/|;
79             }
80             }
81             }
82              
83             # remove any directories that don't actually exist
84             # this will also remove /etc/perl on non-Debian systems
85 3         161 @paths = grep -d, @paths;
86              
87 3         41 @INC = @paths;
88             }
89              
90             =head1 ACKNOWLEDGEMENTS
91              
92             Thanks to mxey, jawnsy and ribasushi for help with the design.
93              
94             =head1 AUTHOR
95              
96             Rafael Kitover
97              
98             =cut
99              
100             __PACKAGE__; # End of vendorlib