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

Comparing App-Staticperl/mkbundle (file contents):
Revision 1.11 by root, Fri Dec 10 02:35:54 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 $UNISTRIP = 1; # always on, try to strip unicore swash data
9our $PERL = 0; 9our $PERL = 0;
10our $APP; 10our $APP;
11our $VERIFY = 0; 11our $VERIFY = 0;
12our $STATIC = 0; 12our $STATIC = 0;
13our $PACKLIST = 0;
14our $IGNORE_ENV = 0;
15our $ALLOW_DYNAMIC = 0;
16our $HAVE_DYNAMIC; # maybe useful?
13 17
14our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression? 18our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression?
15 19
16our $CACHE; 20our $CACHE;
17our $CACHEVER = 1; # do not change unless you know what you are doing 21our $CACHEVER = 1; # do not change unless you know what you are doing
… …
35 39
36$|=1; 40$|=1;
37 41
38our ($TRACER_W, $TRACER_R); 42our ($TRACER_W, $TRACER_R);
39 43
40sub find_inc($) { 44sub find_incdir($) {
41 for (@INC) { 45 for (@INC) {
42 next if ref; 46 next if ref;
43 return $_ if -e "$_/$_[0]"; 47 return $_ if -e "$_/$_[0]";
44 } 48 }
45 49
46 undef 50 undef
47} 51}
48 52
53sub find_inc($) {
54 my $dir = find_incdir $_[0];
55
56 return "$dir/$_[0]"
57 if defined $dir;
58
59 undef
60}
61
49BEGIN { 62BEGIN {
50 # 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
51 my ($W_TRACER, $R_TRACER); # used by tracer 64 my ($W_TRACER, $R_TRACER); # used by tracer
52 65
53 pipe $R_TRACER, $TRACER_W or die "pipe: $!"; 66 pipe $R_TRACER, $TRACER_W or die "pipe: $!";
… …
55 68
56 unless (fork) { 69 unless (fork) {
57 close $TRACER_R; 70 close $TRACER_R;
58 close $TRACER_W; 71 close $TRACER_W;
59 72
73 my $pkg = "pkg000000";
74
60 unshift @INC, sub { 75 unshift @INC, sub {
61 my $dir = find_inc $_[1] 76 my $dir = find_incdir $_[1]
62 or return; 77 or return;
63 78
64 syswrite $W_TRACER, "-\n$dir\n$_[1]\n"; 79 syswrite $W_TRACER, "-\n$dir\n$_[1]\n";
65 80
66 open my $fh, "<:perlio", "$dir/$_[1]" 81 open my $fh, "<:raw:perlio", "$dir/$_[1]"
67 or warn "ERROR: $dir/$_[1]: $!\n"; 82 or warn "ERROR: $dir/$_[1]: $!\n";
68 83
69 $fh 84 $fh
70 }; 85 };
71 86
72 while (<$R_TRACER>) { 87 while (<$R_TRACER>) {
73 if (/use (.*)$/) { 88 if (/use (.*)$/) {
74 my $mod = $1; 89 my $mod = $1;
90 my $eval;
91
92 if ($mod =~ /^'.*'$/ or $mod =~ /^".*"$/) {
75 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;
76 warn "ERROR: $@ (while loading '$mod')\n" 102 warn "ERROR: $@ (while loading '$mod')\n"
77 if $@; 103 if $@;
78 syswrite $W_TRACER, "\n";
79 } elsif (/eval (.*)$/) { 104 } elsif (/eval (.*)$/) {
80 my $eval = $1; 105 my $eval = $1;
81 eval $eval; 106 eval $eval;
82 warn "ERROR: $@ (in '$eval')\n" 107 warn "ERROR: $@ (in '$eval')\n"
83 if $@; 108 if $@;
84 } 109 }
110
111 syswrite $W_TRACER, "\n";
85 } 112 }
86 113
87 exit 0; 114 exit 0;
88 } 115 }
89} 116}
90 117
91# module loading is now safe 118# module loading is now safe
92 119
93sub trace_module { 120sub trace_parse {
94 syswrite $TRACER_W, "use $_[0]\n";
95
96 for (;;) { 121 for (;;) {
97 <$TRACER_R> =~ /^-$/ or last; 122 <$TRACER_R> =~ /^-$/ or last;
98 my $dir = <$TRACER_R>; chomp $dir; 123 my $dir = <$TRACER_R>; chomp $dir;
99 my $name = <$TRACER_R>; chomp $name; 124 my $name = <$TRACER_R>; chomp $name;
100 125
101 $pm{$name} = "$dir/$name"; 126 $pm{$name} = "$dir/$name";
127
128 print "+ found potential dependency $name\n"
129 if $VERBOSE >= 3;
102 } 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;
103} 139}
104 140
105sub trace_eval { 141sub trace_eval {
142 print "tracing eval $_[0]\n"
143 if $VERBOSE >= 2;
144
106 syswrite $TRACER_W, "eval $_[0]\n"; 145 syswrite $TRACER_W, "eval $_[0]\n";
146 trace_parse;
107} 147}
108 148
109sub trace_finish { 149sub trace_finish {
110 close $TRACER_W; 150 close $TRACER_W;
111 close $TRACER_R; 151 close $TRACER_R;
… …
119use Digest::MD5; 159use Digest::MD5;
120 160
121sub cache($$$) { 161sub cache($$$) {
122 my ($variant, $src, $filter) = @_; 162 my ($variant, $src, $filter) = @_;
123 163
124 if (length $CACHE and 2048 <= length $src) { 164 if (length $CACHE and 2048 <= length $src and defined $variant) {
125 my $file = "$CACHE/" . Digest::MD5::md5_hex "$CACHEVER\x00$variant\x00$src"; 165 my $file = "$CACHE/" . Digest::MD5::md5_hex "$CACHEVER\x00$variant\x00$src";
126 166
127 if (open my $fh, "<:perlio", $file) { 167 if (open my $fh, "<:raw:perlio", $file) {
168 print "using cache for $file\n"
169 if $VERBOSE >= 7;
170
128 local $/; 171 local $/;
129 return <$fh>; 172 return <$fh>;
130 } 173 }
131 174
132 $src = $filter->($src); 175 $src = $filter->($src);
133 176
177 print "creating cache entry $file\n"
178 if $VERBOSE >= 8;
179
134 if (open my $fh, ">:perlio", "$file~") { 180 if (open my $fh, ">:raw:perlio", "$file~") {
135 if ((syswrite $fh, $src) == length $src) { 181 if ((syswrite $fh, $src) == length $src) {
136 close $fh; 182 close $fh;
137 rename "$file~", $file; 183 rename "$file~", $file;
138 } 184 }
139 } 185 }
… …
146 192
147sub dump_string { 193sub dump_string {
148 my ($fh, $data) = @_; 194 my ($fh, $data) = @_;
149 195
150 if (length $data) { 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";
151 for ( 200 for (
152 my $ofs = 0; 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;
153 length (my $substr = substr $data, $ofs, 80); 212 length (my $substr = substr $data, $ofs, 80);
154 $ofs += 80 213 $ofs += 80
155 ) { 214 ) {
156 $substr =~ s/([^\x20-\x21\x23-\x5b\x5d-\x7e])/sprintf "\\%03o", ord $1/ge; 215 $substr =~ s/([^\x20-\x21\x23-\x5b\x5d-\x7e])/sprintf "\\%03o", ord $1/ge;
157 $substr =~ s/\?/\\?/g; # trigraphs... 216 $substr =~ s/\?/\\?/g; # trigraphs...
158 print $fh " \"$substr\"\n"; 217 print $fh " \"$substr\"\n";
218 }
159 } 219 }
160 } else { 220 } else {
161 print $fh " \"\"\n"; 221 print $fh " \"\"\n";
162 } 222 }
163} 223}
… …
200 my $path = "$_[0]/$_"; 260 my $path = "$_[0]/$_";
201 261
202 if (-d "$path/.") { 262 if (-d "$path/.") {
203 $scan->($path); 263 $scan->($path);
204 } else { 264 } else {
205 next unless /\.(?:pm|pl)$/;
206
207 $path = substr $path, $skip; 265 $path = substr $path, $skip;
208 push @tree, $path 266 push @tree, $path
209 unless exists $INCSKIP{$path}; 267 unless exists $INCSKIP{$path};
210 } 268 }
211 } 269 }
… …
232} 290}
233 291
234############################################################################# 292#############################################################################
235 293
236sub cmd_boot { 294sub cmd_boot {
237 $pm{"//boot"} = $_[0]; 295 $pm{"!boot"} = $_[0];
238} 296}
239 297
240sub cmd_add { 298sub cmd_add {
241 $_[0] =~ /^(.*)(?:\s+(\S+))$/ 299 $_[0] =~ /^(.*?)(?:\s+(\S+))?$/
242 or die "$_[0]: cannot parse"; 300 or die "$_[0]: cannot parse";
243 301
244 my $file = $1; 302 my $file = $1;
245 my $as = defined $2 ? $2 : "/$1"; 303 my $as = defined $2 ? $2 : $1;
246 304
247 $pm{$as} = $file; 305 $pm{$as} = $file;
248 $pmbin{$as} = 1 if $_[1]; 306 $pmbin{$as} = 1 if $_[1];
249} 307}
250 308
… …
264 322
265 for (get_inctrees) { 323 for (get_inctrees) {
266 my ($dir, $files) = @$_; 324 my ($dir, $files) = @$_;
267 325
268 $pm{$_} = "$dir/$_" 326 $pm{$_} = "$dir/$_"
269 for grep /$pattern/, @$files; 327 for grep /$pattern/ && /\.(pl|pm)$/, @$files;
270 } 328 }
271} 329}
330
331sub parse_argv;
272 332
273sub cmd_file { 333sub cmd_file {
274 open my $fh, "<", $_[0] 334 open my $fh, "<", $_[0]
275 or die "$_[0]: $!\n"; 335 or die "$_[0]: $!\n";
276 336
337 local @ARGV;
338
277 while (<$fh>) { 339 while (<$fh>) {
278 chomp; 340 chomp;
341 next unless /\S/;
342 next if /^\s*#/;
343
344 s/^\s*-*/--/;
279 my ($cmd, $args) = split / /, $_, 2; 345 my ($cmd, $args) = split / /, $_, 2;
280 $cmd =~ s/^-+//;
281 346
282 if ($cmd eq "strip") { 347 push @ARGV, $cmd;
283 $STRIP = $args; 348 push @ARGV, $args if defined $args;
284 } elsif ($cmd eq "perl") {
285 $PERL = 1;
286 } elsif ($cmd eq "app") {
287 $APP = $args;
288 } elsif ($cmd eq "eval") {
289 trace_eval $_;
290 } elsif ($cmd eq "use") {
291 trace_module $_
292 for split / /, $args;
293 } elsif ($cmd eq "staticlib") {
294 cmd_staticlib $args;
295 } elsif ($cmd eq "boot") {
296 cmd_boot $args;
297 } elsif ($cmd eq "static") {
298 $STATIC = 1;
299 } elsif ($cmd eq "add") {
300 cmd_add $args, 0;
301 } elsif ($cmd eq "addbin") {
302 cmd_add $args, 1;
303 } elsif ($cmd eq "incglob") {
304 cmd_incglob $args;
305 } elsif ($cmd eq "include") {
306 cmd_include $args, 1;
307 } elsif ($cmd eq "exclude") {
308 cmd_include $args, 0;
309 } elsif (/^\s*#/) {
310 # comment
311 } elsif (/\S/) {
312 die "$_: unsupported directive\n";
313 }
314 } 349 }
350
351 parse_argv;
315} 352}
316 353
317use Getopt::Long; 354use Getopt::Long;
318 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
319Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); 385Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
320 386
321GetOptions 387parse_argv;
322 "strip=s" => \$STRIP,
323 "cache=s" => \$CACHE, # internal option
324 "verbose|v" => sub { ++$VERBOSE },
325 "quiet|q" => sub { --$VERBOSE },
326 "perl" => \$PERL,
327 "app=s" => \$APP,
328 "eval|e=s" => sub { trace_eval $_[1] },
329 "use|M=s" => sub { trace_module $_[1] },
330 "boot=s" => sub { cmd_boot $_[1] },
331 "add=s" => sub { cmd_add $_[1], 0 },
332 "addbin=s" => sub { cmd_add $_[1], 1 },
333 "incglob=s" => sub { cmd_incglob $_[1] },
334 "include|i=s" => sub { cmd_include $_[1], 1 },
335 "exclude|x=s" => sub { cmd_include $_[1], 0 },
336 "static" => sub { $STATIC = 1 },
337 "staticlib=s" => sub { cmd_staticlib $_[1] },
338 "<>" => sub { cmd_file $_[0] },
339 or exit 1;
340 388
341die "cannot specify both --app and --perl\n" 389die "cannot specify both --app and --perl\n"
342 if $PERL and defined $APP; 390 if $PERL and defined $APP;
343 391
344# required for @INC loading, unfortunately 392# required for @INC loading, unfortunately
345trace_module "PerlIO::scalar"; 393trace_module "PerlIO::scalar";
346 394
347############################################################################# 395#############################################################################
348# include/exclude apply 396# apply include/exclude
349 397
350{ 398{
351 my %pmi; 399 my %pmi;
352 400
353 for (@incext) { 401 for (@incext) {
… …
356 my @match = grep /$glob/, keys %pm; 404 my @match = grep /$glob/, keys %pm;
357 405
358 if ($inc) { 406 if ($inc) {
359 # include 407 # include
360 @pmi{@match} = delete @pm{@match}; 408 @pmi{@match} = delete @pm{@match};
409
410 print "applying include $glob - protected ", (scalar @match), " files.\n"
411 if $VERBOSE >= 5;
361 } else { 412 } else {
362 # exclude 413 # exclude
363 delete @pm{@match}; 414 delete @pm{@match};
415
416 print "applying exclude $glob - removed ", (scalar @match), " files.\n"
417 if $VERBOSE >= 5;
364 } 418 }
365 } 419 }
366 420
367 my @pmi = keys %pmi; 421 my @pmi = keys %pmi;
368 @pm{@pmi} = delete @pmi{@pmi}; 422 @pm{@pmi} = delete @pmi{@pmi};
369} 423}
370 424
371############################################################################# 425#############################################################################
372# scan for AutoLoader and static archives 426# scan for AutoLoader, static archives and other dependencies
373 427
374sub scan_al { 428sub scan_al {
375 my ($auto, $autodir) = @_; 429 my ($auto, $autodir) = @_;
376 430
377 my $ix = "$autodir/autosplit.ix"; 431 my $ix = "$autodir/autosplit.ix";
432
433 print "processing autoload index for '$auto'\n"
434 if $VERBOSE >= 6;
378 435
379 $pm{"$auto/autosplit.ix"} = $ix; 436 $pm{"$auto/autosplit.ix"} = $ix;
380 437
381 open my $fh, "<:perlio", $ix 438 open my $fh, "<:perlio", $ix
382 or die "$ix: $!"; 439 or die "$ix: $!";
… …
388 my $al = "auto/$package/$1.al"; 445 my $al = "auto/$package/$1.al";
389 my $inc = find_inc $al; 446 my $inc = find_inc $al;
390 447
391 defined $inc or die "$al: autoload file not found, but should be there.\n"; 448 defined $inc or die "$al: autoload file not found, but should be there.\n";
392 449
393 $pm{$al} = "$inc/$al"; 450 $pm{$al} = $inc;
451 print "found autoload function '$al'\n"
452 if $VERBOSE >= 6;
394 453
395 } elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) { 454 } elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) {
396 ($package = $1) =~ s/::/\//g; 455 ($package = $1) =~ s/::/\//g;
397 } elsif (/^\s*(?:#|1?\s*;?\s*$)/) { 456 } elsif (/^\s*(?:#|1?\s*;?\s*$)/) {
398 # nop 457 # nop
399 } else { 458 } else {
400 warn "$ix: unparsable line, please report: $_"; 459 warn "WARNING: $ix: unparsable line, please report: $_";
401 } 460 }
402 } 461 }
403} 462}
404 463
405for my $pm (keys %pm) { 464for my $pm (keys %pm) {
406 if ($pm =~ /^(.*)\.pm$/) { 465 if ($pm =~ /^(.*)\.pm$/) {
407 my $auto = "auto/$1"; 466 my $auto = "auto/$1";
408 my $autodir = find_inc $auto; 467 my $autodir = find_inc $auto;
409 468
410 if (defined $autodir && -d "$autodir/$auto") { 469 if (defined $autodir && -d $autodir) {
411 $autodir = "$autodir/$auto";
412
413 # AutoLoader 470 # AutoLoader
414 scan_al $auto, $autodir 471 scan_al $auto, $autodir
415 if -f "$autodir/autosplit.ix"; 472 if -f "$autodir/autosplit.ix";
416 473
417 # extralibs.ld 474 # extralibs.ld
418 if (open my $fh, "<:perlio", "$autodir/extralibs.ld") { 475 if (open my $fh, "<:perlio", "$autodir/extralibs.ld") {
476 print "found extralibs for $pm\n"
477 if $VERBOSE >= 6;
478
419 local $/; 479 local $/;
420 $extralibs .= " " . <$fh>; 480 $extralibs .= " " . <$fh>;
421 } 481 }
422 482
423 $pm =~ /([^\/]+).pm$/ or die "$pm: unable to match last component"; 483 $pm =~ /([^\/]+).pm$/ or die "$pm: unable to match last component";
424 484
425 my $base = $1; 485 my $base = $1;
426 486
427 # static ext 487 # static ext
428 if (-f "$autodir/$base$Config{_a}") { 488 if (-f "$autodir/$base$Config{_a}") {
489 print "found static archive for $pm\n"
490 if $VERBOSE >= 3;
491
429 push @libs, "$autodir/$base$Config{_a}"; 492 push @libs, "$autodir/$base$Config{_a}";
430 push @static_ext, $pm; 493 push @static_ext, $pm;
431 } 494 }
432 495
433 # dynamic object 496 # dynamic object
434 die "ERROR: found shared object - can't link statically ($_)\n"
435 if -f "$autodir/$base.$Config{dlext}"; 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 }
536 }
537 }
538 }
436 } 539 }
437 } 540 }
438} 541}
439 542
440############################################################################# 543#############################################################################
544
545print "processing bundle files (try more -v power if you get bored waiting here)...\n"
546 if $VERBOSE >= 1;
441 547
442my $data; 548my $data;
443my @index; 549my @index;
444my @order = sort { 550my @order = sort {
445 length $a <=> length $b 551 length $a <=> length $b
… …
457 or die "ERROR: $pm: path too long (only 128 octets supported)\n"; 563 or die "ERROR: $pm: path too long (only 128 octets supported)\n";
458 564
459 my $src = ref $path 565 my $src = ref $path
460 ? $$path 566 ? $$path
461 : do { 567 : do {
462 open my $pm, "<", $path 568 open my $pm, "<:raw:perlio", $path
463 or die "$path: $!"; 569 or die "$path: $!";
464 570
465 local $/; 571 local $/;
466 572
467 <$pm> 573 <$pm>
… …
470 my $size = length $src; 576 my $size = length $src;
471 577
472 unless ($pmbin{$pm}) { # only do this unless the file is binary 578 unless ($pmbin{$pm}) { # only do this unless the file is binary
473 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { 579 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) {
474 if ($src =~ /^ unimpl \"/m) { 580 if ($src =~ /^ unimpl \"/m) {
475 warn "$pm: skipping (not implemented anyways).\n" 581 print "$pm: skipping (raises runtime error only).\n"
476 if $VERBOSE >= 2; 582 if $VERBOSE >= 3;
477 next; 583 next;
478 } 584 }
479 } 585 }
480 586
481 $src = cache "$UNISTRIP,$OPTIMISE_SIZE,$STRIP", $src, sub { 587 $src = cache +($STRIP eq "ppi" ? "$UNISTRIP,$OPTIMISE_SIZE" : undef), $src, sub {
482 if ($UNISTRIP && $pm =~ /^unicore\/.*\.pl$/) { 588 if ($UNISTRIP && $pm =~ /^unicore\/.*\.pl$/) {
589 print "applying unicore stripping $pm\n"
590 if $VERBOSE >= 6;
591
483 # special stripping for unicore swashes and properties 592 # special stripping for unicore swashes and properties
484 # much more could be done by going binary 593 # much more could be done by going binary
485 $src =~ s{ 594 $src =~ s{
486 (^return\ <<'END';\n) (.*?\n) (END(?:\n|\Z)) 595 (^return\ <<'END';\n) (.*?\n) (END(?:\n|\Z))
487 }{ 596 }{
… …
600 709
601 $src = $ppi->serialize; 710 $src = $ppi->serialize;
602 } else { 711 } else {
603 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n"; 712 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n";
604 } 713 }
605 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod 714 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses its own pod
606 require Pod::Strip; 715 require Pod::Strip;
607 716
608 my $stripper = Pod::Strip->new; 717 my $stripper = Pod::Strip->new;
609 718
610 my $out; 719 my $out;
… …
630# open my $fh, ">x" or die; print $fh $src;#d# 739# open my $fh, ">x" or die; print $fh $src;#d#
631# exit 1; 740# exit 1;
632# } 741# }
633 } 742 }
634 743
635 print "adding $pm{$pm} (original size $size, stored size ", length $src, ")\n" 744 print "adding $pm (original size $size, stored size ", length $src, ")\n"
636 if $VERBOSE >= 2; 745 if $VERBOSE >= 2;
637 746
638 push @index, ((length $pm) << 25) | length $data; 747 push @index, ((length $pm) << 25) | length $data;
639 $data .= $pm . $src; 748 $data .= $pm . $src;
640} 749}
641 750
642length $data < 2**25 751length $data < 2**25
643 or die "bundle too large (only 32MB supported)\n"; 752 or die "ERROR: bundle too large (only 32MB supported)\n";
644 753
645my $varpfx = "bundle_" . substr +(Digest::MD5::md5_hex $data), 0, 16; 754my $varpfx = "bundle";
646 755
647############################################################################# 756#############################################################################
648# output 757# output
649 758
650print "generating $PREFIX.h... "; 759print "generating $PREFIX.h... "
760 if $VERBOSE >= 1;
651 761
652{ 762{
653 open my $fh, ">", "$PREFIX.h" 763 open my $fh, ">", "$PREFIX.h"
654 or die "$PREFIX.h: $!\n"; 764 or die "$PREFIX.h: $!\n";
655 765
656 print $fh <<EOF; 766 print $fh <<EOF;
657/* do not edit, automatically created by mkstaticbundle */ 767/* do not edit, automatically created by staticperl */
658 768
659#include <EXTERN.h> 769#include <EXTERN.h>
660#include <perl.h> 770#include <perl.h>
661#include <XSUB.h> 771#include <XSUB.h>
662 772
663/* public API */ 773/* public API */
664EXTERN_C PerlInterpreter *staticperl; 774EXTERN_C PerlInterpreter *staticperl;
665EXTERN_C void staticperl_xs_init (pTHX); 775EXTERN_C void staticperl_xs_init (pTHX);
666EXTERN_C void staticperl_init (void); 776EXTERN_C void staticperl_init (XSINIT_t xs_init); /* argument can be 0 */
667EXTERN_C void staticperl_cleanup (void); 777EXTERN_C void staticperl_cleanup (void);
668 778
669EOF 779EOF
670} 780}
671 781
672print "\n"; 782print "\n"
783 if $VERBOSE >= 1;
673 784
674############################################################################# 785#############################################################################
675# output 786# output
676 787
677print "generating $PREFIX.c... "; 788print "generating $PREFIX.c... "
789 if $VERBOSE >= 1;
678 790
679open my $fh, ">", "$PREFIX.c" 791open my $fh, ">", "$PREFIX.c"
680 or die "$PREFIX.c: $!\n"; 792 or die "$PREFIX.c: $!\n";
681 793
682print $fh <<EOF; 794print $fh <<EOF;
683/* do not edit, automatically created by mkstaticbundle */ 795/* do not edit, automatically created by staticperl */
684 796
685#include "bundle.h" 797#include "bundle.h"
686 798
687/* public API */ 799/* public API */
688PerlInterpreter *staticperl; 800PerlInterpreter *staticperl;
… …
712printf $fh "0x%08x\n};\n", (length $data); 824printf $fh "0x%08x\n};\n", (length $data);
713 825
714print $fh "static const char $varpfx\_data [] =\n"; 826print $fh "static const char $varpfx\_data [] =\n";
715dump_string $fh, $data; 827dump_string $fh, $data;
716 828
717print $fh ";\n\n";; 829print $fh ";\n\n";
718 830
719############################################################################# 831#############################################################################
720# bootstrap 832# bootstrap
721 833
722# boot file for staticperl 834# boot file for staticperl
723# this file will be eval'ed at initialisation time 835# this file will be eval'ed at initialisation time
724 836
837# lines marked with "^D" are only used when $HAVE_DYNAMIC
725my $bootstrap = ' 838my $bootstrap = '
726BEGIN { 839BEGIN {
727 package ' . $PACKAGE . '; 840 package ' . $PACKAGE . ';
728 841
729 PerlIO::scalar->bootstrap; 842 # the path prefix to use when putting files into %INC
843 our $inc_prefix;
730 844
731 @INC = sub { 845 # the @INC hook to use when we have PerlIO::scalar available
846 my $perlio_inc = sub {
732 my $data = find "$_[1]" 847 my $data = find "$_[1]"
733 or return; 848 or return;
734 849
735 $INC{$_[1]} = $_[1]; 850 $INC{$_[1]} = "$inc_prefix$_[1]";
736 851
737 open my $fh, "<", \$data; 852 open my $fh, "<", \$data;
738 $fh 853 $fh
739 }; 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 }
740} 884}
741'; 885';
742 886
743$bootstrap .= "require '//boot';" 887$bootstrap .= "require '!boot';"
744 if exists $pm{"//boot"}; 888 if exists $pm{"!boot"};
745 889
890if ($HAVE_DYNAMIC) {
891 $bootstrap =~ s/^D/ /mg;
892} else {
893 $bootstrap =~ s/^D.*$//mg;
894}
895
896$bootstrap =~ s/#.*$//mg;
746$bootstrap =~ s/\s+/ /g; 897$bootstrap =~ s/\s+/ /g;
747$bootstrap =~ s/(\W) /$1/g; 898$bootstrap =~ s/(\W) /$1/g;
748$bootstrap =~ s/ (\W)/$1/g; 899$bootstrap =~ s/ (\W)/$1/g;
749 900
750print $fh "const char bootstrap [] = "; 901print $fh "const char bootstrap [] = ";
… …
796 } 947 }
797 948
798 XSRETURN (0); 949 XSRETURN (0);
799 950
800 found: 951 found:
801 ST (0) = res; 952 ST (0) = sv_2mortal (res);
802 sv_2mortal (ST (0));
803 } 953 }
804 954
805 XSRETURN (1); 955 XSRETURN (1);
806} 956}
807 957
… …
820 970
821 for (i = 0; i < $varpfx\_count; ++i) 971 for (i = 0; i < $varpfx\_count; ++i)
822 { 972 {
823 U32 idx = $varpfx\_index [i]; 973 U32 idx = $varpfx\_index [i];
824 974
825 PUSHs (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25)); 975 PUSHs (sv_2mortal (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25)));
826 } 976 }
827 } 977 }
828 978
829 XSRETURN ($varpfx\_count); 979 XSRETURN ($varpfx\_count);
830} 980}
… …
838void 988void
839staticperl_xs_init (pTHX) 989staticperl_xs_init (pTHX)
840{ 990{
841EOF 991EOF
842 992
843@static_ext = ("DynaLoader", sort @static_ext); 993@static_ext = sort @static_ext;
844 994
845# prototypes 995# prototypes
846for (@static_ext) { 996for (@static_ext) {
847 s/\.pm$//; 997 s/\.pm$//;
848 (my $cname = $_) =~ s/\//__/g; 998 (my $cname = $_) =~ s/\//__/g;
… …
862 s/\.pm$//; 1012 s/\.pm$//;
863 1013
864 (my $cname = $_) =~ s/\//__/g; 1014 (my $cname = $_) =~ s/\//__/g;
865 (my $pname = $_) =~ s/\//::/g; 1015 (my $pname = $_) =~ s/\//::/g;
866 1016
867 my $bootstrap = $pname eq "DynaLoader" ? "boot" : "bootstrap"; 1017 my $bootstrap = $pname eq "DynaLoader" ? "boot_DynaLoader" : "bootstrap";
868 1018
869 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n"; 1019 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n";
870} 1020}
871 1021
872print $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
873 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);
874} 1037}
875EOF 1038EOF
876 1039
877############################################################################# 1040#############################################################################
878# optional perl_init/perl_destroy 1041# optional perl_init/perl_destroy
879 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
880if ($APP) { 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
1096} elsif ($PERL) {
881 print $fh <<EOF; 1097 print $fh <<EOF;
882 1098
883int 1099int
884main (int argc, char *argv []) 1100main (int argc, char *argv [])
885{ 1101{
886 extern char **environ; 1102 extern char **environ;
887 int exitstatus; 1103 int exitstatus;
888 1104
1105$IGNORE_ENV
1106 PERL_SYS_INIT3 (&argc, &argv, &environ);
1107 staticperl = perl_alloc ();
1108 perl_construct (staticperl);
1109
1110 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1111
1112 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
1113 if (!exitstatus)
1114 perl_run (staticperl);
1115
1116 exitstatus = perl_destruct (staticperl);
1117 perl_free (staticperl);
1118 PERL_SYS_TERM ();
1119
1120 return exitstatus;
1121}
1122EOF
1123} else {
1124 print $fh <<EOF;
1125
1126EXTERN_C void
1127staticperl_init (XSINIT_t xs_init)
1128{
889 static char *args[] = { 1129 static char *args[] = {
890 "staticperl", 1130 "staticperl",
891 "-e", 1131 "-e",
892 "0" 1132 "0"
893 }; 1133 };
894 1134
895 PERL_SYS_INIT3 (&argc, &argv, &environ);
896 staticperl = perl_alloc ();
897 perl_construct (staticperl);
898
899 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
900
901 exitstatus = perl_parse (staticperl, staticperl_xs_init, sizeof (args) / sizeof (*args), args, environ);
902 if (!exitstatus)
903 perl_run (staticperl);
904
905 exitstatus = perl_destruct (staticperl);
906 perl_free (staticperl);
907 PERL_SYS_TERM ();
908
909 return exitstatus;
910}
911EOF
912} elsif ($PERL) {
913 print $fh <<EOF;
914
915int
916main (int argc, char *argv [])
917{
918 extern char **environ;
919 int exitstatus;
920
921 PERL_SYS_INIT3 (&argc, &argv, &environ);
922 staticperl = perl_alloc ();
923 perl_construct (staticperl);
924
925 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
926
927 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
928 if (!exitstatus)
929 perl_run (staticperl);
930
931 exitstatus = perl_destruct (staticperl);
932 perl_free (staticperl);
933 PERL_SYS_TERM ();
934
935 return exitstatus;
936}
937EOF
938} else {
939 print $fh <<EOF;
940
941EXTERN_C void
942staticperl_init (void)
943{
944 extern char **environ; 1135 extern char **environ;
945 int argc = sizeof (args) / sizeof (args [0]); 1136 int argc = sizeof (args) / sizeof (args [0]);
946 char **argv = args; 1137 char **argv = args;
947 1138
948 static char *args[] = { 1139$IGNORE_ENV
949 "staticperl",
950 "-e",
951 "0"
952 };
953
954 PERL_SYS_INIT3 (&argc, &argv, &environ); 1140 PERL_SYS_INIT3 (&argc, &argv, &environ);
955 staticperl = perl_alloc (); 1141 staticperl = perl_alloc ();
956 perl_construct (staticperl); 1142 perl_construct (staticperl);
957 PL_origalen = 1; 1143 PL_origalen = 1;
958 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1144 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1145 PL_oldname = (char *)xs_init;
959 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ); 1146 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
960 1147
961 perl_run (staticperl); 1148 perl_run (staticperl);
962} 1149}
963 1150
… …
970 PERL_SYS_TERM (); 1157 PERL_SYS_TERM ();
971} 1158}
972EOF 1159EOF
973} 1160}
974 1161
1162close $fh;
1163
975print -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;
976 1166
977############################################################################# 1167#############################################################################
978# libs, cflags 1168# libs, cflags
979 1169
1170my $ccopts;
1171
980{ 1172{
981 print "generating $PREFIX.ccopts... "; 1173 print "generating $PREFIX.ccopts... "
1174 if $VERBOSE >= 1;
982 1175
983 my $str = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE"; 1176 $ccopts = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE";
984 $str =~ s/([\(\)])/\\$1/g; 1177 $ccopts =~ s/([\(\)])/\\$1/g;
985
986 print "$str\n\n";
987 1178
988 open my $fh, ">$PREFIX.ccopts" 1179 open my $fh, ">$PREFIX.ccopts"
989 or die "$PREFIX.ccopts: $!"; 1180 or die "$PREFIX.ccopts: $!";
990 print $fh $str; 1181 print $fh $ccopts;
1182
1183 print "$ccopts\n\n"
1184 if $VERBOSE >= 1;
991} 1185}
1186
1187my $ldopts;
992 1188
993{ 1189{
994 print "generating $PREFIX.ldopts... "; 1190 print "generating $PREFIX.ldopts... ";
995 1191
996 my $str = $STATIC ? "-static " : ""; 1192 $ldopts = $STATIC ? "-static " : "";
997 1193
998 $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}";
999 1195
1000 my %seen; 1196 my %seen;
1001 $str .= " $_" for grep !$seen{$_}++, ($extralibs =~ /(\S+)/g); 1197 $ldopts .= " $_" for reverse grep !$seen{$_}++, reverse +($extralibs =~ /(\S+)/g);
1002 1198
1003 for (@staticlibs) { 1199 for (@staticlibs) {
1004 $str =~ s/(^|\s) (-l\Q$_\E) ($|\s)/$1-Wl,-Bstatic $2 -Wl,-Bdynamic$3/gx; 1200 $ldopts =~ s/(^|\s) (-l\Q$_\E) ($|\s)/$1-Wl,-Bstatic $2 -Wl,-Bdynamic$3/gx;
1005 } 1201 }
1006 1202
1007 $str =~ s/([\(\)])/\\$1/g; 1203 $ldopts =~ s/([\(\)])/\\$1/g;
1008
1009 print "$str\n\n";
1010 1204
1011 open my $fh, ">$PREFIX.ldopts" 1205 open my $fh, ">$PREFIX.ldopts"
1012 or die "$PREFIX.ldopts: $!"; 1206 or die "$PREFIX.ldopts: $!";
1013 print $fh $str; 1207 print $fh $ldopts;
1208
1209 print "$ldopts\n\n"
1210 if $VERBOSE >= 1;
1014} 1211}
1015 1212
1016if ($PERL or defined $APP) { 1213if ($PERL or defined $APP) {
1017 $APP = "perl" unless defined $APP; 1214 $APP = "perl" unless defined $APP;
1018 1215
1216 my $build = "$Config{cc} $ccopts -o \Q$APP\E$Config{_exe} bundle.c $ldopts";
1217
1019 print "generating $APP...\n"; 1218 print "build $APP...\n"
1219 if $VERBOSE >= 1;
1020 1220
1021 system "$Config{cc} \$(cat bundle.ccopts\) -o \Q$APP\E bundle.c \$(cat bundle.ldopts\)"; 1221 print "$build\n"
1222 if $VERBOSE >= 2;
1022 1223
1224 system $build;
1225
1023# unlink "$PREFIX.$_" 1226 unlink "$PREFIX.$_"
1024# for qw(ccopts ldopts c h); 1227 for qw(ccopts ldopts c h);
1025 1228
1026 print "\n"; 1229 print "\n"
1230 if $VERBOSE >= 1;
1027} 1231}
1028 1232

Diff Legend

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