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