File Coverage

blib/lib/Find/Lib.pm
Criterion Covered Total %
statement 68 70 97.1
branch 18 20 90.0
condition 15 24 62.5
subroutine 16 16 100.0
pod 3 8 37.5
total 120 138 86.9


line stmt bran cond sub pod time code
1             package Find::Lib;
2 16     16   269117 use strict;
  16         29  
  16         472  
3 16     16   62 use warnings;
  16         25  
  16         447  
4 16     16   7362 use lib;
  16         9551  
  16         83  
5              
6 16     16   804 use File::Spec();
  16         27  
  16         337  
7 16     16   61 use vars qw/$Base $VERSION @base/;
  16         23  
  16         1008  
8 16     16   66 use vars qw/$Script/; # compat
  16         19  
  16         794  
9              
10             =head1 NAME
11              
12             Find::Lib - Helper to smartly find libs to use in the filesystem tree
13              
14             =head1 VERSION
15              
16             Version 1.01
17              
18             =cut
19              
20             $VERSION = '1.03_01';
21              
22             =head1 SYNOPSIS
23              
24             #!/usr/bin/perl -w;
25             use strict;
26              
27             ## simple usage
28             use Find::Lib '../mylib';
29              
30             ## more libraries
31             use Find::Lib '../mylib', 'local-lib';
32              
33             ## More verbose and backward compatible with Find::Lib < 1.0
34             use Find::Lib libs => [ 'lib', '../lib', 'devlib' ];
35              
36             ## resolve some path with minimum typing
37             $dir = Find::Lib->catdir("..", "data");
38             $path = Find::Lib->catfile("..", "data", "test.yaml");
39              
40             $base = Find::Lib->base;
41             # or
42             $base = Find::Lib::Base;
43              
44             =head1 DESCRIPTION
45              
46             The purpose of this module is to replace
47              
48             use FindBin;
49             use lib "$FindBin::Bin/../bootstrap/lib";
50              
51             with something shorter. This is specially useful if your project has a lot
52             of scripts (For instance tests scripts).
53              
54             use Find::Lib '../bootstrap/lib';
55              
56             The important differences between L and L are:
57              
58             =over 4
59              
60             =item * symlinks and '..'
61              
62             If you have symlinks in your path it respects them, so basically you can forget
63             you have symlinks, because Find::Lib will do the natural thing (NOT ignore
64             them), and resolve '..' correctly. L breaks if you do:
65              
66             use lib "$Bin/../lib";
67              
68             and you currently are in a symlinked directory, because $Bin resolved to the
69             filesystem path (without the symlink) and not the shell path.
70              
71             =item * convenience
72              
73             it's faster too type, and more intuitive (Exporting C<$Bin> always
74             felt weird to me).
75              
76             =back
77              
78             =head1 DISCUSSION
79              
80             =head2 Installation and availability of this module
81              
82             The usefulness of this module is seriously reduced if L is not
83             already in your @INC / $ENV{PERL5LIB} -- Chicken and egg problem. This is
84             the big disavantage of L over L: FindBin is distributed
85             with Perl. To mitigate that, you need to be sure of global availability of
86             the module in the system (You could install it via your favorite package
87             managment system for instance).
88              
89             =head2 modification of $0 and chdir (BEGIN blocks, other 'use')
90              
91             As soon as L is compiled it saves the location of the script and
92             the initial cwd (current working directory), which are the two pieces of
93             information the module relies on to interpret the relative path given by the
94             calling program.
95              
96             If one of cwd, $ENV{PWD} or $0 is changed before Find::Lib has a chance to do
97             its job, then Find::Lib will most probably die, saying "The script cannot be
98             found". I don't know a workaround that. So be sure to load Find::Lib as soon
99             as possible in your script to minimize problems (you are in control!).
100              
101             (some programs alter $0 to customize the diplay line of the process in
102             the system process-list (C on unix).
103              
104             (Note, see L for explanation of $0)
105              
106             =head1 USAGE
107              
108             =head2 import
109              
110             All the work is done in import. So you need to C<'use Find::Lib'> and pass
111             a list of paths to add to @INC. See L section for
112             more retails on this topic.
113              
114             The paths given are (should) be relative to the location of the current script.
115             The paths won't be added unless the path actually exists on disk
116              
117             =cut
118              
119 16     16   66 use Carp();
  16         22  
  16         9851  
120              
121             $Script = $Base = guess_base();
122              
123             sub guess_base {
124 16     16 0 20 my $base;
125 16         33 $base = guess_shell_path();
126 16 100 66     430 return $base if $base && -e $base;
127 2         5 return guess_system_path();
128             }
129              
130             ## we want to use PWD if it exists (it's not guaranteed on all platforms)
131             ## so that we have a sense of the shell current working dir, with unresolved
132             ## symlinks
133             sub guess_pwd {
134 16   33 16 0 95 return $ENV{PWD} || Cwd::cwd();
135             }
136              
137             sub guess_shell_path {
138 16     16 0 51 my $pwd = guess_pwd();
139 16         458 my ($volume, $path, $file) = File::Spec->splitpath($pwd);
140 16         230 my @path = File::Spec->splitdir($path);
141 16 50       63 pop @path unless $path[-1];
142 16         47 @base = (@path, $file);
143 16         79 my @zero = File::Spec->splitdir($0);
144 16         26 pop @zero; # get rid of the script
145             ## a clean base is also important for the pop business below
146             #@base = grep { $_ && $_ ne '.' } shell_resolve(\@base, \@zero);
147 16         39 @base = shell_resolve(\@base, \@zero);
148 16         400 return File::Spec->catpath( $volume, (File::Spec->catdir( @base )), '' );
149             }
150              
151             ## naive method, but really DWIM from a developer perspective
152             sub shell_resolve {
153 33     33 0 39 my ($left, $right) = @_;
154 33   66     207 while (@$right && $right->[0] eq '.') { shift @$right }
  1         4  
155 33   66     150 while (@$right && $right->[0] eq '..') {
156 7         13 shift @$right;
157             ## chop off @left until we removed a significant path part
158 7         13 my $part;
159 7   66     60 while (@$left && !$part) {
160 7         49 $part = pop @$left;
161             }
162             }
163              
164 33         251 return (@$left, @$right);
165             }
166              
167             sub guess_system_path {
168 2     2 0 93 my @split = (File::Spec->splitpath( File::Spec->rel2abs($0) ))[ 0, 1 ];
169 2         12 return File::Spec->catpath( @split, '' );
170             }
171              
172             sub import {
173 20     20   602 my $class = shift;
174 20 100       4407 return unless @_;
175              
176 15 100       668 Carp::croak("The script/base dir cannot be found") unless -e $Base;
177              
178 13         21 my @libs;
179              
180 13 100       56 if ($_[0] eq 'libs') {
181 4 100 100     24 if ($_[1] && ref $_[1] && ref $_[1] eq 'ARRAY') {
      66        
182             ## backward compat mode;
183 1         2 @libs = @{ $_[1] };
  1         3  
184             }
185             }
186 13 100       50 @libs = @_ unless @libs;
187              
188 13         29 for ( reverse @libs ) {
189 17         405 my @lib = File::Spec->splitdir($_);
190 17 50 33     108 if (@lib && ! $lib[0]) {
191             # '/abs/olute/' path
192 0         0 lib->import($_);
193 0         0 next;
194             }
195 17         76 my $dir = File::Spec->catdir( shell_resolve( [ @base ], \@lib ) );
196 17 100       331 unless (-d $dir) {
197             ## Try the old way (<0.03)
198 2         12 $dir = File::Spec->catdir($Base, $_);
199             }
200 17 100       1187 next unless -d $dir;
201 15         59 lib->import( $dir );
202             }
203             }
204              
205             =head2 base
206              
207             Returns the detected base (the directory where the script lives in). It's a
208             string, and is the same as C<$Find::Lib::Base>.
209              
210             =cut
211              
212 1     1 1 2321 sub base { return $Base }
213              
214             =head2 catfile
215              
216             A shorcut to L using B's base.
217              
218             =cut
219              
220             sub catfile {
221 1     1 1 641 my $class = shift;
222 1         29 return File::Spec->catfile($Base, @_);
223             }
224              
225             =head2 catdir
226              
227             A shorcut to L using B's base.
228              
229             =cut
230              
231             sub catdir {
232 3     3 1 20 my $class = shift;
233 3         33 return File::Spec->catdir($Base, @_);
234             }
235              
236             =head1 BACKWARD COMPATIBILITY
237              
238             in versions <1.0 of Find::Lib, the import arguments allowed you to specify
239             a Bootstrap package. This option is now B breaking backward
240             compatibility. I'm sorry about that, but that was a dumb idea of mine to
241             save more typing. But it saves, like, 3 characters at the expense of
242             readability. So, I'm sure I didn't break anybody, because probabaly no one
243             was relying on a stupid behaviour.
244              
245             However, the multiple libs argument passing is kept intact: you can still
246             use:
247              
248             use Find::Lib libs => [ 'a', 'b', 'c' ];
249              
250              
251             where C is a reference to a list of path to add to C<@INC>.
252              
253             The short forms implies that the first argument passed to import is not C
254             or C. An example of usage is given in the SYNOPSIS section.
255              
256              
257             =head1 SEE ALSO
258              
259             L, L, L, L, L
260             L
261              
262             =head1 AUTHOR
263              
264             Yann Kerherve, C<< >>
265              
266             =head1 BUGS
267              
268             Please report any bugs or feature requests to
269             C, or through the web interface at
270             L.
271             I will be notified, and then you'll automatically be notified of progress on
272             your bug as I make changes.
273              
274             =head1 ACKNOWLEDGEMENT
275              
276             Six Apart hackers nourrished the discussion that led to this module creation.
277              
278             Jonathan Steinert (hachi) for doing all the conception of 0.03 shell expansion
279             mode with me.
280              
281             =head1 SUPPORT & CRITICS
282              
283             I welcome feedback about this module, don't hesitate to contact me regarding this
284             module, usage or code.
285              
286             You can find documentation for this module with the perldoc command.
287              
288             perldoc Find::Lib
289              
290             You can also look for information at:
291              
292             =over 4
293              
294             =item * AnnoCPAN: Annotated CPAN documentation
295              
296             L
297              
298             =item * CPAN Ratings
299              
300             L
301              
302             =item * RT: CPAN's request tracker
303              
304             L
305              
306             =item * Search CPAN
307              
308             L
309              
310             =back
311              
312             =head1 COPYRIGHT & LICENSE
313              
314             Copyright 2007, 2009 Yann Kerherve, all rights reserved.
315              
316             This program is free software; you can redistribute it and/or modify it
317             under the same terms as Perl itself.
318              
319             =cut
320              
321             1;