ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/Perl-LibExtractor/LibExtractor.pm
Revision: 1.12
Committed: Fri Jan 20 00:05:34 2012 UTC (12 years, 5 months ago) by root
Branch: MAIN
Changes since 1.11: +37 -81 lines
Log Message:
*** empty log message ***

File Contents

# Content
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 use case 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. Then query the set
25 of files and do whatever you want with them.
26
27 The command-line utility F<perl-libextract> can be a convenient
28 alternative to using this module directly, and offers a few extra options,
29 such as to copy out the files into a new directory, strip them and/or
30 manipulate them in other ways.
31
32 =cut
33
34 package Perl::LibExtractor;
35
36 our $VERSION = '0.1';
37
38 use Config;
39 use File::Spec ();
40 use File::Temp ();
41
42 use common::sense;
43
44 sub I_SRC () { 0 }
45 sub I_DEP () { 1 }
46
47 sub croak($) {
48 require Carp;
49 Carp::croak "(Perl::LibExtractor) $_[0]";
50 }
51
52 my $canonpath = File::Spec->can ("canonpath");
53 my $case_tolerant = File::Spec->case_tolerant;
54
55 sub canonpath($) {
56 local $_ = $canonpath->(File::Spec::, $_[0]);
57 s%\\%/%g;
58 # $_ = lc if $case_tolerant; # we assume perl file name case is always the same
59 $_
60 }
61
62 =head2 CREATION
63
64 =over 4
65
66 =item $extractor = new Perl::LibExtractor [key => value...]
67
68 Creates a new extractor object. Each extractor object stores some
69 configuration options and a subset of files that can be queried at any
70 time,.
71
72 Binary executables (such as the perl interpreter) are stored inside
73 F<bin/>, perl scripts are stored under F<script/>, perl library files are
74 stored under F<lib/> and shared libraries are stored under F<dll/>.
75
76 The following key-value pairs exist, with default values as specified.
77
78 =over 4
79
80 =item inc => \@INC without "."
81
82 An arrayref with paths to perl library directories. The default is
83 C<\@INC>, with F<.> removed.
84
85 To prepend custom dirs just do this:
86
87 inc => ["mydir", @INC],
88
89 =item use_packlist => 1
90
91 Enable (if true) or disable the use of C<.packlist> files. If enabled,
92 then each time a file is traced, the complete distribution that contains
93 it is included (but not traced).
94
95 If disabled, only shared objects and autoload files will be added.
96
97 =back
98
99 =cut
100
101 sub new {
102 my ($class, %kv) = @_;
103
104 my $self = bless {
105 inc => [grep $_ ne ".", @INC],
106 use_packlist => 1,
107 %kv,
108 set => {},
109 }, $class;
110
111 my %inc_seen;
112 my @inc = grep !$inc_seen{$_}++ && -d "$_/.", @{ $self->{inc} };
113 $self->{inc} = \@inc;
114
115 $self->_set_inc;
116
117 $self
118 }
119
120 sub _perl_path() {
121 my $secure_perl_path = $Config{perlpath};
122
123 if ($^O ne 'VMS') {
124 $secure_perl_path .= $Config{_exe}
125 unless $secure_perl_path =~ m/$Config{_exe}$/i;
126 }
127
128 $secure_perl_path
129 }
130
131 sub _path2match {
132 my $re = join "|", map "\Q$_", @_;
133
134 $re = "(?:$re)\\/";
135 $re =~ s%\\[/\\]%[/\\\\]%g; # we support / and \ on all OSes, keep your fingers crossed
136
137 $case_tolerant
138 ? qr<$re>i
139 : qr<$re>
140 }
141
142 sub _read_packlist {
143 my ($self, $root, $path) = @_;
144
145 my $lib = $self->{lib};
146
147 my @packlist;
148
149 open my $fh, "<:perlio", "$root/$path"
150 or die "$root/$path: $!";
151
152 $root = _path2match $root;
153
154 while (<$fh>) {
155 chomp;
156 s/ .*$//; # newer-style .packlists might contain key=value pairs
157
158 s/$root// and exists $lib->{$_}
159 or next;
160
161 push @packlist, canonpath $_;
162 }
163
164 \@packlist
165 }
166
167 sub _set_inc {
168 my ($self) = @_;
169
170 my $matchprefix = _path2match @{ $self->{inc }};
171
172 my %lib;
173 my @packlists;
174
175 # find all files in all libdirs, earlier ones overwrite later ones
176 my @scan = map [$_, ""], @{ $self->{inc} };
177
178 while (@scan) {
179 my ($root, $dir) = @{ pop @scan };
180
181 my $pfx = length $dir ? "$dir/" : "";
182
183 for (do {
184 opendir my $fh, "$root/$dir"
185 or croak "$root/$dir: $!";
186 grep !/^\.\.?$/, readdir $fh
187 }) {
188 if (-d "$root/$dir/$_/.") {
189 $lib{"$pfx$_/"} = "$root/$pfx$_";
190 push @scan, [$root, "$pfx$_"];
191 } elsif ($_ eq ".packlist" && $pfx =~ m%^auto/%) {
192 push @packlists, [$root, $pfx];
193 } elsif (/\.bs$/ && $pfx =~ m%^auto/% && !-s "$root/$dir/$_") {
194 # skip empty .bs files
195 # } elsif (/\.(?:pod|h|html)$/) {
196 # # not interested in those
197 } else {
198 #push @files, $_;
199 $lib{"$pfx$_"} = "$root/$pfx$_";
200 }
201 }
202
203 #$lib{"$_[1]/"} = [\@dirs, \@files]; # won't work nice with overwrite
204 }
205
206 my %packlist;
207
208 # need to go forward here
209 for (@packlists) {
210 my $packlist = $self->_read_packlist ($_->[0], "$_->[1]/.packlist");
211
212 $packlist{$_} = $packlist
213 for @$packlist;
214 }
215
216 $self->{lib} = \%lib;
217 $self->{packlist} = \%packlist;
218 $self->{matchprefix} = $matchprefix;
219 }
220
221 =back
222
223 =head2 TRACE/PACKLIST BASED ADDING
224
225 The following methods add various things to the set of files.
226
227 Each time a perl file is added, it is scanned by tracing either loading,
228 execution or compiling it, and seeing which other perl modules and
229 libraries have been loaded.
230
231 For each library file found this way, additional dependencies are added:
232 if packlists are enabled, then all files of the distribution that contains
233 the file will be added. If packlists are disabled, then only shared
234 objects and autoload files for modules will be added.
235
236 Only files from perl library directories will be added automatically. Any
237 other files (such as manpages or scripts installed in the F<bin>
238 directory) are skipped.
239
240 If there is an error, such as a module not being found, then this module
241 croaks (as opposed to silently skipping). If you want to add something of
242 which you are not sure it exists, then you can wrap the call into C<eval
243 {}>. In some cases, you can avoid this by executing the code you want
244 to work later using C<add_eval> - see C<add_core_support> for an actual
245 example of this technique.
246
247 Note that packlists are meant to add files not covered by other
248 mechanisms, such as resource files and other data files loaded directly by
249 a module - they are not meant to add dependencies that are missed because
250 they only happen at runtime.
251
252 For example, with packlists, when using L<AnyEvent>, then all event loop
253 backends are automatically added as well, but I<not> any event loops
254 (i.e. L<AnyEvent::Impl::POE> is added, but L<POE> itself is not). Without
255 packlists, only the backend that is being used is added (i.e. normally
256 none, as loading AnyEvent does not instantly load any backend).
257
258 To catch the extra event loop dependencies, you can either initialise
259 AnyEvent so it picks a suitable backend:
260
261 $extractor->add_eval ("use AnyEvent; AnyEvent::detect");
262
263 Or you can directly load the backend modules you plan to use:
264
265 $extractor->add_mod ("AnyEvent::Impl::EV", "AnyEvent::Impl::Perl");
266
267 An example of a program (or module) that has extra resource files is
268 L<Deliantra::Client> - the normal tracing (without packlist usage) will
269 correctly add all submodules, but miss the fonts and textures. By using
270 the packlist, those files are added correctly.
271
272 =over 4
273
274 =cut
275
276 sub _add {
277 my ($self, $add) = @_;
278
279 my $lib = $self->{lib};
280 my $path;
281
282 for (@$add) {
283 $path = "lib/$_";
284
285 $self->{set}{$path} ||= do {
286 my @info;
287
288 $info[I_SRC] = $lib->{$_}
289 or croak "$_: unable to locate file in perl library";
290
291 if ($self->{use_packlist} && exists $self->{packlist}{$_}) {
292 $self->{set}{"lib/$_"} ||= [$self->{lib}{$_} or die]
293 for @{ $self->{packlist}{$_} };
294
295 # for (grep /\.pm$/, @{ $self->{packlist}{$_} }) {
296 # s/\.pm$//;
297 # s%/%::%g;
298 # my $pkg = "libextractor" . ++$self->{count};
299 # $self->add_eval ("{ package $pkg; eval 'use $_' }")
300 # unless $self->{_add_do}{$_}++;
301 # }
302 #
303 # $self->{_add_do}{$_}++ or $self->add_eval ("do q\x00$_\x00")
304 # for grep /\.pl$/, @{ $self->{packlist}{$_} };
305
306 } elsif (/^(.*)\.pm$/) {
307 (my $auto = "auto/$1/") =~ s%::%/%g;
308 $auto =~ m%/([^/]+)/$% or die;
309 my $base = $1;
310
311 if (exists $lib->{$auto}) {
312 # auto dir exists, scan it for cool stuff
313
314 # 1. shared object, others are of no interest to us
315 my $so = "$auto$base.$Config{dlext}";
316 if (my $src = $lib->{$so}) {
317 $so = "lib/$so";
318 push @{ $info[I_DEP] }, $so; $self->{set}{$so} = [$src];
319 }
320
321 # 2. autoloader/autosplit
322 my $ix = "${auto}autosplit.ix";
323 if (my $src = $lib->{$ix}) {
324 $ix = "lib/$ix";
325 push @{ $info[I_DEP] }, $ix; $self->{set}{$ix} = [$src];
326
327 open my $fh, "<:perlio", $src
328 or croak "$src: $!";
329
330 my $package;
331
332 while (<$fh>) {
333 if (/^\s*sub\s+ ([^[:space:];]+) \s* (?:\([^)]*\))? \s*;?\s*$/x) {
334 my $al = "auto/$package/$1.al";
335 my $src = $lib->{$al}
336 or croak "$al: autoload file not found, but should be there.";
337
338 $al = "lib/$al";
339 push @{ $info[I_DEP] }, $al; $self->{set}{$al} = [$src];
340
341 } elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) {
342 ($package = $1) =~ s/::/\//g;
343 } elsif (/^\s*(?:#|1?\s*;?\s*$)/) {
344 # nop
345 } else {
346 warn "WARNING: $src: unparsable line, please report: $_";
347 }
348 }
349 }
350
351 skip:
352 }
353 }
354
355 \@info
356 };
357 }
358 }
359
360 sub _trace {
361 my ($self, $file, $eval) = @_;
362
363 $self->{trace_begin} .= "\n#line \"$file\" 1\n$eval;\n";
364 }
365
366 sub _trace_flush {
367 my ($self) = @_;
368
369 # ->_add might add additional files to trace
370 while (exists $self->{trace_begin} or exists $self->{trace_check}) {
371 my $tmpdir = newdir File::Temp;
372 my $dir = $tmpdir->dirname;
373
374 open my $fh, ">:perlio", "$dir/eval"
375 or croak "$dir/eval: $!";
376 syswrite $fh,
377 'BEGIN { @INC = (' . (join ", ", map "q\x00$_\x00", @{ $self->{inc} }) . ") }\n"
378 . "BEGIN { chdir q\x00$dir\x00 or die q\x00$dir: \$!\x00 }\n"
379 . 'BEGIN { ' . (delete $self->{trace_begin}) . "}\n"
380 . "CHECK {\n"
381 . 'open STDOUT, ">:raw", "out" or die "out: $!";'
382 . 'print join "\x00", values %INC;'
383 . 'open STDERR, ">stderr";' # suppress "syntax OK" message from perl
384 . "}\n"
385 . (delete $self->{trace_check});
386 close $fh;
387
388 system _perl_path, "-c", "$dir/eval"
389 and croak "trace failure, check trace process output - caught";
390
391 my @inc = split /\x00/, do {
392 open my $fh, "<:perlio", "$dir/out"
393 or croak "$dir/out: $!";
394 local $/;
395 scalar readline $fh
396 };
397
398 my $matchprefix = $self->{matchprefix};
399
400 # remove the library directory prefix, hope for the best
401 s/$matchprefix//
402 or croak "$_: file outside any library directory"
403 for @inc;
404
405 $self->_add (\@inc);
406 }
407 }
408
409 =item $extractor->add_mod ($module[, $module...])
410
411 Adds the given module(s) to the file set - the module name must be specified
412 as in C<use>, i.e. with C<::> as separators and without F<.pm>.
413
414 The program will be loaded with the default import list, any dependent
415 files, such as the shared object implementing xs functions, or autoload
416 files, will also be added.
417
418 If you want to use a different import list (for those rare modules wghere
419 import lists trigger different backend modules to be loaded for example),
420 you can use C<add_eval> instead:
421
422 $extractor->add_eval ("use Module qw(a b c)");
423
424 Example: add F<Coro.pm> and F<AnyEvent/AIO.pm>, and all relevant files
425 from the distribution they are part of.
426
427 $extractor->add_mod ("Coro", "AnyEvent::AIO");
428
429 =cut
430
431 sub add_mod {
432 my $self = shift;
433
434 for (@_) {
435 my $pkg = "libextractor" . ++$self->{count};
436 $self->_trace ("use $_", "{ package $pkg; use $_ }")
437 unless $self->{add_mod}{$_}++;
438 }
439 }
440
441 =item $extractor->add_bin ($name[, $name...])
442
443 Adds the given (perl) program(s) to the file set, that is, a program
444 installed by some perl module, written in perl (an example would be the
445 L<perl-libextract> program that is part of the C<Perl::LibExtractor>
446 distribution).
447
448 Example: add the deliantra client program installed by the
449 L<Deliantra::Client> module and put it under F<bin/deliantra>.
450
451 $extractor->add_bin ("deliantra");
452
453 =cut
454
455 sub add_bin {
456 my $self = shift;
457
458 exe:
459 for my $exe (@_) {
460 for my $dir ($Config{sitebinexp}, $Config{vendorbinexp}, $Config{binexp}) {
461 if (open my $fh, "<:perlio", "$dir/$exe") {
462 if (-f $fh) {
463 my $file = do { local $/; readline $fh };
464
465 $self->_trace_flush if exists $self->{trace_check};
466 $self->{trace_check} = $file;
467
468 $self->{set}{"bin/$exe"} = ["$dir/$exe"];
469 next exe;
470 }
471 }
472 }
473
474 croak "add_bin ($exe): executable not found";
475 }
476 }
477
478 =item $extractor->add_eval ($string)
479
480 Evaluates the string as perl code and adds all modules that are loaded
481 by it. For example, this would add L<AnyEvent> and the default backend
482 implementation module and event loop module:
483
484 $extractor->add_eval ("use AnyEvent; AnyEvent::detect");
485
486 Each code snippet will be executed in its own package and under C<use
487 strict>.
488
489 =cut
490
491 sub add_eval {
492 my ($self, $eval) = @_;
493
494 my $pkg = "libextractor" . ++$self->{count};
495 $eval =~ s/\x00/\x00."\\x00".q\x00/g;
496 $self->_trace ($eval,
497 "local \$^H = \$^H;" # vvvvvvvvvvvvvvvvvvvv = use strict; use utf8
498 . "eval q\x00package $pkg; BEGIN { \$^H = \$^H | 0x800600 } $eval\x00; die \"\$\@\" if \$\@;\n"
499 );
500 }
501
502 =back
503
504 =head2 OTHER METHODS FOR ADDING FILES
505
506 The following methods add commonly used files that are either not covered
507 by other methods or add commonly-used dependencies.
508
509 =over 4
510
511 =item $extractor->add_perl
512
513 Adds the perl binary itself to the file set, including the libperl dll, if
514 needed.
515
516 For example, on UNIX systems, this usually adds a F<exe/perl> and possibly
517 some F<dll/libperl.so.XXX>.
518
519 =cut
520
521 sub add_perl {
522 my ($self) = @_;
523
524 $self->{set}{"exe/perl$Config{_exe}"} = [_perl_path];
525
526 # on debian, we have the special case of a perl binary linked against
527 # a static libperl.a (which is not available), but the Config says to use
528 # a shared library, which is in the wrong directory, too (which breaks
529 # every other perl installation on the system - they are so stupid).
530
531 # that means we can't find the libperl.so, because dbeian actively breaks
532 # their perl install, and we don't need it. we work around this by silently
533 # not including the libperl if we cannot find it.
534
535 if ($Config{useshrplib} eq "true") {
536 my ($libperl, $libpath);
537
538 if ($^O eq "cygwin") {
539 $libperl = $Config{libperl};
540 $libpath = "$Config{binexp}/$libperl";
541 } elsif ($^O eq "MSWin32") {
542 ($libperl = $Config{libperl}) =~ s/\Q$Config{_a}\E$/.$Config{so}/;
543 $libpath = "$Config{binexp}/$libperl";
544 } else {
545 $libperl = $Config{libperl};
546 $libpath = $self->{lib}{"CORE/$libperl"};
547 }
548
549 $self->{set}{"dll/$libperl"} = $libpath
550 if length $libpath && -e $libpath;
551 }
552 }
553
554 =item $extractor->add_core_support
555
556 Try to add modules and files needed to support commonly-used builtin
557 language features. For example to open a scalar for I/O you need the
558 L<PerlIO::scalar> module:
559
560 open $fh, "<", \$scalar
561
562 A number of regex and string features (e.g. C<ucfirst>) need some unicore
563 files, e.g.:
564
565 'my $x = chr 1234; "\u$x\U$x\l$x\L$x"; $x =~ /\d|\w|\s|\b|$x/i';
566
567 This call adds these files (simply by executing code similar to the above
568 code fragments).
569
570 Notable things that are missing are other PerlIO layers, such as
571 L<PerlIO::encoding>, and named character and character class matches.
572
573 =cut
574
575 sub add_core_support {
576 my ($self) = @_;
577
578 $self->add_eval ('my $v; open my $fh, "<", \$v');
579 $self->add_eval ('my $x = chr 1234; "\u$x\U$x\l$x\L$x"; $x =~ /\d|\w|\s|\b|\R|\h|\v|$x/i');
580 $self->add_eval ('split " ", chr 1234'); # usually covered by the regex above
581 $self->add_eval ('/\x{1234}(?<a>)\g{a}/') if $] >= 5.010; # usually covered by the regex above
582 }
583
584 =item $extractor->add_unicore
585
586 Adds (hopefully) all files from the unicore database that will ever be
587 needed.
588
589 If you are not sure which unicode character classes and similar unicore
590 databases you need, and you do not care about an extra one thousand(!)
591 files comprising 4MB of data, then you can just call this method, which
592 adds basically all files from perl's unicode database.
593
594 Note that C<add_core_support> also adds some unicore files, but it's not a
595 subset of C<add_unicore> - the former adds all files neccessary to support
596 core builtins (which includes some unicore files and other things), while
597 the latter adds all unicore files (but nothing else).
598
599 When in doubt, use both.
600
601 =cut
602
603 sub add_unicore {
604 my ($self) = @_;
605
606 $self->_add ([grep m%^unicore/.*\.pl$%, keys %{ $self->{lib} }]);
607 }
608
609 =item $extractor->add_core
610
611 This adds all files from the perl core distribution, that is, all library
612 files that come with perl.
613
614 This is a superset of C<add_core_support> and C<add_unicore>.
615
616 This is quite a lot, but on the plus side, you can be sure nothing is
617 missing.
618
619 This requires a full perl installation - many distributions (Debian
620 GNU/Linux for example) don't package all library files that perl installs.
621
622 =cut
623
624 sub add_core {
625 my ($self) = @_;
626
627 my $lib = $self->{lib};
628
629 for (@{
630 $self->_read_packlist ($Config{privlibexp}, ".packlist")
631 }) {
632 $self->{set}{$_} ||= [
633 "lib/"
634 . ($lib->{$_} or croak "$_: unable to locate file in perl library")
635 ];
636 }
637 }
638
639 =back
640
641 =head2 GLOB-BASED ADDING AND FILTERING
642
643 These methods add or manipulate files by using glob-based patterns.
644
645 These glob patterns work similarly to glob patterns in the shell:
646
647 =over 4
648
649 =item /
650
651 A F</> at the start of the pattern interprets the pattern as a file
652 path inside the file set, almost the same as in the shell. For example,
653 F</bin/perl*> would match all files whose names starting with F<perl>
654 inside the F<bin> directory in the set.
655
656 If the F</> is missing, then the pattern is interpreted as a module name
657 (a F<.pm> file). For example, F<Coro> matches the file F<lib/Coro.pm> ,
658 while F<Coro::*> would match F<lib/Coro/*.pm>.
659
660 =item *
661
662 A single star matches anything inside a single directory component. For
663 example, F</lib/Coro/*.pm> would match all F<.pm> files inside the
664 F<lib/Coro/> directory, but not any files deeper in the hierarchy.
665
666 Another way to look at it is that a single star matches anything but a
667 slash (F</>).
668
669 =item **
670
671 A double star matches any number of characters in the path, including F</>.
672
673 For example, F<AnyEvent::**> would match all modules whose names start
674 with C<AnyEvent::>, no matter how deep in the hierarchy they are.
675
676 =back
677
678 =cut
679
680 sub _extglob2re {
681 for (quotemeta $_[1]) {
682 s/\\\*\\\*/.*/g;
683 s/\\\*/[^\/]*/g;
684 s/\\\?/[^\/]/g;
685
686 unless (s%^\\/%%) {
687 s%\\:\\:%/%g;
688 $_ = "lib/$_\\.pm";
689 }
690
691 $_ .= '$';
692 s/(?: \[\^\/\] | \. ) \*\$$//x; # remove ** at end
693
694 return qr<^$_>s
695 }
696 }
697
698 =over 4
699
700 =item $extractor->add_glob ($modglob[, $modglob...])
701
702 Adds all files from the perl library that match the given glob pattern.
703
704 For example, you could implement C<add_unicore> yourself like this:
705
706 $extractor->add_glob ("/unicore/**.pl");
707
708 =cut
709
710 sub add_glob {
711 my $self = shift;
712
713 for (@_) {
714 my $pat = $self->_extglob2re ($_);
715 $self->_add ([grep /$pat/, keys %{ $self->{lib} }]);
716 }
717 }
718
719 =item $extractor->filter ($pattern[, $pattern...])
720
721 Applies a series of include/exclude filters. Each filter must start with
722 either C<+> or C<->, to designate the pattern as I<include> or I<exclude>
723 pattern. The rest of the pattern is a normal glob pattern.
724
725 An exclude pattern (C<->) instantly removes all matching files from
726 the set. An include pattern (C<+>) protects matching files from later
727 removals.
728
729 That is, if you have an include pattern then all files that were matched
730 by it will be included in the set, regardless of any further exclude
731 patterns matching the same files.
732
733 Likewise, any file excluded by a pattern will not be included in the set,
734 even if matched by later include patterns.
735
736 Any files not matched by any expression will simply stay in the set.
737
738 For example, to remove most of the useless autoload functions by the POSIX
739 module (they either do the same thing as a builtin or always raise an
740 error), you would use this:
741
742 $extractor->filter ("-/lib/auto/POSIX/*.al");
743
744 This does not remove all autoload files, only the ones not defined by a
745 subclass (e.g. it leaves C<POSIX::SigRt::xxx> alone).
746
747 =cut
748
749 sub filter {
750 my ($self, @patterns) = @_;
751
752 $self->_trace_flush;
753
754 my $set = $self->{set};
755 my %include;
756
757 for my $pat (@patterns) {
758 $pat =~ s/^([+\-])//
759 or croak "$_: not a valid filter pattern (missing + or - prefix)";
760 my $inc = $1 eq "+";
761 $pat = $self->_extglob2re ($pat);
762
763 my @match = grep /$pat/, keys %$set;
764
765 if ($inc) {
766 @include{@match} = delete @$set{@match};
767 } else {
768 delete @$set{@{ $_->[I_DEP] }} # remove dependents
769 for delete @$set{@match};
770 }
771 }
772
773 my @include = keys %include;
774 @$set{@include} = delete @include{@include};
775 }
776
777 =item $extractor->runtime_only
778
779 This removes all files that are not needed at runtime, such as static
780 archives, header and other files needed only for compilation of modules,
781 and pod and html files (which are unlikely to be needed at runtime).
782
783 This is quite useful when you want to have only files actually needed to
784 execute a program.
785
786 =cut
787
788 sub runtime_only {
789 my ($self) = @_;
790
791 $self->_trace_flush;
792
793 my $set = $self->{set};
794
795 # delete all static libraries, also windows stuff
796 delete @$set{ grep m%^lib/auto/(?:.+/)?([^\/]+)/\1(?:\Q$Config{_a}\E|\.pdb|\.exp)$%s, keys %$set };
797
798 # delete all extralibs.ld and extralibs.all (no clue what the latter is for)
799 delete @$set{ grep m%^lib/auto/.*/extralibs\.(?:ld|all)$%s, keys %$set };
800
801 # delete all .pod, .h, .html files (hopefully none of them are used at runtime)
802 delete @$set{ grep m%^lib/.*\.(?:pod|h|html)$%s, keys %$set };
803
804 # delete unneeded unicore files
805 delete @$set{ grep m%^lib/unicore/(?:mktables(?:\.lst)?|.*\.txt)$%s, keys %$set };
806 }
807
808 =back
809
810 =head2 RESULT SET
811
812 =over 4
813
814 =item $set = $extractor->set
815
816 Returns a hash reference that represents the result set. The hash is the
817 actual internal storage hash and can only be modified as described below.
818
819 Each key in the hash is the path inside the set, without a leading slash,
820 e.g.:
821
822 bin/perl
823 lib/unicore/lib/Blk/Superscr.pl
824 lib/AnyEvent/Impl/EV.pm
825
826 The value is an array reference with mostly unspecified contents, except
827 the first element, which is the file system path where the actual file can
828 be found.
829
830 This code snippet lists all files inside the set:
831
832 print "$_\n"
833 for sort keys %{ $extractor->set });
834
835 This code fragment prints C<< filesystem_path => set_path >> pairs for all
836 files in the set:
837
838 my $set = $extractor->set;
839 while (my ($set,$fspath) = each %$set) {
840 print "$fspath => $set\n";
841 }
842
843 You can implement your own filtering by asking for the result set with
844 C<< $extractor->set >>, and then deleting keys from the referenced hash
845 - since you can ask for the result set at any time you can add things,
846 filter them out this way, and add additional things.
847
848 =back
849
850 =cut
851
852 sub set {
853 $_[0]->_trace_flush;
854 $_[0]{set}
855 }
856
857 =head1 EXAMPLE
858
859 To package he deliantra client (L<Deliantra::Client>), finding all
860 (perl) files needed to run it is a first step. This can be done by using
861 something like the following code snippet:
862
863 my $ex = new Perl::LibExtractor;
864
865 $ex->add_perl;
866 $ex->add_core_support;
867 $ex->add_bin ("deliantra");
868 $ex->add_mod ("AnyEvent::Impl::EV");
869 $ex->add_mod ("AnyEvent::Impl::Perl");
870 $ex->add_mod ("Urlader");
871 $ex->filter ("-/*/auto/POSIX/**.al");
872 $ex->runtime_only;
873
874 First it sets the perl library directory to F<pm> and F<.> (the latter
875 to work around some AutoLoader bugs), so perl uses only the perl library
876 files that came with the binary package.
877
878 Then it sets some environment variable to override the system default
879 (which might be incompatible).
880
881 Then it runs the client itself, using C<require>. Since C<require> only
882 looks in the perl library directory this is the reaosn why the scripts
883 were put there (of course, since F<.> is also included it doesn't matter,
884 but I refuse to yield to bugs).
885
886 Finally it exits with a clean status to signal "ok" to Urlader.
887
888 Back to the original C<Perl::LibExtractor> script: after initialising a
889 new set, the script simply adds the F<perl> interpreter and core support
890 files (just in case, not all are needed, but some are, and I am too lazy
891 to find out which ones exactly).
892
893 Then it adds the deliantra executable itself, which in turn adds most of
894 the required modules. After that, the AnyEvent implementation modules are
895 added because these dependencies are not picked up automatically.
896
897 The L<Urlader> module is added because the client itself does not depend
898 on it at all, but the wrapper does.
899
900 At this point, all required files are present, and it's time to slim
901 down: most of the ueseless POSIX autoloaded functions are removed,
902 not because they are so big, but because creating files is a costly
903 operation in itself, so even small fiels have considerable overhead when
904 unpacking. Then files not required for running the client are removed.
905
906 And that concludes it, the set is now ready.
907
908 =head1 SEE ALSO
909
910 The utility program that comes with this module: L<perl-libextract>.
911
912 L<App::Staticperl>, L<Urlader>, L<Perl::Squish>.
913
914 =head1 LICENSE
915
916 This software package is licensed under the GPL version 3 or any later
917 version, see COPYING for details.
918
919 This license does not, of course, apply to any output generated by this
920 software.
921
922 =head1 AUTHOR
923
924 Marc Lehmann <schmorp@schmorp.de>
925 http://home.schmorp.de/
926
927 =cut
928
929 1;
930