1 |
=head1 NAME |
2 |
|
3 |
Perl::LibExtractor - determine perl library subsets for building distributions |
4 |
|
5 |
=head1 SYNOPSIS |
6 |
|
7 |
use Perl::LibExtractor; |
8 |
|
9 |
=head1 DESCRIPTION |
10 |
|
11 |
The purpose of this module is to determine subsets of your perl library, |
12 |
that is, a set of files needed to satisfy certain dependencies (e.g. of a |
13 |
program). |
14 |
|
15 |
The goal is to extract a part of your perl installation including |
16 |
dependencies. A typical example for this module would be to find out |
17 |
which files are needed to be build a L<PAR> distribution, to link into |
18 |
an L<App::Staticperl> binary, or to pack with L<Urlader>, to create |
19 |
stand-alone distributions tailormade to run your app. |
20 |
|
21 |
=head1 METHODS |
22 |
|
23 |
To use this module, first call the C<new>-constructor and then as many |
24 |
other methods as you want, to generate a set of files. |
25 |
|
26 |
=over 4 |
27 |
|
28 |
=cut |
29 |
|
30 |
package Perl::LibExtractor; |
31 |
|
32 |
our $VERSION = '0.1'; |
33 |
|
34 |
use Config; |
35 |
use File::Temp (); |
36 |
|
37 |
use common::sense; |
38 |
|
39 |
sub I_SRC () { 0 } |
40 |
sub I_DEP () { 1 } |
41 |
sub I_FLAGS() { 2 } |
42 |
|
43 |
sub T_PL () { 1 } |
44 |
sub T_PM () { 2 } |
45 |
sub T_EXE() { 3 } |
46 |
sub T_BIN() { 4 } |
47 |
sub T_DLL() { 5 } |
48 |
|
49 |
sub F_EVAL () { 0x01 } |
50 |
sub F_STRIP() { 0x02 } |
51 |
|
52 |
sub croak($) { |
53 |
require Carp; |
54 |
Carp::croak "(Perl::LibExtractor) $_[0]"; |
55 |
} |
56 |
|
57 |
=item $extractor = new Perl::LibExtractor [key => value...] |
58 |
|
59 |
Creates a new extractor object. Each extractor object stores some |
60 |
configuration options and a subset of files that can be queried at any |
61 |
time,. |
62 |
|
63 |
The following key-value pairs exist, with default values as specified. |
64 |
|
65 |
=over 4 |
66 |
|
67 |
=item exedir => "bin" |
68 |
|
69 |
The prefix to use for the suggested target path for perl |
70 |
executables. Defaults to F<bin>. |
71 |
|
72 |
=item libdir => "lib" |
73 |
|
74 |
The prefix to use for the suggested target path of perl library |
75 |
files (F<.pm>, F<.pl>, dynamic objects, autoloader index and files |
76 |
etc.). Defaults to F<lib>. |
77 |
|
78 |
=item bindir => "bin" |
79 |
|
80 |
The prefix to use for the suggested target path for (non-perl) |
81 |
executables. Defaults to F<bin>. |
82 |
|
83 |
=item dlldir => "bin" |
84 |
|
85 |
The prefix to use for the suggested target path of any shared |
86 |
libraries. Defaults to F<bin>. |
87 |
|
88 |
=item inc => \@INC without "." |
89 |
|
90 |
An arrayref with paths to perl library directories. The default is |
91 |
C<\@INC>, with F<.> removed. |
92 |
|
93 |
To prepend custom dirs just do this: |
94 |
|
95 |
inc => ["mydir", @INC], |
96 |
|
97 |
=item use_packlists => 1 |
98 |
|
99 |
Enable (if true) or disable the use of C<.packlists>. If enabled, then |
100 |
each time a module is included, the complete distribution that contains |
101 |
it is included as well. See L<ALGORITHMS>, below. |
102 |
|
103 |
=back |
104 |
|
105 |
=cut |
106 |
|
107 |
sub new { |
108 |
my ($class, %kv) = @_; |
109 |
|
110 |
my $self = bless { |
111 |
exedir => "bin", |
112 |
libdir => "lib", |
113 |
bindir => "bin", |
114 |
dlldir => "bin", |
115 |
inc => [grep $_ ne ".", @INC], |
116 |
use_packlists => 1, |
117 |
%kv, |
118 |
set => {}, |
119 |
}, $class; |
120 |
|
121 |
my %inc_seen; |
122 |
my @inc = grep !$inc_seen{$_}++, @{ $self->{inc} }; |
123 |
$self->{inc} = \@inc; |
124 |
|
125 |
$self->_set_inc; |
126 |
|
127 |
$self |
128 |
} |
129 |
|
130 |
sub _set_inc { |
131 |
my ($self) = @_; |
132 |
|
133 |
my %lib; |
134 |
|
135 |
# find all files in all libdirs, earlier ones overwrite later ones |
136 |
for my $dir (reverse @{ $self->{inc} }) { |
137 |
my $scan = sub { |
138 |
my $pfx = length $_[1] ? "$_[1]/" : ""; |
139 |
#my (@dirs, @files); |
140 |
|
141 |
for (do { |
142 |
opendir my $fh, "$dir/$_[1]" |
143 |
or croak "$dir/$_[1]: $!"; |
144 |
grep !/^\.\.?$/, readdir $fh |
145 |
}) { |
146 |
if (-d "$dir/$_[1]/$_/.") { |
147 |
#push @dirs, $_; |
148 |
$_[0]($_[0], "$pfx$_"); |
149 |
$lib{"$pfx$_/"} = "$dir/$pfx$_"; |
150 |
} else { |
151 |
#push @files, $_; |
152 |
$lib{"$pfx$_"} = "$dir/$pfx$_"; |
153 |
} |
154 |
} |
155 |
|
156 |
#$lib{"$_[1]/"} = [\@dirs, \@files]; # won't work nice with overwrite |
157 |
}; |
158 |
|
159 |
$scan->($scan, ""); |
160 |
} |
161 |
|
162 |
$self->{lib} = \%lib; |
163 |
|
164 |
my $matchprefix = join "|", map "\Q$_", @{ $self->{inc }}; |
165 |
$self->{matchprefix} = qr<^(?:$matchprefix)/>; |
166 |
} |
167 |
|
168 |
sub _add { |
169 |
my ($self, $add) = @_; |
170 |
|
171 |
my $lib = $self->{lib}; |
172 |
my $path; |
173 |
|
174 |
for (@$add) { |
175 |
$path = "$self->{libdir}/$_"; |
176 |
|
177 |
$self->{set}{$path} ||= do { |
178 |
my @info; |
179 |
|
180 |
$info[I_SRC] = $lib->{$_} |
181 |
or croak "$_: unable to locate file in perl library"; |
182 |
|
183 |
if (/^(.*)\.pm$/) { |
184 |
(my $auto = "auto/$1/") =~ s%::%/%g; |
185 |
$auto =~ m%/([^/]+)/$% or die; |
186 |
my $base = $1; |
187 |
|
188 |
if (exists $lib->{$auto}) { |
189 |
# auto dir exists, scan it for cool stuff |
190 |
|
191 |
# 1. packlists |
192 |
my $pack = "$auto.packlist"; |
193 |
if (my $src = $lib->{$pack} and $self->{use_packlists}) { |
194 |
open my $fh, "<:perlio", $src |
195 |
or croak "$src: $!"; |
196 |
|
197 |
my @files; |
198 |
|
199 |
while (<$fh>) { |
200 |
chomp; |
201 |
s/ .*$//; # newer-style .packlists might contain key=value pairs |
202 |
s%/\./%/%g; # yeah, these too |
203 |
|
204 |
# only include certain files (.al, .ix, .pm, .pl) |
205 |
if (/\.(pm|pl|al|ix|\q$Config{dlext}\E)$/) { |
206 |
s/$self->{matchprefix}// |
207 |
or croak "$_: not found in library directory"; |
208 |
|
209 |
my $src = $lib->{$_} |
210 |
or croak "$_: not found in library directory"; |
211 |
|
212 |
$self->{set}{"$self->{libdir}/$_"} = [$src]; |
213 |
} |
214 |
} |
215 |
|
216 |
goto skip; # packlists are supposed to contain all relevant files, including autoload and .so's |
217 |
} |
218 |
|
219 |
# 1. shared object, others are of no interest to us |
220 |
my $so = "$auto$base.$Config{dlext}"; |
221 |
if (my $src = $lib->{$so}) { |
222 |
$so = "$self->{libdir}/$so"; |
223 |
push @{ $info[I_DEP] }, $so; $self->{set}{$so} = [$src]; |
224 |
} |
225 |
|
226 |
# 2. autoloader/autosplit |
227 |
my $ix = "${auto}autosplit.ix"; |
228 |
if (my $src = $lib->{$ix}) { |
229 |
$ix = "$self->{libdir}/$ix"; |
230 |
push @{ $info[I_DEP] }, $ix; $self->{set}{$ix} = [$src]; |
231 |
|
232 |
open my $fh, "<:perlio", $src |
233 |
or croak "$src: $!"; |
234 |
|
235 |
my $package; |
236 |
|
237 |
while (<$fh>) { |
238 |
if (/^\s*sub\s+ ([^[:space:];]+) \s* (?:\([^)]*\))? \s*;?\s*$/x) { |
239 |
my $al = "auto/$package/$1.al"; |
240 |
my $src = $lib->{$al} |
241 |
or croak "$al: autoload file not found, but should be there."; |
242 |
|
243 |
$al = "$self->{libdir}/$al"; |
244 |
push @{ $info[I_DEP] }, $al; $self->{set}{$al} = [$src]; |
245 |
|
246 |
} elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) { |
247 |
($package = $1) =~ s/::/\//g; |
248 |
} elsif (/^\s*(?:#|1?\s*;?\s*$)/) { |
249 |
# nop |
250 |
} else { |
251 |
warn "WARNING: $src: unparsable line, please report: $_"; |
252 |
} |
253 |
} |
254 |
} |
255 |
|
256 |
skip: |
257 |
} |
258 |
} |
259 |
|
260 |
\@info |
261 |
}; |
262 |
} |
263 |
} |
264 |
|
265 |
sub _trace { |
266 |
my ($self, $file, $eval) = @_; |
267 |
|
268 |
$self->{trace_begin} .= "#line \"$file\" 1\n$eval;\n"; |
269 |
} |
270 |
|
271 |
sub _trace_flush { |
272 |
my ($self) = @_; |
273 |
|
274 |
return unless exists $self->{trace_begin} or exists $self->{trace_check}; |
275 |
|
276 |
my $tmpdir = newdir File::Temp; |
277 |
my $dir = $tmpdir->dirname; |
278 |
|
279 |
open my $fh, ">:perlio", "$dir/eval" |
280 |
or croak "$dir/eval: $!"; |
281 |
syswrite $fh, |
282 |
'BEGIN { @INC = (' . (join ", ", map "q\x00$_\x00", @{ $self->{inc} }) . ") }\n" |
283 |
. "BEGIN { chdir q\x00$dir\x00 or die q\x00$dir: \$!\x00 }\n" |
284 |
. 'BEGIN { ' . (delete $self->{trace_begin}) . "}\n" |
285 |
. "CHECK {\n" |
286 |
. 'open STDOUT, ">:raw", "out" or die "out: $!";' |
287 |
. 'print join "\x00", values %INC;' |
288 |
. 'open STDERR, ">stderr";' # suppress "syntax OK" message from perl |
289 |
. "}\n" |
290 |
. (delete $self->{trace_check}); |
291 |
close $fh; |
292 |
|
293 |
my $secure_perl_path = $Config{perlpath}; |
294 |
|
295 |
if ($^O ne 'VMS') { |
296 |
$secure_perl_path .= $Config{_exe} |
297 |
unless $secure_perl_path =~ m/$Config{_exe}$/i; |
298 |
} |
299 |
|
300 |
system $secure_perl_path, "-c", "$dir/eval" |
301 |
and croak "trace failure, check trace process output."; |
302 |
|
303 |
my @inc = split /\x00/, do { |
304 |
open my $fh, "<:perlio", "$dir/out" |
305 |
or croak "$dir/out: $!"; |
306 |
local $/; |
307 |
scalar readline $fh |
308 |
}; |
309 |
|
310 |
my $matchprefix = $self->{matchprefix}; |
311 |
|
312 |
# remove the library directory prefix, hope for the best |
313 |
s/$matchprefix// |
314 |
or croak "$_: file outside any library directory" |
315 |
for @inc; |
316 |
|
317 |
$self->_add (\@inc); |
318 |
} |
319 |
|
320 |
=item $extractor->add_mod ($module[, $module...]) |
321 |
|
322 |
Adds the given module(s) to the file set - the module name must be specified |
323 |
as in C<use>, i.e. with C<::> as separators and without F<.pm>. |
324 |
|
325 |
The program will be loaded with the default import list, any dependent |
326 |
files, such as the shared object implementing xs functions, or autoload |
327 |
files, will also be added. |
328 |
|
329 |
Example: add F<Coro.pm> and F<AnyEvent/AIO.pm>, and all relevant files |
330 |
from the distribution they are part of. |
331 |
|
332 |
$extractor->add_mod ("Coro", "AnyEvent::AIO"); |
333 |
|
334 |
=cut |
335 |
|
336 |
sub add_mod { |
337 |
my $self = shift; |
338 |
|
339 |
my $pkg = "libextractor" . ++$self->{count}; |
340 |
|
341 |
$self->_trace ("use $_", "{ package $pkg; use $_ }") |
342 |
for @_; |
343 |
} |
344 |
|
345 |
=item $extractor->add_exe ($name[, $name...]) |
346 |
|
347 |
Adds the given (perl) program(s) to the file set, that is, a program |
348 |
installed by some perl module, written in perl (an example would be the |
349 |
L<perl-libextract> program that is part of the C<Perl::LibExtractor> |
350 |
distribution). |
351 |
|
352 |
Example: add the deliantra client installed by the L<Deliantra::Client> |
353 |
module. |
354 |
|
355 |
$extractor->add_exe ("deliantra"); |
356 |
|
357 |
=cut |
358 |
|
359 |
sub add_exe { |
360 |
my $self = shift; |
361 |
|
362 |
exe: |
363 |
for my $exe (@_) { |
364 |
for my $dir ($Config{sitebinexp}, $Config{vendorbinexp}, $Config{binexp}) { |
365 |
if (open my $fh, "<:perlio", "$dir/$exe") { |
366 |
|
367 |
my $file = do { local $/; readline $fh }; |
368 |
|
369 |
$self->_trace_flush if exists $self->{trace_check}; |
370 |
$self->{trace_check} = $file; |
371 |
|
372 |
$self->{set}{"$self->{exedir}/$exe"} = ["$dir/$exe"]; |
373 |
next exe; |
374 |
} |
375 |
} |
376 |
|
377 |
croak "add_exe ($exe): executable not found"; |
378 |
} |
379 |
} |
380 |
|
381 |
=item $extractor->add_eval ($string) |
382 |
|
383 |
Evaluates the string and adds all modules that are loaded by it. For |
384 |
example, this would add L<AnyEvent> and the default backend implementation |
385 |
module and event loop module: |
386 |
|
387 |
$extractor->add_eval ("use AnyEvent; AnyEvent::detect"); |
388 |
|
389 |
=cut |
390 |
|
391 |
sub add_eval { |
392 |
my ($self, $eval) = @_; |
393 |
|
394 |
$eval =~ s/\x00/\x00."\\x00".q\x00/g; |
395 |
$self->_trace ($eval, "eval q\x00$eval\x00 or die;\n"); |
396 |
} |
397 |
|
398 |
=item $extractor->add_perl |
399 |
|
400 |
Adds the perl binary itself to the file set, including the libperl dll, if |
401 |
needed. |
402 |
|
403 |
=item $extractor->add_unicore_minimal |
404 |
|
405 |
=item $extractor->add_unicore_all |
406 |
|
407 |
=item $extractor->add_glob ($modglob[, $modglob...]) |
408 |
|
409 |
#TODO# |
410 |
|
411 |
=item $extractor->filter ($pattern[, $pattern...]) |
412 |
|
413 |
Applies a series of include/exclude filters. Each filter must start |
414 |
with either C<+> or C<->, to designate the pattern as I<include> or |
415 |
I<exclude> pattern. The rest of the pattern is an extended glob pattern |
416 |
(see L<EXTENDED GLOB PATTERNS>). |
417 |
|
418 |
Each pattern is instantly applied, and all matching files will be |
419 |
permanently included or excluded, that is, if you have an include pattern |
420 |
then all files that were matched by it will be included in the set, |
421 |
regardless of any further exclude patterns matching the same files. |
422 |
|
423 |
Likewise, any file excluded by a pattern will not be included in the set, |
424 |
even if matches by later include patterns. |
425 |
|
426 |
Any files not matched by any expression will be included, that is, the |
427 |
filter list has an implicit C<+/**> pattern at the end. |
428 |
|
429 |
#TODO# |
430 |
|
431 |
=item $extractor->add_auto |
432 |
|
433 |
#todo, not like this |
434 |
|
435 |
=back |
436 |
|
437 |
=head1 ALGORITHMS |
438 |
#TODO |
439 |
|
440 |
=head2 Module/trace-based additions |
441 |
#TODO |
442 |
|
443 |
For example, when using L<Coro::AnyEvent> or |
444 |
L<AnyEvent::DNS> are added, then also all (relevant) files from the |
445 |
L<Coro> and L<AnyEvent> distributions will be included. |
446 |
|
447 |
The only exception is perl itself |
448 |
|
449 |
=head2 Glob/path-based modifications |
450 |
#TODO |
451 |
|
452 |
=head1 EXTENDED GLOB PATTERNS |
453 |
|
454 |
=head1 SEE ALSO |
455 |
|
456 |
The utility program that comes with this module: L<perl-libextract>. |
457 |
|
458 |
L<App::Staticperl>, L<Urlader>, L<Perl::Squish>. |
459 |
|
460 |
=head1 AUTHOR |
461 |
|
462 |
Marc Lehmann <schmorp@schmorp.de> |
463 |
http://home.schmorp.de/ |
464 |
|
465 |
=cut |
466 |
|
467 |
1; |
468 |
|