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; |