ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/App-Staticperl/mkbundle
(Generate patch)

Comparing App-Staticperl/mkbundle (file contents):
Revision 1.2 by root, Mon Dec 6 20:53:43 2010 UTC vs.
Revision 1.34 by root, Mon Mar 12 21:45:10 2012 UTC

1#!/opt/bin/perl 1#!/opt/bin/perl
2 2
3############################################################################# 3#############################################################################
4# cannot load modules till after the tracer BEGIN block 4# cannot load modules till after the tracer BEGIN block
5 5
6our $VERBOSE = 1; 6our $VERBOSE = 1;
7our $STRIP = "pod"; # none, pod or ppi 7our $STRIP = "pod"; # none, pod or ppi
8our $UNISTRIP = 1; # always on, try to strip unicore swash data
8our $PERL = 0; 9our $PERL = 0;
10our $APP;
9our $VERIFY = 0; 11our $VERIFY = 0;
10our $STATIC = 0; 12our $STATIC = 0;
13our $PACKLIST = 0;
14our $IGNORE_ENV = 0;
15our $ALLOW_DYNAMIC = 0;
16our $HAVE_DYNAMIC; # maybe useful?
17
18our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression?
19
20our $CACHE;
21our $CACHEVER = 1; # do not change unless you know what you are doing
11 22
12my $PREFIX = "bundle"; 23my $PREFIX = "bundle";
13my $PACKAGE = "static"; 24my $PACKAGE = "static";
14 25
15my %pm; 26my %pm;
27my %pmbin;
16my @libs; 28my @libs;
17my @static_ext; 29my @static_ext;
18my $extralibs; 30my $extralibs;
31my @staticlibs;
32my @incext;
19 33
20@ARGV 34@ARGV
21 or die "$0: use 'staticperl help' (or read the sources of staticperl)\n"; 35 or die "$0: use 'staticperl help' (or read the sources of staticperl)\n";
22 36
37# remove "." from @INC - staticperl.sh does it for us, but be on the safe side
38BEGIN { @INC = grep !/^\.$/, @INC }
39
23$|=1; 40$|=1;
24 41
25our ($TRACER_W, $TRACER_R); 42our ($TRACER_W, $TRACER_R);
26 43
27sub find_inc($) { 44sub find_incdir($) {
28 for (@INC) { 45 for (@INC) {
29 next if ref; 46 next if ref;
30 return $_ if -e "$_/$_[0]"; 47 return $_ if -e "$_/$_[0]";
31 } 48 }
32 49
33 undef 50 undef
34} 51}
35 52
53sub find_inc($) {
54 my $dir = find_incdir $_[0];
55
56 return "$dir/$_[0]"
57 if defined $dir;
58
59 undef
60}
61
36BEGIN { 62BEGIN {
37 # create a loader process to detect @INC requests before we load any modules 63 # create a loader process to detect @INC requests before we load any modules
38 my ($W_TRACER, $R_TRACER); # used by tracer 64 my ($W_TRACER, $R_TRACER); # used by tracer
39 65
40 pipe $R_TRACER, $TRACER_W or die "pipe: $!"; 66 pipe $R_TRACER, $TRACER_W or die "pipe: $!";
42 68
43 unless (fork) { 69 unless (fork) {
44 close $TRACER_R; 70 close $TRACER_R;
45 close $TRACER_W; 71 close $TRACER_W;
46 72
73 my $pkg = "pkg000000";
74
47 unshift @INC, sub { 75 unshift @INC, sub {
48 my $dir = find_inc $_[1] 76 my $dir = find_incdir $_[1]
49 or return; 77 or return;
50 78
51 syswrite $W_TRACER, "-\n$dir\n$_[1]\n"; 79 syswrite $W_TRACER, "-\n$dir\n$_[1]\n";
52 80
53 open my $fh, "<:perlio", "$dir/$_[1]" 81 open my $fh, "<:raw:perlio", "$dir/$_[1]"
54 or warn "ERROR: $dir/$_[1]: $!\n"; 82 or warn "ERROR: $dir/$_[1]: $!\n";
55 83
56 $fh 84 $fh
57 }; 85 };
58 86
59 while (<$R_TRACER>) { 87 while (<$R_TRACER>) {
60 if (/use (.*)$/) { 88 if (/use (.*)$/) {
61 my $mod = $1; 89 my $mod = $1;
90 my $eval;
91
92 if ($mod =~ /^'.*'$/ or $mod =~ /^".*"$/) {
62 eval "require $mod"; 93 $eval = "require $mod";
94 } elsif ($mod =~ y%/.%%) {
95 $eval = "require q\x00$mod\x00";
96 } else {
97 my $pkg = ++$pkg;
98 $eval = "{ package $pkg; use $mod; }";
99 }
100
101 eval $eval;
63 warn "ERROR: $@ (while loading '$mod')\n" 102 warn "ERROR: $@ (while loading '$mod')\n"
64 if $@; 103 if $@;
65 syswrite $W_TRACER, "\n";
66 } elsif (/eval (.*)$/) { 104 } elsif (/eval (.*)$/) {
67 my $eval = $1; 105 my $eval = $1;
68 eval $eval; 106 eval $eval;
69 warn "ERROR: $@ (in '$eval')\n" 107 warn "ERROR: $@ (in '$eval')\n"
70 if $@; 108 if $@;
71 } 109 }
110
111 syswrite $W_TRACER, "\n";
72 } 112 }
73 113
74 exit 0; 114 exit 0;
75 } 115 }
76} 116}
77 117
78# module loading is now safe 118# module loading is now safe
79use Config;
80 119
81sub trace_module { 120sub trace_parse {
82 syswrite $TRACER_W, "use $_[0]\n";
83
84 for (;;) { 121 for (;;) {
85 <$TRACER_R> =~ /^-$/ or last; 122 <$TRACER_R> =~ /^-$/ or last;
86 my $dir = <$TRACER_R>; chomp $dir; 123 my $dir = <$TRACER_R>; chomp $dir;
87 my $name = <$TRACER_R>; chomp $name; 124 my $name = <$TRACER_R>; chomp $name;
88 125
89 $pm{$name} = "$dir/$name"; 126 $pm{$name} = "$dir/$name";
90 127
128 print "+ found potential dependency $name\n"
129 if $VERBOSE >= 3;
130 }
131}
132
133sub trace_module {
134 print "tracing module $_[0]\n"
135 if $VERBOSE >= 2;
136
137 syswrite $TRACER_W, "use $_[0]\n";
138 trace_parse;
139}
140
141sub trace_eval {
142 print "tracing eval $_[0]\n"
143 if $VERBOSE >= 2;
144
145 syswrite $TRACER_W, "eval $_[0]\n";
146 trace_parse;
147}
148
149sub trace_finish {
150 close $TRACER_W;
151 close $TRACER_R;
152}
153
154#############################################################################
155# now we can use modules
156
157use common::sense;
158use Config;
159use Digest::MD5;
160
161sub cache($$$) {
162 my ($variant, $src, $filter) = @_;
163
164 if (length $CACHE and 2048 <= length $src and defined $variant) {
165 my $file = "$CACHE/" . Digest::MD5::md5_hex "$CACHEVER\x00$variant\x00$src";
166
167 if (open my $fh, "<:raw:perlio", $file) {
168 print "using cache for $file\n"
169 if $VERBOSE >= 7;
170
171 local $/;
172 return <$fh>;
173 }
174
175 $src = $filter->($src);
176
177 print "creating cache entry $file\n"
178 if $VERBOSE >= 8;
179
180 if (open my $fh, ">:raw:perlio", "$file~") {
181 if ((syswrite $fh, $src) == length $src) {
182 close $fh;
183 rename "$file~", $file;
184 }
185 }
186
187 return $src;
188 }
189
190 $filter->($src)
191}
192
193sub dump_string {
194 my ($fh, $data) = @_;
195
196 if (length $data) {
197 if ($^O eq "MSWin32") {
198 # 16 bit system, strings can't be longer than 64k. seriously.
199 print $fh "{\n";
200 for (
201 my $ofs = 0;
202 length (my $substr = substr $data, $ofs, 20);
203 $ofs += 20
204 ) {
205 $substr = join ",", map ord, split //, $substr;
206 print $fh " $substr,\n";
207 }
208 print $fh " 0 }\n";
209 } else {
210 for (
211 my $ofs = 0;
212 length (my $substr = substr $data, $ofs, 80);
213 $ofs += 80
214 ) {
215 $substr =~ s/([^\x20-\x21\x23-\x5b\x5d-\x7e])/sprintf "\\%03o", ord $1/ge;
216 $substr =~ s/\?/\\?/g; # trigraphs...
217 print $fh " \"$substr\"\n";
218 }
219 }
220 } else {
221 print $fh " \"\"\n";
222 }
223}
224
225#############################################################################
226
227sub glob2re {
228 for (quotemeta $_[0]) {
229 s/\\\*/\x00/g;
230 s/\x00\x00/.*/g;
231 s/\x00/[^\/]*/g;
232 s/\\\?/[^\/]/g;
233
234 $_ = s/^\\\/// ? "^$_\$" : "(?:^|/)$_\$";
235
236 s/(?: \[\^\/\] | \. ) \*\$$//x;
237
238 return qr<$_>s
239 }
240}
241
242our %INCSKIP = (
243 "unicore/TestProp.pl" => undef, # 3.5MB of insanity, apparently just some testcase
244);
245
246sub get_dirtree {
247 my $root = shift;
248
249 my @tree;
250 my $skip;
251
252 my $scan; $scan = sub {
253 for (sort do {
254 opendir my $fh, $_[0]
255 or return;
256 readdir $fh
257 }) {
258 next if /^\./;
259
260 my $path = "$_[0]/$_";
261
262 if (-d "$path/.") {
263 $scan->($path);
264 } else {
265 $path = substr $path, $skip;
266 push @tree, $path
267 unless exists $INCSKIP{$path};
268 }
269 }
270 };
271
272 $root =~ s/\/$//;
273 $skip = 1 + length $root;
274 $scan->($root);
275
276 \@tree
277}
278
279my $inctrees;
280
281sub get_inctrees {
282 unless ($inctrees) {
283 my %inctree;
284 $inctree{$_} ||= [$_, get_dirtree $_] # entries in @INC are often duplicates
285 for @INC;
286 $inctrees = [values %inctree];
287 }
288
289 @$inctrees
290}
291
292#############################################################################
293
294sub cmd_boot {
295 $pm{"!boot"} = $_[0];
296}
297
298sub cmd_add {
299 $_[0] =~ /^(.*?)(?:\s+(\S+))?$/
300 or die "$_[0]: cannot parse";
301
302 my $file = $1;
303 my $as = defined $2 ? $2 : $1;
304
305 $pm{$as} = $file;
306 $pmbin{$as} = 1 if $_[1];
307}
308
309sub cmd_staticlib {
310 push @staticlibs, $_
311 for split /\s+/, $_[0];
312}
313
314sub cmd_include {
315 push @incext, [$_[1], glob2re $_[0]];
316}
317
318sub cmd_incglob {
319 my ($pattern) = @_;
320
321 $pattern = glob2re $pattern;
322
323 for (get_inctrees) {
324 my ($dir, $files) = @$_;
325
326 $pm{$_} = "$dir/$_"
327 for grep /$pattern/ && /\.(pl|pm)$/, @$files;
328 }
329}
330
331sub parse_argv;
332
333sub cmd_file {
334 open my $fh, "<", $_[0]
335 or die "$_[0]: $!\n";
336
337 local @ARGV;
338
339 while (<$fh>) {
340 chomp;
341 next unless /\S/;
342 next if /^\s*#/;
343
344 s/^\s*-*/--/;
345 my ($cmd, $args) = split / /, $_, 2;
346
347 push @ARGV, $cmd;
348 push @ARGV, $args if defined $args;
349 }
350
351 parse_argv;
352}
353
354use Getopt::Long;
355
356sub parse_argv {
357 GetOptions
358 "perl" => \$PERL,
359 "app=s" => \$APP,
360
361 "verbose|v" => sub { ++$VERBOSE },
362 "quiet|q" => sub { --$VERBOSE },
363
364 "strip=s" => \$STRIP,
365 "cache=s" => \$CACHE, # internal option
366 "eval|e=s" => sub { trace_eval $_[1] },
367 "use|M=s" => sub { trace_module $_[1] },
368 "boot=s" => sub { cmd_boot $_[1] },
369 "add=s" => sub { cmd_add $_[1], 0 },
370 "addbin=s" => sub { cmd_add $_[1], 1 },
371 "incglob=s" => sub { cmd_incglob $_[1] },
372 "include|i=s" => sub { cmd_include $_[1], 1 },
373 "exclude|x=s" => sub { cmd_include $_[1], 0 },
374 "usepacklists!" => \$PACKLIST,
375
376 "static!" => \$STATIC,
377 "staticlib=s" => sub { cmd_staticlib $_[1] },
378 "allow-dynamic!"=> \$ALLOW_DYNAMIC,
379 "ignore-env" => \$IGNORE_ENV,
380
381 "<>" => sub { cmd_file $_[0] },
382 or exit 1;
383}
384
385Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
386
387parse_argv;
388
389die "cannot specify both --app and --perl\n"
390 if $PERL and defined $APP;
391
392# required for @INC loading, unfortunately
393trace_module "PerlIO::scalar";
394
395#############################################################################
396# apply include/exclude
397
398{
399 my %pmi;
400
401 for (@incext) {
402 my ($inc, $glob) = @$_;
403
404 my @match = grep /$glob/, keys %pm;
405
406 if ($inc) {
407 # include
408 @pmi{@match} = delete @pm{@match};
409
410 print "applying include $glob - protected ", (scalar @match), " files.\n"
411 if $VERBOSE >= 5;
412 } else {
413 # exclude
414 delete @pm{@match};
415
416 print "applying exclude $glob - removed ", (scalar @match), " files.\n"
417 if $VERBOSE >= 5;
418 }
419 }
420
421 my @pmi = keys %pmi;
422 @pm{@pmi} = delete @pmi{@pmi};
423}
424
425#############################################################################
426# scan for AutoLoader, static archives and other dependencies
427
428sub scan_al {
429 my ($auto, $autodir) = @_;
430
431 my $ix = "$autodir/autosplit.ix";
432
433 print "processing autoload index for '$auto'\n"
434 if $VERBOSE >= 6;
435
436 $pm{"$auto/autosplit.ix"} = $ix;
437
438 open my $fh, "<:perlio", $ix
439 or die "$ix: $!";
440
441 my $package;
442
443 while (<$fh>) {
444 if (/^\s*sub\s+ ([^[:space:];]+) \s* (?:\([^)]*\))? \s*;?\s*$/x) {
445 my $al = "auto/$package/$1.al";
446 my $inc = find_inc $al;
447
448 defined $inc or die "$al: autoload file not found, but should be there.\n";
449
450 $pm{$al} = $inc;
451 print "found autoload function '$al'\n"
452 if $VERBOSE >= 6;
453
454 } elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) {
455 ($package = $1) =~ s/::/\//g;
456 } elsif (/^\s*(?:#|1?\s*;?\s*$)/) {
457 # nop
458 } else {
459 warn "WARNING: $ix: unparsable line, please report: $_";
460 }
461 }
462}
463
464for my $pm (keys %pm) {
91 if ($name =~ /^(.*)\.pm$/) { 465 if ($pm =~ /^(.*)\.pm$/) {
92 my $auto = "auto/$1"; 466 my $auto = "auto/$1";
93 my $autodir = "$dir/$auto"; 467 my $autodir = find_inc $auto;
94 468
95 if (-d $autodir) { 469 if (defined $autodir && -d $autodir) {
96 opendir my $dir, $autodir
97 or die "$autodir: $!\n";
98
99 for (readdir $dir) {
100 # AutoLoader 470 # AutoLoader
101 $pm{"$auto/$_"} = "$autodir/$_" 471 scan_al $auto, $autodir
102 if /\.(?:al|ix)$/; 472 if -f "$autodir/autosplit.ix";
103 473
474 # extralibs.ld
475 if (open my $fh, "<:perlio", "$autodir/extralibs.ld") {
476 print "found extralibs for $pm\n"
477 if $VERBOSE >= 6;
478
479 local $/;
480 $extralibs .= " " . <$fh>;
481 }
482
483 $pm =~ /([^\/]+).pm$/ or die "$pm: unable to match last component";
484
485 my $base = $1;
486
104 # static ext 487 # static ext
105 if (/\Q$Config{_a}\E$/o) { 488 if (-f "$autodir/$base$Config{_a}") {
489 print "found static archive for $pm\n"
490 if $VERBOSE >= 3;
491
106 push @libs, "$autodir/$_"; 492 push @libs, "$autodir/$base$Config{_a}";
107 push @static_ext, $name; 493 push @static_ext, $pm;
494 }
495
496 # dynamic object
497 if (-f "$autodir/$base.$Config{dlext}") {
498 if ($ALLOW_DYNAMIC) {
499 my $as = "!$auto/$base.$Config{dlext}";
500 $pm{$as} = "$autodir/$base.$Config{dlext}";
501 $pmbin{$as} = 1;
502
503 $HAVE_DYNAMIC = 1;
504
505 print "+ added dynamic object $as\n"
506 if $VERBOSE >= 3;
507 } else {
508 die "ERROR: found shared object '$autodir/$base.$Config{dlext}' but --allow-dynamic not given, aborting.\n"
509 }
510 }
511
512 if ($PACKLIST && open my $fh, "<:perlio", "$autodir/.packlist") {
513 print "found .packlist for $pm\n"
514 if $VERBOSE >= 3;
515
516 while (<$fh>) {
517 chomp;
518 s/ .*$//; # newer-style .packlists might contain key=value pairs
519
520 # only include certain files (.al, .ix, .pm, .pl)
521 if (/\.(pm|pl|al|ix)$/) {
522 for my $inc (@INC) {
523 # in addition, we only add files that are below some @INC path
524 $inc =~ s/\/*$/\//;
525
526 if ($inc eq substr $_, 0, length $inc) {
527 my $base = substr $_, length $inc;
528 $pm{$base} = $_;
529
530 print "+ added .packlist dependency $base\n"
531 if $VERBOSE >= 3;
532 }
533
534 last;
535 }
108 } 536 }
109
110 # extralibs.ld
111 if ($_ eq "extralibs.ld") {
112 open my $fh, "<:perlio", "$autodir/$_"
113 or die "$autodir/$_";
114
115 local $/;
116 $extralibs .= " " . <$fh>;
117 }
118
119 # dynamic object
120 warn "WARNING: found shared object - can't link statically ($_)\n"
121 if /\.\Q$Config{dlext}\E$/o;
122
123 #TODO: extralibs?
124 } 537 }
125 } 538 }
126 } 539 }
127 } 540 }
128} 541}
129 542
130sub trace_eval {
131 syswrite $TRACER_W, "eval $_[0]\n";
132}
133
134sub trace_finish {
135 close $TRACER_W;
136 close $TRACER_R;
137}
138
139############################################################################# 543#############################################################################
140# now we can use modules
141 544
142use common::sense; 545print "processing bundle files (try more -v power if you get bored waiting here)...\n"
143use Digest::MD5; 546 if $VERBOSE >= 1;
144
145sub dump_string {
146 my ($fh, $data) = @_;
147
148 if (length $data) {
149 for (
150 my $ofs = 0;
151 length (my $substr = substr $data, $ofs, 80);
152 $ofs += 80
153 ) {
154 $substr =~ s/([^\x20-\x21\x23-\x5b\x5d-\x7e])/sprintf "\\%03o", ord $1/ge;
155 $substr =~ s/\?/\\?/g; # trigraphs...
156 print $fh " \"$substr\"\n";
157 }
158 } else {
159 print $fh " \"\"\n";
160 }
161}
162
163# required for @INC loading, unfortunately
164trace_module "PerlIO::scalar";
165
166#trace_module "Term::ReadLine::readline"; # Term::ReadLine::Perl dependency
167# URI is difficult
168#trace_module "URI::http";
169#trace_module "URI::_generic";
170
171sub cmd_boot {
172 $pm{"//boot"} = $_[0];
173}
174
175sub cmd_add {
176 $_[0] =~ /^(.*)(?:\s*(\S+))$/
177 or die "$_[0]: cannot parse";
178
179 my $file = $1;
180 my $as = defined $2 ? $2 : "/$1";
181
182 $pm{$as} = $file;
183}
184
185sub cmd_file {
186 open my $fh, "<", $_[0]
187 or die "$_[0]: $!\n";
188
189 while (<$fh>) {
190 chomp;
191 my ($cmd, $args) = split / /, $_, 2;
192 $cmd =~ s/^-+//;
193
194 if ($cmd eq "strip") {
195 $STRIP = $args;
196 } elsif ($cmd eq "eval") {
197 trace_eval $_;
198 } elsif ($cmd eq "use") {
199 trace_module $_
200 for split / /, $args;
201 } elsif ($cmd eq "boot") {
202 cmd_boot $args;
203 } elsif ($cmd eq "static") {
204 $STATIC = 1;
205 } elsif ($cmd eq "add") {
206 cmd_add $args;
207 } elsif (/^\s*#/) {
208 # comment
209 } elsif (/\S/) {
210 die "$_: unsupported directive\n";
211 }
212 }
213}
214
215use Getopt::Long;
216
217Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
218
219GetOptions
220 "strip=s" => \$STRIP,
221 "verbose|v" => sub { ++$VERBOSE },
222 "quiet|q" => sub { --$VERBOSE },
223 "perl" => \$PERL,
224 "eval|e=s" => sub { trace_eval $_[1] },
225 "use|M=s" => sub { trace_module $_[1] },
226 "boot=s" => sub { cmd_boot $_[1] },
227 "add=s" => sub { cmd_add $_[1] },
228 "static" => sub { $STATIC = 1 },
229 "<>" => sub { cmd_file $_[1] },
230 or exit 1;
231 547
232my $data; 548my $data;
233my @index; 549my @index;
234my @order = sort { 550my @order = sort {
235 length $a <=> length $b 551 length $a <=> length $b
242 558
243for my $pm (@order) { 559for my $pm (@order) {
244 my $path = $pm{$pm}; 560 my $path = $pm{$pm};
245 561
246 128 > length $pm 562 128 > length $pm
247 or die "$pm: path too long (only 128 octets supported)\n"; 563 or die "ERROR: $pm: path too long (only 128 octets supported)\n";
248 564
249 my $src = ref $path 565 my $src = ref $path
250 ? $$path 566 ? $$path
251 : do { 567 : do {
252 open my $pm, "<:perlio", $path 568 open my $pm, "<:raw:perlio", $path
253 or die "$path: $!"; 569 or die "$path: $!";
254 570
255 local $/; 571 local $/;
256 572
257 <$pm> 573 <$pm>
258 }; 574 };
259 575
576 my $size = length $src;
577
578 unless ($pmbin{$pm}) { # only do this unless the file is binary
260 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { 579 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) {
261 if ($src =~ /^ unimpl \"/m) { 580 if ($src =~ /^ unimpl \"/m) {
262 warn "$pm: skipping (not implemented anyways).\n" 581 print "$pm: skipping (raises runtime error only).\n"
263 if $VERBOSE >= 2; 582 if $VERBOSE >= 3;
264 next; 583 next;
584 }
265 } 585 }
266 }
267 586
268 if ($STRIP =~ /ppi/i) { 587 $src = cache +($STRIP eq "ppi" ? "$UNISTRIP,$OPTIMISE_SIZE" : undef), $src, sub {
269 require PPI; 588 if ($UNISTRIP && $pm =~ /^unicore\/.*\.pl$/) {
589 print "applying unicore stripping $pm\n"
590 if $VERBOSE >= 6;
270 591
271 my $ppi = PPI::Document->new (\$src); 592 # special stripping for unicore swashes and properties
272 $ppi->prune ("PPI::Token::Comment"); 593 # much more could be done by going binary
273 $ppi->prune ("PPI::Token::Pod"); 594 $src =~ s{
595 (^return\ <<'END';\n) (.*?\n) (END(?:\n|\Z))
596 }{
597 my ($pre, $data, $post) = ($1, $2, $3);
274 598
275 # prune END stuff 599 for ($data) {
276 for (my $last = $ppi->last_element; $last; ) { 600 s/^([0-9a-fA-F]+)\t([0-9a-fA-F]+)\t/sprintf "%X\t%X", hex $1, hex $2/gem
277 my $prev = $last->previous_token; 601 if $OPTIMISE_SIZE;
278 602
279 if ($last->isa (PPI::Token::Whitespace::)) { 603# s{
280 $last->delete; 604# ^([0-9a-fA-F]+)\t([0-9a-fA-F]*)\t
281 } elsif ($last->isa (PPI::Statement::End::)) { 605# }{
282 $last->delete; 606# # ww - smaller filesize, UU - compress better
607# pack "C0UU",
608# hex $1,
609# length $2 ? (hex $2) - (hex $1) : 0
610# }gemx;
611
612 s/#.*\n/\n/mg;
613 s/\s+\n/\n/mg;
614 }
615
616 "$pre$data$post"
283 last; 617 }smex;
284 } elsif ($last->isa (PPI::Token::Pod::)) {
285 $last->delete;
286 } else {
287 last;
288 } 618 }
289 619
620 if ($STRIP =~ /ppi/i) {
621 require PPI;
622
623 if (my $ppi = PPI::Document->new (\$src)) {
624 $ppi->prune ("PPI::Token::Comment");
625 $ppi->prune ("PPI::Token::Pod");
626
627 # prune END stuff
628 for (my $last = $ppi->last_element; $last; ) {
629 my $prev = $last->previous_token;
630
631 if ($last->isa (PPI::Token::Whitespace::)) {
632 $last->delete;
633 } elsif ($last->isa (PPI::Statement::End::)) {
634 $last->delete;
635 last;
636 } elsif ($last->isa (PPI::Token::Pod::)) {
637 $last->delete;
638 } else {
639 last;
640 }
641
290 $last = $prev; 642 $last = $prev;
291 } 643 }
292 644
293 # prune some but not all insignificant whitespace 645 # prune some but not all insignificant whitespace
294 for my $ws (@{ $ppi->find (PPI::Token::Whitespace::) }) { 646 for my $ws (@{ $ppi->find (PPI::Token::Whitespace::) }) {
295 my $prev = $ws->previous_token; 647 my $prev = $ws->previous_token;
296 my $next = $ws->next_token; 648 my $next = $ws->next_token;
297 649
298 if (!$prev || !$next) { 650 if (!$prev || !$next) {
299 $ws->delete; 651 $ws->delete;
300 } else { 652 } else {
301 if ( 653 if (
302 $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float 654 $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float
303 or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/ 655 or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/
304 or $prev->isa (PPI::Token::Structure::) 656 or $prev->isa (PPI::Token::Structure::)
305 # decrease size, decrease compressability 657 or ($OPTIMISE_SIZE &&
306 #or ($prev->isa (PPI::Token::Word::) 658 ($prev->isa (PPI::Token::Word::)
307 # && (PPI::Token::Symbol:: eq ref $next 659 && (PPI::Token::Symbol:: eq ref $next
308 # || $next->isa (PPI::Structure::Block::) 660 || $next->isa (PPI::Structure::Block::)
309 # || $next->isa (PPI::Structure::List::) 661 || $next->isa (PPI::Structure::List::)
310 # || $next->isa (PPI::Structure::Condition::))) 662 || $next->isa (PPI::Structure::Condition::)))
663 )
311 ) { 664 ) {
312 $ws->delete; 665 $ws->delete;
313 } elsif ($prev->isa (PPI::Token::Whitespace::)) { 666 } elsif ($prev->isa (PPI::Token::Whitespace::)) {
314 $ws->{content} = ' '; 667 $ws->{content} = ' ';
315 $prev->delete; 668 $prev->delete;
669 } else {
670 $ws->{content} = ' ';
671 }
672 }
673 }
674
675 # prune whitespace around blocks
676 if ($OPTIMISE_SIZE) {
677 # these usually decrease size, but decrease compressability more
678 for my $struct (PPI::Structure::Block::, PPI::Structure::Condition::) {
679 for my $node (@{ $ppi->find ($struct) }) {
680 my $n1 = $node->first_token;
681 my $n2 = $n1->previous_token;
682 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
683 $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
684 my $n1 = $node->last_token;
685 my $n2 = $n1->next_token;
686 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
687 $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
688 }
689 }
690
691 for my $node (@{ $ppi->find (PPI::Structure::List::) }) {
692 my $n1 = $node->first_token;
693 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
694 my $n1 = $node->last_token;
695 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
696 }
697 }
698
699 # reformat qw() lists which often have lots of whitespace
700 for my $node (@{ $ppi->find (PPI::Token::QuoteLike::Words::) }) {
701 if ($node->{content} =~ /^qw(.)(.*)(.)$/s) {
702 my ($a, $qw, $b) = ($1, $2, $3);
703 $qw =~ s/^\s+//;
704 $qw =~ s/\s+$//;
705 $qw =~ s/\s+/ /g;
706 $node->{content} = "qw$a$qw$b";
707 }
708 }
709
710 $src = $ppi->serialize;
316 } else { 711 } else {
317 $ws->{content} = ' '; 712 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n";
713 }
714 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses its own pod
715 require Pod::Strip;
716
717 my $stripper = Pod::Strip->new;
718
719 my $out;
720 $stripper->output_string (\$out);
721 $stripper->parse_string_document ($src)
722 or die;
723 $src = $out;
724 }
725
726 if ($VERIFY && $pm =~ /\.pm$/ && $pm ne "Opcode.pm") {
727 if (open my $fh, "-|") {
728 <$fh>;
729 } else {
730 eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n";
731 exit 0;
318 } 732 }
319 } 733 }
734
735 $src
320 } 736 };
321 737
322 # prune whitespace around blocks
323 if (0) {
324 # these usually decrease size, but decrease compressability more
325 for my $struct (PPI::Structure::Block::, PPI::Structure::Condition::) {
326 for my $node (@{ $ppi->find ($struct) }) {
327 my $n1 = $node->first_token;
328 my $n2 = $n1->previous_token;
329 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
330 $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
331 my $n1 = $node->last_token;
332 my $n2 = $n1->next_token;
333 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
334 $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
335 }
336 }
337
338 for my $node (@{ $ppi->find (PPI::Structure::List::) }) {
339 my $n1 = $node->first_token;
340 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
341 my $n1 = $node->last_token;
342 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
343 }
344 }
345
346 # reformat qw() lists which often have lots of whitespace
347 for my $node (@{ $ppi->find (PPI::Token::QuoteLike::Words::) }) {
348 if ($node->{content} =~ /^qw(.)(.*)(.)$/s) {
349 my ($a, $qw, $b) = ($1, $2, $3);
350 $qw =~ s/^\s+//;
351 $qw =~ s/\s+$//;
352 $qw =~ s/\s+/ /g;
353 $node->{content} = "qw$a$qw$b";
354 }
355 }
356
357 $src = $ppi->serialize;
358 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod
359 require Pod::Strip;
360
361 my $stripper = Pod::Strip->new;
362
363 my $out;
364 $stripper->output_string (\$out);
365 $stripper->parse_string_document ($src);
366 $src = $out;
367 }
368
369 if ($VERIFY && $pm =~ /\.pm$/ && $pm ne "Opcode.pm") {
370 if (open my $fh, "-|") {
371 <$fh>;
372 } else {
373 eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n";
374 exit 0;
375 }
376 }
377
378# if ($pm eq "Opcode.pm") { 738# if ($pm eq "Opcode.pm") {
379# open my $fh, ">x" or die; print $fh $src;#d# 739# open my $fh, ">x" or die; print $fh $src;#d#
380# exit 1; 740# exit 1;
741# }
381# } 742 }
382 743
383 warn "adding $pm\n" 744 print "adding $pm (original size $size, stored size ", length $src, ")\n"
384 if $VERBOSE >= 2; 745 if $VERBOSE >= 2;
385 746
386 push @index, ((length $pm) << 25) | length $data; 747 push @index, ((length $pm) << 25) | length $data;
387 $data .= $pm . $src; 748 $data .= $pm . $src;
388} 749}
389 750
390length $data < 2**25 751length $data < 2**25
391 or die "bundle too large (only 32MB supported)\n"; 752 or die "ERROR: bundle too large (only 32MB supported)\n";
392 753
393my $varpfx = "bundle_" . substr +(Digest::MD5::md5_hex $data), 0, 16; 754my $varpfx = "bundle";
394 755
395############################################################################# 756#############################################################################
396# output 757# output
397 758
398print "generating $PREFIX.h... "; 759print "generating $PREFIX.h... "
760 if $VERBOSE >= 1;
399 761
400{ 762{
401 open my $fh, ">", "$PREFIX.h" 763 open my $fh, ">", "$PREFIX.h"
402 or die "$PREFIX.h: $!\n"; 764 or die "$PREFIX.h: $!\n";
403 765
404 print $fh <<EOF; 766 print $fh <<EOF;
405/* do not edit, automatically created by mkstaticbundle */ 767/* do not edit, automatically created by staticperl */
768
406#include <EXTERN.h> 769#include <EXTERN.h>
407#include <perl.h> 770#include <perl.h>
408#include <XSUB.h> 771#include <XSUB.h>
409 772
410/* public API */ 773/* public API */
411EXTERN_C PerlInterpreter *staticperl; 774EXTERN_C PerlInterpreter *staticperl;
412EXTERN_C void staticperl_init (void); 775EXTERN_C void staticperl_xs_init (pTHX);
776EXTERN_C void staticperl_init (XSINIT_t xs_init); /* argument can be 0 */
413EXTERN_C void staticperl_cleanup (void); 777EXTERN_C void staticperl_cleanup (void);
778
414EOF 779EOF
415} 780}
416 781
417print "\n"; 782print "\n"
783 if $VERBOSE >= 1;
418 784
419############################################################################# 785#############################################################################
420# output 786# output
421 787
422print "generating $PREFIX.c... "; 788print "generating $PREFIX.c... "
789 if $VERBOSE >= 1;
423 790
424open my $fh, ">", "$PREFIX.c" 791open my $fh, ">", "$PREFIX.c"
425 or die "$PREFIX.c: $!\n"; 792 or die "$PREFIX.c: $!\n";
426 793
427print $fh <<EOF; 794print $fh <<EOF;
428/* do not edit, automatically created by mkstaticbundle */ 795/* do not edit, automatically created by staticperl */
429
430#include <EXTERN.h>
431#include <perl.h>
432#include <XSUB.h>
433 796
434#include "bundle.h" 797#include "bundle.h"
435 798
436/* public API */ 799/* public API */
437PerlInterpreter *staticperl; 800PerlInterpreter *staticperl;
461printf $fh "0x%08x\n};\n", (length $data); 824printf $fh "0x%08x\n};\n", (length $data);
462 825
463print $fh "static const char $varpfx\_data [] =\n"; 826print $fh "static const char $varpfx\_data [] =\n";
464dump_string $fh, $data; 827dump_string $fh, $data;
465 828
466print $fh ";\n\n";; 829print $fh ";\n\n";
467 830
468############################################################################# 831#############################################################################
469# bootstrap 832# bootstrap
470 833
471# boot file for staticperl 834# boot file for staticperl
472# this file will be eval'ed at initialisation time 835# this file will be eval'ed at initialisation time
473 836
837# lines marked with "^D" are only used when $HAVE_DYNAMIC
474my $bootstrap = ' 838my $bootstrap = '
475BEGIN { 839BEGIN {
476 package ' . $PACKAGE . '; 840 package ' . $PACKAGE . ';
477 841
478 PerlIO::scalar->bootstrap; 842 # the path prefix to use when putting files into %INC
843 our $inc_prefix;
479 844
480 @INC = sub { 845 # the @INC hook to use when we have PerlIO::scalar available
846 my $perlio_inc = sub {
481 my $data = find "$_[1]" 847 my $data = find "$_[1]"
482 or return; 848 or return;
483 849
484 $INC{$_[1]} = $_[1]; 850 $INC{$_[1]} = "$inc_prefix$_[1]";
485 851
486 open my $fh, "<", \$data; 852 open my $fh, "<", \$data;
487 $fh 853 $fh
488 }; 854 };
855
856D if (defined &PerlIO::scalar::bootstrap) {
857 # PerlIO::scalar statically compiled in
858 PerlIO::scalar->bootstrap;
859 @INC = $perlio_inc;
860D } else {
861D # PerlIO::scalar not available, use slower method
862D @INC = sub {
863D # always check if PerlIO::scalar might now be available
864D if (defined &PerlIO::scalar::bootstrap) {
865D # switch to the faster perlio_inc hook
866D @INC = map { $_ == $_[0] ? $perlio_inc : $_ } @INC;
867D goto &$perlio_inc;
868D }
869D
870D my $data = find "$_[1]"
871D or return;
872D
873D $INC{$_[1]} = "$inc_prefix$_[1]";
874D
875D sub {
876D $data =~ /\G([^\n]*\n?)/g
877D or return;
878D
879D $_ = $1;
880D 1
881D }
882D };
883D }
489} 884}
490'; 885';
491 886
492$bootstrap .= "require '//boot';" 887$bootstrap .= "require '!boot';"
493 if exists $pm{"//boot"}; 888 if exists $pm{"!boot"};
494 889
890if ($HAVE_DYNAMIC) {
891 $bootstrap =~ s/^D/ /mg;
892} else {
893 $bootstrap =~ s/^D.*$//mg;
894}
895
896$bootstrap =~ s/#.*$//mg;
495$bootstrap =~ s/\s+/ /g; 897$bootstrap =~ s/\s+/ /g;
496$bootstrap =~ s/(\W) /$1/g; 898$bootstrap =~ s/(\W) /$1/g;
497$bootstrap =~ s/ (\W)/$1/g; 899$bootstrap =~ s/ (\W)/$1/g;
498 900
499print $fh "const char bootstrap [] = "; 901print $fh "const char bootstrap [] = ";
545 } 947 }
546 948
547 XSRETURN (0); 949 XSRETURN (0);
548 950
549 found: 951 found:
550 ST (0) = res; 952 ST (0) = sv_2mortal (res);
551 sv_2mortal (ST (0));
552 } 953 }
553 954
554 XSRETURN (1); 955 XSRETURN (1);
555} 956}
556 957
569 970
570 for (i = 0; i < $varpfx\_count; ++i) 971 for (i = 0; i < $varpfx\_count; ++i)
571 { 972 {
572 U32 idx = $varpfx\_index [i]; 973 U32 idx = $varpfx\_index [i];
573 974
574 PUSHs (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25)); 975 PUSHs (sv_2mortal (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25)));
575 } 976 }
576 } 977 }
577 978
578 XSRETURN ($varpfx\_count); 979 XSRETURN ($varpfx\_count);
579} 980}
580 981
581static char *args[] = {
582 "staticperl",
583 "-e",
584 "0"
585};
586
587EOF 982EOF
588 983
589############################################################################# 984#############################################################################
590# xs_init 985# xs_init
591 986
592print $fh <<EOF; 987print $fh <<EOF;
593static void 988void
594xs_init (pTHX) 989staticperl_xs_init (pTHX)
595{ 990{
596EOF 991EOF
597 992
598@static_ext = ("DynaLoader", sort @static_ext); 993@static_ext = sort @static_ext;
599 994
600# prototypes 995# prototypes
601for (@static_ext) { 996for (@static_ext) {
602 s/\.pm$//; 997 s/\.pm$//;
603 (my $cname = $_) =~ s/\//__/g; 998 (my $cname = $_) =~ s/\//__/g;
617 s/\.pm$//; 1012 s/\.pm$//;
618 1013
619 (my $cname = $_) =~ s/\//__/g; 1014 (my $cname = $_) =~ s/\//__/g;
620 (my $pname = $_) =~ s/\//::/g; 1015 (my $pname = $_) =~ s/\//::/g;
621 1016
622 my $bootstrap = $pname eq "DynaLoader" ? "boot" : "bootstrap"; 1017 my $bootstrap = $pname eq "DynaLoader" ? "boot_DynaLoader" : "bootstrap";
623 1018
624 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n"; 1019 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n";
625} 1020}
626 1021
627print $fh <<EOF; 1022print $fh <<EOF;
1023 #ifdef _WIN32
1024 /* windows perls usually trail behind unix perls 8-10 years in exporting symbols */
1025
1026 if (!PL_preambleav)
1027 PL_preambleav = newAV ();
1028
1029 av_unshift (PL_preambleav, 1);
1030 av_store (PL_preambleav, 0, newSVpv (bootstrap, sizeof (bootstrap) - 1));
1031 #else
628 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1)); 1032 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1));
1033 #endif
1034
1035 if (PL_oldname)
1036 ((XSINIT_t)PL_oldname)(aTHX);
629} 1037}
630EOF 1038EOF
631 1039
632############################################################################# 1040#############################################################################
633# optional perl_init/perl_destroy 1041# optional perl_init/perl_destroy
634 1042
1043if ($IGNORE_ENV) {
1044 $IGNORE_ENV = <<EOF;
1045 unsetenv ("PERL_UNICODE");
1046 unsetenv ("PERL_HASH_SEED_DEBUG");
1047 unsetenv ("PERL_DESTRUCT_LEVEL");
1048 unsetenv ("PERL_SIGNALS");
1049 unsetenv ("PERL_DEBUG_MSTATS");
1050 unsetenv ("PERL5OPT");
1051 unsetenv ("PERLIO_DEBUG");
1052 unsetenv ("PERLIO");
1053 unsetenv ("PERL_HASH_SEED");
1054EOF
1055} else {
1056 $IGNORE_ENV = "";
1057}
1058
1059if ($APP) {
1060 print $fh <<EOF;
1061
1062int
1063main (int argc, char *argv [])
1064{
1065 extern char **environ;
1066 int i, exitstatus;
1067 char **args = malloc ((argc + 3) * sizeof (const char *));
1068
1069 args [0] = argv [0];
1070 args [1] = "-e";
1071 args [2] = "0";
1072 args [3] = "--";
1073
1074 for (i = 1; i < argc; ++i)
1075 args [i + 3] = argv [i];
1076
1077$IGNORE_ENV
1078 PERL_SYS_INIT3 (&argc, &argv, &environ);
1079 staticperl = perl_alloc ();
1080 perl_construct (staticperl);
1081
1082 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1083
1084 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc + 3, args, environ);
1085 free (args);
1086 if (!exitstatus)
1087 perl_run (staticperl);
1088
1089 exitstatus = perl_destruct (staticperl);
1090 perl_free (staticperl);
1091 PERL_SYS_TERM ();
1092
1093 return exitstatus;
1094}
1095EOF
635if ($PERL) { 1096} elsif ($PERL) {
636 print $fh <<EOF; 1097 print $fh <<EOF;
637 1098
638int 1099int
639main (int argc, char *argv []) 1100main (int argc, char *argv [])
640{ 1101{
641 extern char **environ; 1102 extern char **environ;
642 int exitstatus; 1103 int exitstatus;
643 1104
1105$IGNORE_ENV
644 PERL_SYS_INIT3 (&argc, &argv, &environ); 1106 PERL_SYS_INIT3 (&argc, &argv, &environ);
645 staticperl = perl_alloc (); 1107 staticperl = perl_alloc ();
646 perl_construct (staticperl); 1108 perl_construct (staticperl);
647 1109
648 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1110 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
649 1111
650 exitstatus = perl_parse (staticperl, xs_init, argc, argv, environ); 1112 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
651 if (!exitstatus) 1113 if (!exitstatus)
652 perl_run (staticperl); 1114 perl_run (staticperl);
653 1115
654 exitstatus = perl_destruct (staticperl); 1116 exitstatus = perl_destruct (staticperl);
655 perl_free (staticperl); 1117 perl_free (staticperl);
660EOF 1122EOF
661} else { 1123} else {
662 print $fh <<EOF; 1124 print $fh <<EOF;
663 1125
664EXTERN_C void 1126EXTERN_C void
665staticperl_init (void) 1127staticperl_init (XSINIT_t xs_init)
666{ 1128{
1129 static char *args[] = {
1130 "staticperl",
1131 "-e",
1132 "0"
1133 };
1134
667 extern char **environ; 1135 extern char **environ;
668 int argc = sizeof (args) / sizeof (args [0]); 1136 int argc = sizeof (args) / sizeof (args [0]);
669 char **argv = args; 1137 char **argv = args;
670 1138
1139$IGNORE_ENV
671 PERL_SYS_INIT3 (&argc, &argv, &environ); 1140 PERL_SYS_INIT3 (&argc, &argv, &environ);
672 staticperl = perl_alloc (); 1141 staticperl = perl_alloc ();
673 perl_construct (staticperl); 1142 perl_construct (staticperl);
674 PL_origalen = 1; 1143 PL_origalen = 1;
675 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1144 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1145 PL_oldname = (char *)xs_init;
676 perl_parse (staticperl, xs_init, argc, argv, environ); 1146 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
677 1147
678 perl_run (staticperl); 1148 perl_run (staticperl);
679} 1149}
680 1150
681EXTERN_C void 1151EXTERN_C void
687 PERL_SYS_TERM (); 1157 PERL_SYS_TERM ();
688} 1158}
689EOF 1159EOF
690} 1160}
691 1161
1162close $fh;
1163
692print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n"; 1164print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n"
1165 if $VERBOSE >= 1;
693 1166
694############################################################################# 1167#############################################################################
695# libs, cflags 1168# libs, cflags
696 1169
1170my $ccopts;
1171
697{ 1172{
698 print "generating $PREFIX.ccopts... "; 1173 print "generating $PREFIX.ccopts... "
1174 if $VERBOSE >= 1;
699 1175
700 my $str = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE"; 1176 $ccopts = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE";
701 $str =~ s/([\(\)])/\\$1/g; 1177 $ccopts =~ s/([\(\)])/\\$1/g;
702
703 print "$str\n\n";
704 1178
705 open my $fh, ">$PREFIX.ccopts" 1179 open my $fh, ">$PREFIX.ccopts"
706 or die "$PREFIX.ccopts: $!"; 1180 or die "$PREFIX.ccopts: $!";
707 print $fh $str; 1181 print $fh $ccopts;
1182
1183 print "$ccopts\n\n"
1184 if $VERBOSE >= 1;
708} 1185}
1186
1187my $ldopts;
709 1188
710{ 1189{
711 print "generating $PREFIX.ldopts... "; 1190 print "generating $PREFIX.ldopts... ";
712 1191
713 my $str = $STATIC ? "--static " : ""; 1192 $ldopts = $STATIC ? "-static " : "";
714 1193
715 $str .= "$Config{ccdlflags} $Config{ldflags} @libs $Config{archlibexp}/CORE/$Config{libperl} $Config{perllibs}"; 1194 $ldopts .= "$Config{ccdlflags} $Config{ldflags} @libs $Config{archlibexp}/CORE/$Config{libperl} $Config{perllibs}";
716 1195
717 my %seen; 1196 my %seen;
718 $str .= " $_" for grep !$seen{$_}++, ($extralibs =~ /(\S+)/g); 1197 $ldopts .= " $_" for reverse grep !$seen{$_}++, reverse +($extralibs =~ /(\S+)/g);
719 1198
1199 for (@staticlibs) {
1200 $ldopts =~ s/(^|\s) (-l\Q$_\E) ($|\s)/$1-Wl,-Bstatic $2 -Wl,-Bdynamic$3/gx;
1201 }
1202
720 $str =~ s/([\(\)])/\\$1/g; 1203 $ldopts =~ s/([\(\)])/\\$1/g;
721
722 print "$str\n\n";
723 1204
724 open my $fh, ">$PREFIX.ldopts" 1205 open my $fh, ">$PREFIX.ldopts"
725 or die "$PREFIX.ldopts: $!"; 1206 or die "$PREFIX.ldopts: $!";
726 print $fh $str; 1207 print $fh $ldopts;
727}
728 1208
729if ($PERL) { 1209 print "$ldopts\n\n"
730 system "$Config{cc} \$(cat bundle.ccopts\) -o perl bundle.c \$(cat bundle.ldopts\)"; 1210 if $VERBOSE >= 1;
1211}
1212
1213if ($PERL or defined $APP) {
1214 $APP = "perl" unless defined $APP;
1215
1216 my $build = "$Config{cc} $ccopts -o \Q$APP\E$Config{_exe} bundle.c $ldopts";
1217
1218 print "build $APP...\n"
1219 if $VERBOSE >= 1;
1220
1221 print "$build\n"
1222 if $VERBOSE >= 2;
1223
1224 system $build;
731 1225
732 unlink "$PREFIX.$_" 1226 unlink "$PREFIX.$_"
733 for qw(ccopts ldopts c h); 1227 for qw(ccopts ldopts c h);
734}
735 1228
1229 print "\n"
1230 if $VERBOSE >= 1;
1231}
1232

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines