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

Comparing App-Staticperl/mkbundle (file contents):
Revision 1.4 by root, Mon Dec 6 21:10:41 2010 UTC vs.
Revision 1.28 by root, Sat Jul 9 18:26:27 2011 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_DLLS = 0;
16our $HAVE_DLLS; # 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, "<:perlio", "$dir/$_[1]"
… …
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
91 if ($name =~ /^(.*)\.pm$/) { 128 print "+ found potential dependency $name\n"
92 my $auto = "auto/$1"; 129 if $VERBOSE >= 3;
93 my $autodir = "$dir/$auto";
94
95 if (-d $autodir) {
96 opendir my $dir, $autodir
97 or die "$autodir: $!\n";
98
99 for (readdir $dir) {
100 # AutoLoader
101 $pm{"$auto/$_"} = "$autodir/$_"
102 if /\.(?:al|ix)$/;
103
104 # static ext
105 if (/\Q$Config{_a}\E$/o) {
106 push @libs, "$autodir/$_";
107 push @static_ext, $name;
108 }
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 }
125 }
126 }
127 } 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;
128} 139}
129 140
130sub trace_eval { 141sub trace_eval {
142 print "tracing eval $_[0]\n"
143 if $VERBOSE >= 2;
144
131 syswrite $TRACER_W, "eval $_[0]\n"; 145 syswrite $TRACER_W, "eval $_[0]\n";
146 trace_parse;
132} 147}
133 148
134sub trace_finish { 149sub trace_finish {
135 close $TRACER_W; 150 close $TRACER_W;
136 close $TRACER_R; 151 close $TRACER_R;
… …
138 153
139############################################################################# 154#############################################################################
140# now we can use modules 155# now we can use modules
141 156
142use common::sense; 157use common::sense;
158use Config;
143use Digest::MD5; 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, "<: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, ">: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}
144 192
145sub dump_string { 193sub dump_string {
146 my ($fh, $data) = @_; 194 my ($fh, $data) = @_;
147 195
148 if (length $data) { 196 if (length $data) {
… …
158 } else { 206 } else {
159 print $fh " \"\"\n"; 207 print $fh " \"\"\n";
160 } 208 }
161} 209}
162 210
163# required for @INC loading, unfortunately 211#############################################################################
164trace_module "PerlIO::scalar";
165 212
166#trace_module "Term::ReadLine::readline"; # Term::ReadLine::Perl dependency 213sub glob2re {
167# URI is difficult 214 for (quotemeta $_[0]) {
168#trace_module "URI::http"; 215 s/\\\*/\x00/g;
169#trace_module "URI::_generic"; 216 s/\x00\x00/.*/g;
217 s/\x00/[^\/]*/g;
218 s/\\\?/[^\/]/g;
219
220 $_ = s/^\\\/// ? "^$_\$" : "(?:^|/)$_\$";
221
222 s/(?: \[\^\/\] | \. ) \*\$$//x;
223
224 return qr<$_>s
225 }
226}
227
228our %INCSKIP = (
229 "unicore/TestProp.pl" => undef, # 3.5MB of insanity, apparently just some testcase
230);
231
232sub get_dirtree {
233 my $root = shift;
234
235 my @tree;
236 my $skip;
237
238 my $scan; $scan = sub {
239 for (sort do {
240 opendir my $fh, $_[0]
241 or return;
242 readdir $fh
243 }) {
244 next if /^\./;
245
246 my $path = "$_[0]/$_";
247
248 if (-d "$path/.") {
249 $scan->($path);
250 } else {
251 $path = substr $path, $skip;
252 push @tree, $path
253 unless exists $INCSKIP{$path};
254 }
255 }
256 };
257
258 $root =~ s/\/$//;
259 $skip = 1 + length $root;
260 $scan->($root);
261
262 \@tree
263}
264
265my $inctrees;
266
267sub get_inctrees {
268 unless ($inctrees) {
269 my %inctree;
270 $inctree{$_} ||= [$_, get_dirtree $_] # entries in @INC are often duplicates
271 for @INC;
272 $inctrees = [values %inctree];
273 }
274
275 @$inctrees
276}
277
278#############################################################################
170 279
171sub cmd_boot { 280sub cmd_boot {
172 $pm{"//boot"} = $_[0]; 281 $pm{"&&boot"} = $_[0];
173} 282}
174 283
175sub cmd_add { 284sub cmd_add {
176 $_[0] =~ /^(.*)(?:\s+(\S+))$/ 285 $_[0] =~ /^(.*?)(?:\s+(\S+))?$/
177 or die "$_[0]: cannot parse"; 286 or die "$_[0]: cannot parse";
178 287
179 my $file = $1; 288 my $file = $1;
180 my $as = defined $2 ? $2 : "/$1"; 289 my $as = defined $2 ? $2 : $1;
181 290
182 $pm{$as} = $file; 291 $pm{$as} = $file;
292 $pmbin{$as} = 1 if $_[1];
183} 293}
294
295sub cmd_staticlib {
296 push @staticlibs, $_
297 for split /\s+/, $_[0];
298}
299
300sub cmd_include {
301 push @incext, [$_[1], glob2re $_[0]];
302}
303
304sub cmd_incglob {
305 my ($pattern) = @_;
306
307 $pattern = glob2re $pattern;
308
309 for (get_inctrees) {
310 my ($dir, $files) = @$_;
311
312 $pm{$_} = "$dir/$_"
313 for grep /$pattern/ && /\.(pl|pm)$/, @$files;
314 }
315}
316
317sub parse_argv;
184 318
185sub cmd_file { 319sub cmd_file {
186 open my $fh, "<", $_[0] 320 open my $fh, "<", $_[0]
187 or die "$_[0]: $!\n"; 321 or die "$_[0]: $!\n";
188 322
323 local @ARGV;
324
189 while (<$fh>) { 325 while (<$fh>) {
190 chomp; 326 chomp;
327 next unless /\S/;
328 next if /^\s*#/;
329
330 s/^\s*-*/--/;
191 my ($cmd, $args) = split / /, $_, 2; 331 my ($cmd, $args) = split / /, $_, 2;
192 $cmd =~ s/^-+//;
193 332
194 if ($cmd eq "strip") { 333 push @ARGV, $cmd;
195 $STRIP = $args; 334 push @ARGV, $args if defined $args;
196 } elsif ($cmd eq "eval") { 335 }
197 trace_eval $_; 336
198 } elsif ($cmd eq "use") { 337 parse_argv;
199 trace_module $_ 338}
200 for split / /, $args; 339
201 } elsif ($cmd eq "boot") { 340use Getopt::Long;
202 cmd_boot $args; 341
203 } elsif ($cmd eq "static") { 342sub parse_argv {
204 $STATIC = 1; 343 GetOptions
205 } elsif ($cmd eq "add") { 344 "perl" => \$PERL,
206 cmd_add $args; 345 "app=s" => \$APP,
207 } elsif (/^\s*#/) { 346
208 # comment 347 "verbose|v" => sub { ++$VERBOSE },
209 } elsif (/\S/) { 348 "quiet|q" => sub { --$VERBOSE },
210 die "$_: unsupported directive\n"; 349
350 "strip=s" => \$STRIP,
351 "cache=s" => \$CACHE, # internal option
352 "eval|e=s" => sub { trace_eval $_[1] },
353 "use|M=s" => sub { trace_module $_[1] },
354 "boot=s" => sub { cmd_boot $_[1] },
355 "add=s" => sub { cmd_add $_[1], 0 },
356 "addbin=s" => sub { cmd_add $_[1], 1 },
357 "incglob=s" => sub { cmd_incglob $_[1] },
358 "include|i=s" => sub { cmd_include $_[1], 1 },
359 "exclude|x=s" => sub { cmd_include $_[1], 0 },
360 "usepacklists!" => \$PACKLIST,
361
362 "static!" => \$STATIC,
363 "staticlib=s" => sub { cmd_staticlib $_[1] },
364 "allow-dlls" => \$ALLOW_DLLS,
365 "ignore-env" => \$IGNORE_ENV,
366
367 "<>" => sub { cmd_file $_[0] },
368 or exit 1;
369}
370
371Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
372
373parse_argv;
374
375die "cannot specify both --app and --perl\n"
376 if $PERL and defined $APP;
377
378# required for @INC loading, unfortunately
379trace_module "PerlIO::scalar";
380
381#############################################################################
382# apply include/exclude
383
384{
385 my %pmi;
386
387 for (@incext) {
388 my ($inc, $glob) = @$_;
389
390 my @match = grep /$glob/, keys %pm;
391
392 if ($inc) {
393 # include
394 @pmi{@match} = delete @pm{@match};
395
396 print "applying include $glob - protected ", (scalar @match), " files.\n"
397 if $VERBOSE >= 5;
398 } else {
399 # exclude
400 delete @pm{@match};
401
402 print "applying exclude $glob - removed ", (scalar @match), " files.\n"
403 if $VERBOSE >= 5;
211 } 404 }
212 } 405 }
213}
214 406
215use Getopt::Long; 407 my @pmi = keys %pmi;
408 @pm{@pmi} = delete @pmi{@pmi};
409}
216 410
217Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); 411#############################################################################
412# scan for AutoLoader, static archives and other dependencies
218 413
219GetOptions 414sub scan_al {
220 "strip=s" => \$STRIP, 415 my ($auto, $autodir) = @_;
221 "verbose|v" => sub { ++$VERBOSE }, 416
222 "quiet|q" => sub { --$VERBOSE }, 417 my $ix = "$autodir/autosplit.ix";
223 "perl" => \$PERL, 418
224 "eval|e=s" => sub { trace_eval $_[1] }, 419 print "processing autoload index for '$auto'\n"
225 "use|M=s" => sub { trace_module $_[1] }, 420 if $VERBOSE >= 6;
226 "boot=s" => sub { cmd_boot $_[1] }, 421
227 "add=s" => sub { cmd_add $_[1] }, 422 $pm{"$auto/autosplit.ix"} = $ix;
228 "static" => sub { $STATIC = 1 }, 423
229 "<>" => sub { cmd_file $_[0] }, 424 open my $fh, "<:perlio", $ix
230 or exit 1; 425 or die "$ix: $!";
426
427 my $package;
428
429 while (<$fh>) {
430 if (/^\s*sub\s+ ([^[:space:];]+) \s* (?:\([^)]*\))? \s*;?\s*$/x) {
431 my $al = "auto/$package/$1.al";
432 my $inc = find_inc $al;
433
434 defined $inc or die "$al: autoload file not found, but should be there.\n";
435
436 $pm{$al} = $inc;
437 print "found autoload function '$al'\n"
438 if $VERBOSE >= 6;
439
440 } elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) {
441 ($package = $1) =~ s/::/\//g;
442 } elsif (/^\s*(?:#|1?\s*;?\s*$)/) {
443 # nop
444 } else {
445 warn "WARNING: $ix: unparsable line, please report: $_";
446 }
447 }
448}
449
450for my $pm (keys %pm) {
451 if ($pm =~ /^(.*)\.pm$/) {
452 my $auto = "auto/$1";
453 my $autodir = find_inc $auto;
454
455 if (defined $autodir && -d $autodir) {
456 # AutoLoader
457 scan_al $auto, $autodir
458 if -f "$autodir/autosplit.ix";
459
460 # extralibs.ld
461 if (open my $fh, "<:perlio", "$autodir/extralibs.ld") {
462 print "found extralibs for $pm\n"
463 if $VERBOSE >= 6;
464
465 local $/;
466 $extralibs .= " " . <$fh>;
467 }
468
469 $pm =~ /([^\/]+).pm$/ or die "$pm: unable to match last component";
470
471 my $base = $1;
472
473 # static ext
474 if (-f "$autodir/$base$Config{_a}") {
475 print "found static archive for $pm\n"
476 if $VERBOSE >= 3;
477
478 push @libs, "$autodir/$base$Config{_a}";
479 push @static_ext, $pm;
480 }
481
482 # dynamic object
483 if (-f "$autodir/$base.$Config{dlext}") {
484 if ($ALLOW_DLLS) {
485 my $as = "&fs/perl/$auto/$base.$Config{dlext}";
486 $pm{$as} = "$autodir/$base.$Config{dlext}";
487 $pmbin{$as} = 1;
488
489 $HAVE_DLLS = 1;
490
491 print "+ added dynamic object $auto/$base.$Config{dlext}\n"
492 if $VERBOSE >= 3;
493 } else {
494 die "ERROR: found shared object '$_' but --allow-dlls not given, aborting.\n"
495 }
496 }
497
498 if ($PACKLIST && open my $fh, "<:perlio", "$autodir/.packlist") {
499 print "found .packlist for $pm\n"
500 if $VERBOSE >= 3;
501
502 while (<$fh>) {
503 chomp;
504 s/ .*$//; # newer-style .packlists might contain key=value pairs
505
506 # only include certain files (.al, .ix, .pm, .pl)
507 if (/\.(pm|pl|al|ix)$/) {
508 for my $inc (@INC) {
509 # in addition, we only add files that are below some @INC path
510 $inc =~ s/\/*$/\//;
511
512 if ($inc eq substr $_, 0, length $inc) {
513 my $base = substr $_, length $inc;
514 $pm{$base} = $_;
515
516 print "+ added .packlist dependency $base\n"
517 if $VERBOSE >= 3;
518 }
519
520 last;
521 }
522 }
523 }
524 }
525 }
526 }
527}
528
529#############################################################################
530
531print "processing bundle files (try more -v power if you get bored waiting here)...\n"
532 if $VERBOSE >= 1;
231 533
232my $data; 534my $data;
233my @index; 535my @index;
234my @order = sort { 536my @order = sort {
235 length $a <=> length $b 537 length $a <=> length $b
… …
242 544
243for my $pm (@order) { 545for my $pm (@order) {
244 my $path = $pm{$pm}; 546 my $path = $pm{$pm};
245 547
246 128 > length $pm 548 128 > length $pm
247 or die "$pm: path too long (only 128 octets supported)\n"; 549 or die "ERROR: $pm: path too long (only 128 octets supported)\n";
248 550
249 my $src = ref $path 551 my $src = ref $path
250 ? $$path 552 ? $$path
251 : do { 553 : do {
252 open my $pm, "<:perlio", $path 554 open my $pm, "<", $path
253 or die "$path: $!"; 555 or die "$path: $!";
254 556
255 local $/; 557 local $/;
256 558
257 <$pm> 559 <$pm>
258 }; 560 };
259 561
562 my $size = length $src;
563
564 unless ($pmbin{$pm}) { # only do this unless the file is binary
260 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { 565 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) {
261 if ($src =~ /^ unimpl \"/m) { 566 if ($src =~ /^ unimpl \"/m) {
262 warn "$pm: skipping (not implemented anyways).\n" 567 print "$pm: skipping (raises runtime error only).\n"
263 if $VERBOSE >= 2; 568 if $VERBOSE >= 3;
264 next; 569 next;
570 }
265 } 571 }
266 }
267 572
268 if ($STRIP =~ /ppi/i) { 573 $src = cache +($STRIP eq "ppi" ? "$UNISTRIP,$OPTIMISE_SIZE" : undef), $src, sub {
269 require PPI; 574 if ($UNISTRIP && $pm =~ /^unicore\/.*\.pl$/) {
575 print "applying unicore stripping $pm\n"
576 if $VERBOSE >= 6;
270 577
271 my $ppi = PPI::Document->new (\$src); 578 # special stripping for unicore swashes and properties
272 $ppi->prune ("PPI::Token::Comment"); 579 # much more could be done by going binary
273 $ppi->prune ("PPI::Token::Pod"); 580 $src =~ s{
581 (^return\ <<'END';\n) (.*?\n) (END(?:\n|\Z))
582 }{
583 my ($pre, $data, $post) = ($1, $2, $3);
274 584
275 # prune END stuff 585 for ($data) {
276 for (my $last = $ppi->last_element; $last; ) { 586 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; 587 if $OPTIMISE_SIZE;
278 588
279 if ($last->isa (PPI::Token::Whitespace::)) { 589# s{
280 $last->delete; 590# ^([0-9a-fA-F]+)\t([0-9a-fA-F]*)\t
281 } elsif ($last->isa (PPI::Statement::End::)) { 591# }{
282 $last->delete; 592# # ww - smaller filesize, UU - compress better
593# pack "C0UU",
594# hex $1,
595# length $2 ? (hex $2) - (hex $1) : 0
596# }gemx;
597
598 s/#.*\n/\n/mg;
599 s/\s+\n/\n/mg;
600 }
601
602 "$pre$data$post"
283 last; 603 }smex;
284 } elsif ($last->isa (PPI::Token::Pod::)) {
285 $last->delete;
286 } else {
287 last;
288 } 604 }
289 605
606 if ($STRIP =~ /ppi/i) {
607 require PPI;
608
609 if (my $ppi = PPI::Document->new (\$src)) {
610 $ppi->prune ("PPI::Token::Comment");
611 $ppi->prune ("PPI::Token::Pod");
612
613 # prune END stuff
614 for (my $last = $ppi->last_element; $last; ) {
615 my $prev = $last->previous_token;
616
617 if ($last->isa (PPI::Token::Whitespace::)) {
618 $last->delete;
619 } elsif ($last->isa (PPI::Statement::End::)) {
620 $last->delete;
621 last;
622 } elsif ($last->isa (PPI::Token::Pod::)) {
623 $last->delete;
624 } else {
625 last;
626 }
627
290 $last = $prev; 628 $last = $prev;
291 } 629 }
292 630
293 # prune some but not all insignificant whitespace 631 # prune some but not all insignificant whitespace
294 for my $ws (@{ $ppi->find (PPI::Token::Whitespace::) }) { 632 for my $ws (@{ $ppi->find (PPI::Token::Whitespace::) }) {
295 my $prev = $ws->previous_token; 633 my $prev = $ws->previous_token;
296 my $next = $ws->next_token; 634 my $next = $ws->next_token;
297 635
298 if (!$prev || !$next) { 636 if (!$prev || !$next) {
299 $ws->delete; 637 $ws->delete;
300 } else { 638 } else {
301 if ( 639 if (
302 $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float 640 $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float
303 or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/ 641 or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/
304 or $prev->isa (PPI::Token::Structure::) 642 or $prev->isa (PPI::Token::Structure::)
305 # decrease size, decrease compressability 643 or ($OPTIMISE_SIZE &&
306 #or ($prev->isa (PPI::Token::Word::) 644 ($prev->isa (PPI::Token::Word::)
307 # && (PPI::Token::Symbol:: eq ref $next 645 && (PPI::Token::Symbol:: eq ref $next
308 # || $next->isa (PPI::Structure::Block::) 646 || $next->isa (PPI::Structure::Block::)
309 # || $next->isa (PPI::Structure::List::) 647 || $next->isa (PPI::Structure::List::)
310 # || $next->isa (PPI::Structure::Condition::))) 648 || $next->isa (PPI::Structure::Condition::)))
649 )
311 ) { 650 ) {
312 $ws->delete; 651 $ws->delete;
313 } elsif ($prev->isa (PPI::Token::Whitespace::)) { 652 } elsif ($prev->isa (PPI::Token::Whitespace::)) {
314 $ws->{content} = ' '; 653 $ws->{content} = ' ';
315 $prev->delete; 654 $prev->delete;
655 } else {
656 $ws->{content} = ' ';
657 }
658 }
659 }
660
661 # prune whitespace around blocks
662 if ($OPTIMISE_SIZE) {
663 # these usually decrease size, but decrease compressability more
664 for my $struct (PPI::Structure::Block::, PPI::Structure::Condition::) {
665 for my $node (@{ $ppi->find ($struct) }) {
666 my $n1 = $node->first_token;
667 my $n2 = $n1->previous_token;
668 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
669 $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
670 my $n1 = $node->last_token;
671 my $n2 = $n1->next_token;
672 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
673 $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
674 }
675 }
676
677 for my $node (@{ $ppi->find (PPI::Structure::List::) }) {
678 my $n1 = $node->first_token;
679 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
680 my $n1 = $node->last_token;
681 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
682 }
683 }
684
685 # reformat qw() lists which often have lots of whitespace
686 for my $node (@{ $ppi->find (PPI::Token::QuoteLike::Words::) }) {
687 if ($node->{content} =~ /^qw(.)(.*)(.)$/s) {
688 my ($a, $qw, $b) = ($1, $2, $3);
689 $qw =~ s/^\s+//;
690 $qw =~ s/\s+$//;
691 $qw =~ s/\s+/ /g;
692 $node->{content} = "qw$a$qw$b";
693 }
694 }
695
696 $src = $ppi->serialize;
316 } else { 697 } else {
317 $ws->{content} = ' '; 698 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n";
699 }
700 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses its own pod
701 require Pod::Strip;
702
703 my $stripper = Pod::Strip->new;
704
705 my $out;
706 $stripper->output_string (\$out);
707 $stripper->parse_string_document ($src)
708 or die;
709 $src = $out;
710 }
711
712 if ($VERIFY && $pm =~ /\.pm$/ && $pm ne "Opcode.pm") {
713 if (open my $fh, "-|") {
714 <$fh>;
715 } else {
716 eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n";
717 exit 0;
318 } 718 }
319 } 719 }
720
721 $src
320 } 722 };
321 723
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") { 724# if ($pm eq "Opcode.pm") {
379# open my $fh, ">x" or die; print $fh $src;#d# 725# open my $fh, ">x" or die; print $fh $src;#d#
380# exit 1; 726# exit 1;
727# }
381# } 728 }
382 729
383 warn "adding $pm\n" 730 print "adding $pm (original size $size, stored size ", length $src, ")\n"
384 if $VERBOSE >= 2; 731 if $VERBOSE >= 2;
385 732
386 push @index, ((length $pm) << 25) | length $data; 733 push @index, ((length $pm) << 25) | length $data;
387 $data .= $pm . $src; 734 $data .= $pm . $src;
388} 735}
389 736
390length $data < 2**25 737length $data < 2**25
391 or die "bundle too large (only 32MB supported)\n"; 738 or die "ERROR: bundle too large (only 32MB supported)\n";
392 739
393my $varpfx = "bundle_" . substr +(Digest::MD5::md5_hex $data), 0, 16; 740my $varpfx = "bundle";
394 741
395############################################################################# 742#############################################################################
396# output 743# output
397 744
398print "generating $PREFIX.h... "; 745print "generating $PREFIX.h... "
746 if $VERBOSE >= 1;
399 747
400{ 748{
401 open my $fh, ">", "$PREFIX.h" 749 open my $fh, ">", "$PREFIX.h"
402 or die "$PREFIX.h: $!\n"; 750 or die "$PREFIX.h: $!\n";
403 751
404 print $fh <<EOF; 752 print $fh <<EOF;
405/* do not edit, automatically created by mkstaticbundle */ 753/* do not edit, automatically created by staticperl */
754
406#include <EXTERN.h> 755#include <EXTERN.h>
407#include <perl.h> 756#include <perl.h>
408#include <XSUB.h> 757#include <XSUB.h>
409 758
410/* public API */ 759/* public API */
411EXTERN_C PerlInterpreter *staticperl; 760EXTERN_C PerlInterpreter *staticperl;
412EXTERN_C void staticperl_init (void); 761EXTERN_C void staticperl_xs_init (pTHX);
762EXTERN_C void staticperl_init (XSINIT_t xs_init); /* argument can be 0 */
413EXTERN_C void staticperl_cleanup (void); 763EXTERN_C void staticperl_cleanup (void);
764
414EOF 765EOF
415} 766}
416 767
417print "\n"; 768print "\n"
769 if $VERBOSE >= 1;
418 770
419############################################################################# 771#############################################################################
420# output 772# output
421 773
422print "generating $PREFIX.c... "; 774print "generating $PREFIX.c... "
775 if $VERBOSE >= 1;
423 776
424open my $fh, ">", "$PREFIX.c" 777open my $fh, ">", "$PREFIX.c"
425 or die "$PREFIX.c: $!\n"; 778 or die "$PREFIX.c: $!\n";
426 779
427print $fh <<EOF; 780print $fh <<EOF;
428/* do not edit, automatically created by mkstaticbundle */ 781/* do not edit, automatically created by staticperl */
429
430#include <EXTERN.h>
431#include <perl.h>
432#include <XSUB.h>
433 782
434#include "bundle.h" 783#include "bundle.h"
435 784
436/* public API */ 785/* public API */
437PerlInterpreter *staticperl; 786PerlInterpreter *staticperl;
… …
461printf $fh "0x%08x\n};\n", (length $data); 810printf $fh "0x%08x\n};\n", (length $data);
462 811
463print $fh "static const char $varpfx\_data [] =\n"; 812print $fh "static const char $varpfx\_data [] =\n";
464dump_string $fh, $data; 813dump_string $fh, $data;
465 814
466print $fh ";\n\n";; 815print $fh ";\n\n";
467 816
468############################################################################# 817#############################################################################
469# bootstrap 818# bootstrap
470 819
471# boot file for staticperl 820# boot file for staticperl
472# this file will be eval'ed at initialisation time 821# this file will be eval'ed at initialisation time
473 822
823# lines marked with "^D" are only used when $HAVE_DLLS
474my $bootstrap = ' 824my $bootstrap = '
475BEGIN { 825BEGIN {
476 package ' . $PACKAGE . '; 826 package ' . $PACKAGE . ';
477 827
478 PerlIO::scalar->bootstrap; 828 # the path prefix to use when putting files into %INC
829 our $inc_prefix;
479 830
480 @INC = sub { 831 # the @INC hook to use when we have PerlIO::scalar available
832 my $perlio_inc = sub {
481 my $data = find "$_[1]" 833 my $data = find "$_[1]"
482 or return; 834 or return;
483 835
484 $INC{$_[1]} = $_[1]; 836 $INC{$_[1]} = "$inc_prefix$_[1]";
485 837
486 open my $fh, "<", \$data; 838 open my $fh, "<", \$data;
487 $fh 839 $fh
488 }; 840 };
841
842D if (defined &PerlIO::scalar::bootstrap) {
843 # PerlIO::scalar statically compiled in
844 PerlIO::scalar->bootstrap;
845 @INC = $perlio_inc;
846D } else {
847D # PerlIO::scalar not available, use slower method
848D @INC = sub {
849D # always check if PerlIO::scalar might now be available
850D if (defined &PerlIO::scalar::bootstrap) {
851D # switch to the faster perlio_inc hook
852D @INC = map { $_ == $_[0] ? $perlio_inc : $_ } @INC;
853D goto &$perlio_inc;
854D }
855D
856D my $data = find "$_[1]"
857D or return;
858D
859D $INC{$_[1]} = "$inc_prefix$_[1]";
860D
861D sub {
862D $data =~ /\G([^\n]*\n?)/g
863D or return;
864D
865D $_ = $1;
866D 1
867D }
868D };
869D }
489} 870}
490'; 871';
491 872
492$bootstrap .= "require '//boot';" 873$bootstrap .= "require '&&boot';"
493 if exists $pm{"//boot"}; 874 if exists $pm{"&&boot"};
494 875
876if ($HAVE_DLLS) {
877 $bootstrap =~ s/^D/ /mg;
878} else {
879 $bootstrap =~ s/^D.*$//mg;
880}
881
882$bootstrap =~ s/#.*$//mg;
495$bootstrap =~ s/\s+/ /g; 883$bootstrap =~ s/\s+/ /g;
496$bootstrap =~ s/(\W) /$1/g; 884$bootstrap =~ s/(\W) /$1/g;
497$bootstrap =~ s/ (\W)/$1/g; 885$bootstrap =~ s/ (\W)/$1/g;
498 886
499print $fh "const char bootstrap [] = "; 887print $fh "const char bootstrap [] = ";
… …
545 } 933 }
546 934
547 XSRETURN (0); 935 XSRETURN (0);
548 936
549 found: 937 found:
550 ST (0) = res; 938 ST (0) = sv_2mortal (res);
551 sv_2mortal (ST (0));
552 } 939 }
553 940
554 XSRETURN (1); 941 XSRETURN (1);
555} 942}
556 943
… …
569 956
570 for (i = 0; i < $varpfx\_count; ++i) 957 for (i = 0; i < $varpfx\_count; ++i)
571 { 958 {
572 U32 idx = $varpfx\_index [i]; 959 U32 idx = $varpfx\_index [i];
573 960
574 PUSHs (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25)); 961 PUSHs (sv_2mortal (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25)));
575 } 962 }
576 } 963 }
577 964
578 XSRETURN ($varpfx\_count); 965 XSRETURN ($varpfx\_count);
579} 966}
580 967
581static char *args[] = {
582 "staticperl",
583 "-e",
584 "0"
585};
586
587EOF 968EOF
588 969
589############################################################################# 970#############################################################################
590# xs_init 971# xs_init
591 972
592print $fh <<EOF; 973print $fh <<EOF;
593static void 974void
594xs_init (pTHX) 975staticperl_xs_init (pTHX)
595{ 976{
596EOF 977EOF
597 978
598@static_ext = ("DynaLoader", sort @static_ext); 979@static_ext = sort @static_ext;
599 980
600# prototypes 981# prototypes
601for (@static_ext) { 982for (@static_ext) {
602 s/\.pm$//; 983 s/\.pm$//;
603 (my $cname = $_) =~ s/\//__/g; 984 (my $cname = $_) =~ s/\//__/g;
… …
617 s/\.pm$//; 998 s/\.pm$//;
618 999
619 (my $cname = $_) =~ s/\//__/g; 1000 (my $cname = $_) =~ s/\//__/g;
620 (my $pname = $_) =~ s/\//::/g; 1001 (my $pname = $_) =~ s/\//::/g;
621 1002
622 my $bootstrap = $pname eq "DynaLoader" ? "boot" : "bootstrap"; 1003 my $bootstrap = $pname eq "DynaLoader" ? "boot_DynaLoader" : "bootstrap";
623 1004
624 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n"; 1005 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n";
625} 1006}
626 1007
627print $fh <<EOF; 1008print $fh <<EOF;
628 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1)); 1009 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1));
1010
1011 if (PL_oldname)
1012 ((XSINIT_t)PL_oldname)(aTHX);
629} 1013}
630EOF 1014EOF
631 1015
632############################################################################# 1016#############################################################################
633# optional perl_init/perl_destroy 1017# optional perl_init/perl_destroy
634 1018
1019if ($IGNORE_ENV) {
1020 $IGNORE_ENV = <<EOF;
1021 unsetenv ("PERL_UNICODE");
1022 unsetenv ("PERL_HASH_SEED_DEBUG");
1023 unsetenv ("PERL_DESTRUCT_LEVEL");
1024 unsetenv ("PERL_SIGNALS");
1025 unsetenv ("PERL_DEBUG_MSTATS");
1026 unsetenv ("PERL5OPT");
1027 unsetenv ("PERLIO_DEBUG");
1028 unsetenv ("PERLIO");
1029 unsetenv ("PERL_HASH_SEED");
1030EOF
1031} else {
1032 $IGNORE_ENV = "";
1033}
1034
1035if ($APP) {
1036 print $fh <<EOF;
1037
1038int
1039main (int argc, char *argv [])
1040{
1041 extern char **environ;
1042 int i, exitstatus;
1043 char **args = malloc ((argc + 3) * sizeof (const char *));
1044
1045 args [0] = argv [0];
1046 args [1] = "-e";
1047 args [2] = "0";
1048 args [3] = "--";
1049
1050 for (i = 1; i < argc; ++i)
1051 args [i + 3] = argv [i];
1052
1053$IGNORE_ENV
1054 PERL_SYS_INIT3 (&argc, &argv, &environ);
1055 staticperl = perl_alloc ();
1056 perl_construct (staticperl);
1057
1058 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1059
1060 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc + 3, args, environ);
1061 free (args);
1062 if (!exitstatus)
1063 perl_run (staticperl);
1064
1065 exitstatus = perl_destruct (staticperl);
1066 perl_free (staticperl);
1067 PERL_SYS_TERM ();
1068
1069 return exitstatus;
1070}
1071EOF
635if ($PERL) { 1072} elsif ($PERL) {
636 print $fh <<EOF; 1073 print $fh <<EOF;
637 1074
638int 1075int
639main (int argc, char *argv []) 1076main (int argc, char *argv [])
640{ 1077{
641 extern char **environ; 1078 extern char **environ;
642 int exitstatus; 1079 int exitstatus;
643 1080
1081$IGNORE_ENV
644 PERL_SYS_INIT3 (&argc, &argv, &environ); 1082 PERL_SYS_INIT3 (&argc, &argv, &environ);
645 staticperl = perl_alloc (); 1083 staticperl = perl_alloc ();
646 perl_construct (staticperl); 1084 perl_construct (staticperl);
647 1085
648 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1086 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
649 1087
650 exitstatus = perl_parse (staticperl, xs_init, argc, argv, environ); 1088 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
651 if (!exitstatus) 1089 if (!exitstatus)
652 perl_run (staticperl); 1090 perl_run (staticperl);
653 1091
654 exitstatus = perl_destruct (staticperl); 1092 exitstatus = perl_destruct (staticperl);
655 perl_free (staticperl); 1093 perl_free (staticperl);
… …
660EOF 1098EOF
661} else { 1099} else {
662 print $fh <<EOF; 1100 print $fh <<EOF;
663 1101
664EXTERN_C void 1102EXTERN_C void
665staticperl_init (void) 1103staticperl_init (XSINIT_t xs_init)
666{ 1104{
1105 static char *args[] = {
1106 "staticperl",
1107 "-e",
1108 "0"
1109 };
1110
667 extern char **environ; 1111 extern char **environ;
668 int argc = sizeof (args) / sizeof (args [0]); 1112 int argc = sizeof (args) / sizeof (args [0]);
669 char **argv = args; 1113 char **argv = args;
670 1114
1115$IGNORE_ENV
671 PERL_SYS_INIT3 (&argc, &argv, &environ); 1116 PERL_SYS_INIT3 (&argc, &argv, &environ);
672 staticperl = perl_alloc (); 1117 staticperl = perl_alloc ();
673 perl_construct (staticperl); 1118 perl_construct (staticperl);
674 PL_origalen = 1; 1119 PL_origalen = 1;
675 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1120 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1121 PL_oldname = (char *)xs_init;
676 perl_parse (staticperl, xs_init, argc, argv, environ); 1122 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
677 1123
678 perl_run (staticperl); 1124 perl_run (staticperl);
679} 1125}
680 1126
681EXTERN_C void 1127EXTERN_C void
… …
687 PERL_SYS_TERM (); 1133 PERL_SYS_TERM ();
688} 1134}
689EOF 1135EOF
690} 1136}
691 1137
692print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n"; 1138print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n"
1139 if $VERBOSE >= 1;
693 1140
694############################################################################# 1141#############################################################################
695# libs, cflags 1142# libs, cflags
696 1143
697{ 1144{
698 print "generating $PREFIX.ccopts... "; 1145 print "generating $PREFIX.ccopts... "
1146 if $VERBOSE >= 1;
699 1147
700 my $str = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE"; 1148 my $str = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE";
701 $str =~ s/([\(\)])/\\$1/g; 1149 $str =~ s/([\(\)])/\\$1/g;
702
703 print "$str\n\n";
704 1150
705 open my $fh, ">$PREFIX.ccopts" 1151 open my $fh, ">$PREFIX.ccopts"
706 or die "$PREFIX.ccopts: $!"; 1152 or die "$PREFIX.ccopts: $!";
707 print $fh $str; 1153 print $fh $str;
1154
1155 print "$str\n\n"
1156 if $VERBOSE >= 1;
708} 1157}
709 1158
710{ 1159{
711 print "generating $PREFIX.ldopts... "; 1160 print "generating $PREFIX.ldopts... ";
712 1161
713 my $str = $STATIC ? "--static " : ""; 1162 my $str = $STATIC ? "-static " : "";
714 1163
715 $str .= "$Config{ccdlflags} $Config{ldflags} @libs $Config{archlibexp}/CORE/$Config{libperl} $Config{perllibs}"; 1164 $str .= "$Config{ccdlflags} $Config{ldflags} @libs $Config{archlibexp}/CORE/$Config{libperl} $Config{perllibs}";
716 1165
717 my %seen; 1166 my %seen;
718 $str .= " $_" for grep !$seen{$_}++, ($extralibs =~ /(\S+)/g); 1167 $str .= " $_" for grep !$seen{$_}++, ($extralibs =~ /(\S+)/g);
719 1168
1169 for (@staticlibs) {
1170 $str =~ s/(^|\s) (-l\Q$_\E) ($|\s)/$1-Wl,-Bstatic $2 -Wl,-Bdynamic$3/gx;
1171 }
1172
720 $str =~ s/([\(\)])/\\$1/g; 1173 $str =~ s/([\(\)])/\\$1/g;
721
722 print "$str\n\n";
723 1174
724 open my $fh, ">$PREFIX.ldopts" 1175 open my $fh, ">$PREFIX.ldopts"
725 or die "$PREFIX.ldopts: $!"; 1176 or die "$PREFIX.ldopts: $!";
726 print $fh $str; 1177 print $fh $str;
727}
728 1178
729if ($PERL) { 1179 print "$str\n\n"
1180 if $VERBOSE >= 1;
1181}
1182
1183if ($PERL or defined $APP) {
1184 $APP = "perl" unless defined $APP;
1185
1186 print "building $APP...\n"
1187 if $VERBOSE >= 1;
1188
730 system "$Config{cc} \$(cat bundle.ccopts\) -o perl bundle.c \$(cat bundle.ldopts\)"; 1189 system "$Config{cc} \$(cat bundle.ccopts\) -o \Q$APP\E bundle.c \$(cat bundle.ldopts\)";
731 1190
732 unlink "$PREFIX.$_" 1191 unlink "$PREFIX.$_"
733 for qw(ccopts ldopts c h); 1192 for qw(ccopts ldopts c h);
734}
735 1193
1194 print "\n"
1195 if $VERBOSE >= 1;
1196}
1197

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines