File Coverage

blib/lib/Find/Lib.pm
Criterion Covered Total %
statement 71 73 97.2
branch 18 20 90.0
condition 15 24 62.5
subroutine 17 17 100.0
pod 3 8 37.5
total 124 142 87.3


line stmt bran cond sub pod time code
1             package Find::Lib;
2 16     16   1608188 use strict;
  16         38  
  16         602  
3 16     16   89 use warnings;
  16         34  
  16         461  
4 16     16   674374 use lib;
  16         11480  
  16         94  
5              
6 16     16   1156 use File::Spec();
  16         33  
  16         418  
7 16     16   86 use vars qw/$Base $VERSION @base/;
  16         37  
  16         1271  
8 16     16   82 use vars qw/$Script/; # compat
  16         26  
  16         966  
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.04';
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 display 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   87 use Carp();
  16         40  
  16         241  
120 16     16   172 use Cwd();
  16         26  
  16         13567  
121              
122             $Script = $Base = guess_base();
123              
124             sub guess_base {
125 16     16 0 26 my $base;
126 16         176 $base = guess_shell_path();
127 16 100 66     698 return $base if $base && -e $base;
128 2         6 return guess_system_path();
129             }
130              
131             ## we want to use PWD if it exists (it's not guaranteed on all platforms)
132             ## so that we have a sense of the shell current working dir, with unresolved
133             ## symlinks
134             sub guess_pwd {
135 16   33 16 0 197 return $ENV{PWD} || Cwd::cwd();
136             }
137              
138             sub guess_shell_path {
139 16     16 0 66 my $pwd = guess_pwd();
140 16         385 my ($volume, $path, $file) = File::Spec->splitpath($pwd);
141 16         231 my @path = File::Spec->splitdir($path);
142 16 50       77 pop @path unless $path[-1];
143 16         53 @base = (@path, $file);
144 16         94 my @zero = File::Spec->splitdir($0);
145 16         29 pop @zero; # get rid of the script
146             ## a clean base is also important for the pop business below
147             #@base = grep { $_ && $_ ne '.' } shell_resolve(\@base, \@zero);
148 16         57 @base = shell_resolve(\@base, \@zero);
149 16         436 return File::Spec->catpath( $volume, (File::Spec->catdir( @base )), '' );
150             }
151              
152             ## naive method, but really DWIM from a developer perspective
153             sub shell_resolve {
154 33     33 0 52 my ($left, $right) = @_;
155 33   66     253 while (@$right && $right->[0] eq '.') { shift @$right }
  1         5  
156 33   66     191 while (@$right && $right->[0] eq '..') {
157 7         19 shift @$right;
158             ## chop off @left until we removed a significant path part
159 7         16 my $part;
160 7   66     89 while (@$left && !$part) {
161 7         74 $part = pop @$left;
162             }
163             }
164              
165 33         274 return (@$left, @$right);
166             }
167              
168             sub guess_system_path {
169 2     2 0 100 my @split = (File::Spec->splitpath( File::Spec->rel2abs($0) ))[ 0, 1 ];
170 2         14 return File::Spec->catpath( @split, '' );
171             }
172              
173             sub import {
174 20     20   805 my $class = shift;
175 20 100       6228 return unless @_;
176              
177 15 100       806 Carp::croak("The script/base dir cannot be found") unless -e $Base;
178              
179 13         25 my @libs;
180              
181 13 100       78 if ($_[0] eq 'libs') {
182 4 100 100     290 if ($_[1] && ref $_[1] && ref $_[1] eq 'ARRAY') {
      66        
183             ## backward compat mode;
184 1         2 @libs = @{ $_[1] };
  1         4  
185             }
186             }
187 13 100       76 @libs = @_ unless @libs;
188              
189 13         31 for ( reverse @libs ) {
190 17         610 my @lib = File::Spec->splitdir($_);
191 17 50 33     287 if (@lib && ! $lib[0]) {
192             # '/abs/olute/' path
193 0         0 lib->import($_);
194 0         0 next;
195             }
196 17         113 my $dir = File::Spec->catdir( shell_resolve( [ @base ], \@lib ) );
197 17 100       476 unless (-d $dir) {
198             ## Try the old way (<0.03)
199 2         14 $dir = File::Spec->catdir($Base, $_);
200             }
201 17 100       2112 next unless -d $dir;
202 15         75 lib->import( $dir );
203             }
204             }
205              
206             =head2 base
207              
208             Returns the detected base (the directory where the script lives in). It's a
209             string, and is the same as C<$Find::Lib::Base>.
210              
211             =cut
212              
213 1     1 1 3901 sub base { return $Base }
214              
215             =head2 catfile
216              
217             A shorcut to L using B's base.
218              
219             =cut
220              
221             sub catfile {
222 1     1 1 1051 my $class = shift;
223 1         41 return File::Spec->catfile($Base, @_);
224             }
225              
226             =head2 catdir
227              
228             A shorcut to L using B's base.
229              
230             =cut
231              
232             sub catdir {
233 3     3 1 6 my $class = shift;
234 3         48 return File::Spec->catdir($Base, @_);
235             }
236              
237             =head1 BACKWARD COMPATIBILITY
238              
239             in versions <1.0 of Find::Lib, the import arguments allowed you to specify
240             a Bootstrap package. This option is now B breaking backward
241             compatibility. I'm sorry about that, but that was a dumb idea of mine to
242             save more typing. But it saves, like, 3 characters at the expense of
243             readability. So, I'm sure I didn't break anybody, because probabaly no one
244             was relying on a stupid behaviour.
245              
246             However, the multiple libs argument passing is kept intact: you can still
247             use:
248              
249             use Find::Lib libs => [ 'a', 'b', 'c' ];
250              
251              
252             where C is a reference to a list of path to add to C<@INC>.
253              
254             The short forms implies that the first argument passed to import is not C
255             or C. An example of usage is given in the SYNOPSIS section.
256              
257              
258             =head1 SEE ALSO
259              
260             L, L, L, L, L
261             L
262              
263             =head1 AUTHOR
264              
265             Yann Kerherve, C<< >>
266              
267             =head1 BUGS
268              
269             Please report any bugs or feature requests to
270             C, or through the web interface at
271             L.
272             I will be notified, and then you'll automatically be notified of progress on
273             your bug as I make changes.
274              
275             =head1 ACKNOWLEDGEMENT
276              
277             Six Apart hackers nourrished the discussion that led to this module creation.
278              
279             Jonathan Steinert (hachi) for doing all the conception of 0.03 shell expansion
280             mode with me.
281              
282             =head1 SUPPORT & CRITICS
283              
284             I welcome feedback about this module, don't hesitate to contact me regarding this
285             module, usage or code.
286              
287             You can find documentation for this module with the perldoc command.
288              
289             perldoc Find::Lib
290              
291             You can also look for information at:
292              
293             =over 4
294              
295             =item * AnnoCPAN: Annotated CPAN documentation
296              
297             L
298              
299             =item * CPAN Ratings
300              
301             L
302              
303             =item * RT: CPAN's request tracker
304              
305             L
306              
307             =item * Search CPAN
308              
309             L
310              
311             =back
312              
313             =head1 COPYRIGHT & LICENSE
314              
315             Copyright 2007, 2009 Yann Kerherve, all rights reserved.
316              
317             This program is free software; you can redistribute it and/or modify it
318             under the same terms as Perl itself.
319              
320             =cut
321              
322             1;