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

Comparing cvsroot/App-Staticperl/mkbundle (file contents):
Revision 1.11 by root, Fri Dec 10 02:35:54 2010 UTC vs.
Revision 1.25 by root, Thu Feb 24 07:01:46 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 $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;
13 15
14our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression? 16our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression?
15 17
16our $CACHE; 18our $CACHE;
17our $CACHEVER = 1; # do not change unless you know what you are doing 19our $CACHEVER = 1; # do not change unless you know what you are doing
… …
35 37
36$|=1; 38$|=1;
37 39
38our ($TRACER_W, $TRACER_R); 40our ($TRACER_W, $TRACER_R);
39 41
40sub find_inc($) { 42sub find_incdir($) {
41 for (@INC) { 43 for (@INC) {
42 next if ref; 44 next if ref;
43 return $_ if -e "$_/$_[0]"; 45 return $_ if -e "$_/$_[0]";
44 } 46 }
45 47
46 undef 48 undef
47} 49}
48 50
51sub find_inc($) {
52 my $dir = find_incdir $_[0];
53
54 return "$dir/$_[0]"
55 if defined $dir;
56
57 undef
58}
59
49BEGIN { 60BEGIN {
50 # create a loader process to detect @INC requests before we load any modules 61 # create a loader process to detect @INC requests before we load any modules
51 my ($W_TRACER, $R_TRACER); # used by tracer 62 my ($W_TRACER, $R_TRACER); # used by tracer
52 63
53 pipe $R_TRACER, $TRACER_W or die "pipe: $!"; 64 pipe $R_TRACER, $TRACER_W or die "pipe: $!";
… …
55 66
56 unless (fork) { 67 unless (fork) {
57 close $TRACER_R; 68 close $TRACER_R;
58 close $TRACER_W; 69 close $TRACER_W;
59 70
71 my $pkg = "pkg000000";
72
60 unshift @INC, sub { 73 unshift @INC, sub {
61 my $dir = find_inc $_[1] 74 my $dir = find_incdir $_[1]
62 or return; 75 or return;
63 76
64 syswrite $W_TRACER, "-\n$dir\n$_[1]\n"; 77 syswrite $W_TRACER, "-\n$dir\n$_[1]\n";
65 78
66 open my $fh, "<:perlio", "$dir/$_[1]" 79 open my $fh, "<:perlio", "$dir/$_[1]"
… …
70 }; 83 };
71 84
72 while (<$R_TRACER>) { 85 while (<$R_TRACER>) {
73 if (/use (.*)$/) { 86 if (/use (.*)$/) {
74 my $mod = $1; 87 my $mod = $1;
88 my $eval;
89
90 if ($mod =~ /^'.*'$/ or $mod =~ /^".*"$/) {
75 eval "require $mod"; 91 $eval = "require $mod";
92 } elsif ($mod =~ y%/.%%) {
93 $eval = "require q\x00$mod\x00";
94 } else {
95 my $pkg = ++$pkg;
96 $eval = "{ package $pkg; use $mod; }";
97 }
98
99 eval $eval;
76 warn "ERROR: $@ (while loading '$mod')\n" 100 warn "ERROR: $@ (while loading '$mod')\n"
77 if $@; 101 if $@;
78 syswrite $W_TRACER, "\n";
79 } elsif (/eval (.*)$/) { 102 } elsif (/eval (.*)$/) {
80 my $eval = $1; 103 my $eval = $1;
81 eval $eval; 104 eval $eval;
82 warn "ERROR: $@ (in '$eval')\n" 105 warn "ERROR: $@ (in '$eval')\n"
83 if $@; 106 if $@;
84 } 107 }
108
109 syswrite $W_TRACER, "\n";
85 } 110 }
86 111
87 exit 0; 112 exit 0;
88 } 113 }
89} 114}
90 115
91# module loading is now safe 116# module loading is now safe
92 117
93sub trace_module { 118sub trace_parse {
94 syswrite $TRACER_W, "use $_[0]\n";
95
96 for (;;) { 119 for (;;) {
97 <$TRACER_R> =~ /^-$/ or last; 120 <$TRACER_R> =~ /^-$/ or last;
98 my $dir = <$TRACER_R>; chomp $dir; 121 my $dir = <$TRACER_R>; chomp $dir;
99 my $name = <$TRACER_R>; chomp $name; 122 my $name = <$TRACER_R>; chomp $name;
100 123
101 $pm{$name} = "$dir/$name"; 124 $pm{$name} = "$dir/$name";
125
126 print "+ found potential dependency $name\n"
127 if $VERBOSE >= 3;
102 } 128 }
129}
130
131sub trace_module {
132 print "tracing module $_[0]\n"
133 if $VERBOSE >= 2;
134
135 syswrite $TRACER_W, "use $_[0]\n";
136 trace_parse;
103} 137}
104 138
105sub trace_eval { 139sub trace_eval {
140 print "tracing eval $_[0]\n"
141 if $VERBOSE >= 2;
142
106 syswrite $TRACER_W, "eval $_[0]\n"; 143 syswrite $TRACER_W, "eval $_[0]\n";
144 trace_parse;
107} 145}
108 146
109sub trace_finish { 147sub trace_finish {
110 close $TRACER_W; 148 close $TRACER_W;
111 close $TRACER_R; 149 close $TRACER_R;
… …
119use Digest::MD5; 157use Digest::MD5;
120 158
121sub cache($$$) { 159sub cache($$$) {
122 my ($variant, $src, $filter) = @_; 160 my ($variant, $src, $filter) = @_;
123 161
124 if (length $CACHE and 2048 <= length $src) { 162 if (length $CACHE and 2048 <= length $src and defined $variant) {
125 my $file = "$CACHE/" . Digest::MD5::md5_hex "$CACHEVER\x00$variant\x00$src"; 163 my $file = "$CACHE/" . Digest::MD5::md5_hex "$CACHEVER\x00$variant\x00$src";
126 164
127 if (open my $fh, "<:perlio", $file) { 165 if (open my $fh, "<:perlio", $file) {
166 print "using cache for $file\n"
167 if $VERBOSE >= 7;
168
128 local $/; 169 local $/;
129 return <$fh>; 170 return <$fh>;
130 } 171 }
131 172
132 $src = $filter->($src); 173 $src = $filter->($src);
174
175 print "creating cache entry $file\n"
176 if $VERBOSE >= 8;
133 177
134 if (open my $fh, ">:perlio", "$file~") { 178 if (open my $fh, ">:perlio", "$file~") {
135 if ((syswrite $fh, $src) == length $src) { 179 if ((syswrite $fh, $src) == length $src) {
136 close $fh; 180 close $fh;
137 rename "$file~", $file; 181 rename "$file~", $file;
… …
200 my $path = "$_[0]/$_"; 244 my $path = "$_[0]/$_";
201 245
202 if (-d "$path/.") { 246 if (-d "$path/.") {
203 $scan->($path); 247 $scan->($path);
204 } else { 248 } else {
205 next unless /\.(?:pm|pl)$/;
206
207 $path = substr $path, $skip; 249 $path = substr $path, $skip;
208 push @tree, $path 250 push @tree, $path
209 unless exists $INCSKIP{$path}; 251 unless exists $INCSKIP{$path};
210 } 252 }
211 } 253 }
… …
232} 274}
233 275
234############################################################################# 276#############################################################################
235 277
236sub cmd_boot { 278sub cmd_boot {
237 $pm{"//boot"} = $_[0]; 279 $pm{"&&boot"} = $_[0];
238} 280}
239 281
240sub cmd_add { 282sub cmd_add {
241 $_[0] =~ /^(.*)(?:\s+(\S+))$/ 283 $_[0] =~ /^(.*?)(?:\s+(\S+))?$/
242 or die "$_[0]: cannot parse"; 284 or die "$_[0]: cannot parse";
243 285
244 my $file = $1; 286 my $file = $1;
245 my $as = defined $2 ? $2 : "/$1"; 287 my $as = defined $2 ? $2 : $1;
246 288
247 $pm{$as} = $file; 289 $pm{$as} = $file;
248 $pmbin{$as} = 1 if $_[1]; 290 $pmbin{$as} = 1 if $_[1];
249} 291}
250 292
… …
264 306
265 for (get_inctrees) { 307 for (get_inctrees) {
266 my ($dir, $files) = @$_; 308 my ($dir, $files) = @$_;
267 309
268 $pm{$_} = "$dir/$_" 310 $pm{$_} = "$dir/$_"
269 for grep /$pattern/, @$files; 311 for grep /$pattern/ && /\.(pl|pm)$/, @$files;
270 } 312 }
271} 313}
314
315sub parse_argv;
272 316
273sub cmd_file { 317sub cmd_file {
274 open my $fh, "<", $_[0] 318 open my $fh, "<", $_[0]
275 or die "$_[0]: $!\n"; 319 or die "$_[0]: $!\n";
276 320
321 local @ARGV;
322
277 while (<$fh>) { 323 while (<$fh>) {
278 chomp; 324 chomp;
325 next unless /\S/;
326 next if /^\s*#/;
327
328 s/^\s*-*/--/;
279 my ($cmd, $args) = split / /, $_, 2; 329 my ($cmd, $args) = split / /, $_, 2;
280 $cmd =~ s/^-+//;
281 330
282 if ($cmd eq "strip") { 331 push @ARGV, $cmd;
283 $STRIP = $args; 332 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 } 333 }
334
335 parse_argv;
315} 336}
316 337
317use Getopt::Long; 338use Getopt::Long;
318 339
340sub parse_argv {
341 GetOptions
342 "perl" => \$PERL,
343 "app=s" => \$APP,
344
345 "verbose|v" => sub { ++$VERBOSE },
346 "quiet|q" => sub { --$VERBOSE },
347
348 "strip=s" => \$STRIP,
349 "cache=s" => \$CACHE, # internal option
350 "eval|e=s" => sub { trace_eval $_[1] },
351 "use|M=s" => sub { trace_module $_[1] },
352 "boot=s" => sub { cmd_boot $_[1] },
353 "add=s" => sub { cmd_add $_[1], 0 },
354 "addbin=s" => sub { cmd_add $_[1], 1 },
355 "incglob=s" => sub { cmd_incglob $_[1] },
356 "include|i=s" => sub { cmd_include $_[1], 1 },
357 "exclude|x=s" => sub { cmd_include $_[1], 0 },
358 "usepacklists!" => \$PACKLIST,
359
360 "static!" => \$STATIC,
361 "staticlib=s" => sub { cmd_staticlib $_[1] },
362 "ignore-env" => \$IGNORE_ENV,
363
364 "<>" => sub { cmd_file $_[0] },
365 or exit 1;
366}
367
319Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); 368Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
320 369
321GetOptions 370parse_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 371
341die "cannot specify both --app and --perl\n" 372die "cannot specify both --app and --perl\n"
342 if $PERL and defined $APP; 373 if $PERL and defined $APP;
343 374
344# required for @INC loading, unfortunately 375# required for @INC loading, unfortunately
345trace_module "PerlIO::scalar"; 376trace_module "PerlIO::scalar";
346 377
347############################################################################# 378#############################################################################
348# include/exclude apply 379# apply include/exclude
349 380
350{ 381{
351 my %pmi; 382 my %pmi;
352 383
353 for (@incext) { 384 for (@incext) {
… …
356 my @match = grep /$glob/, keys %pm; 387 my @match = grep /$glob/, keys %pm;
357 388
358 if ($inc) { 389 if ($inc) {
359 # include 390 # include
360 @pmi{@match} = delete @pm{@match}; 391 @pmi{@match} = delete @pm{@match};
392
393 print "applying include $glob - protected ", (scalar @match), " files.\n"
394 if $VERBOSE >= 5;
361 } else { 395 } else {
362 # exclude 396 # exclude
363 delete @pm{@match}; 397 delete @pm{@match};
398
399 print "applying exclude $glob - removed ", (scalar @match), " files.\n"
400 if $VERBOSE >= 5;
364 } 401 }
365 } 402 }
366 403
367 my @pmi = keys %pmi; 404 my @pmi = keys %pmi;
368 @pm{@pmi} = delete @pmi{@pmi}; 405 @pm{@pmi} = delete @pmi{@pmi};
369} 406}
370 407
371############################################################################# 408#############################################################################
372# scan for AutoLoader and static archives 409# scan for AutoLoader, static archives and other dependencies
373 410
374sub scan_al { 411sub scan_al {
375 my ($auto, $autodir) = @_; 412 my ($auto, $autodir) = @_;
376 413
377 my $ix = "$autodir/autosplit.ix"; 414 my $ix = "$autodir/autosplit.ix";
415
416 print "processing autoload index for '$auto'\n"
417 if $VERBOSE >= 6;
378 418
379 $pm{"$auto/autosplit.ix"} = $ix; 419 $pm{"$auto/autosplit.ix"} = $ix;
380 420
381 open my $fh, "<:perlio", $ix 421 open my $fh, "<:perlio", $ix
382 or die "$ix: $!"; 422 or die "$ix: $!";
… …
388 my $al = "auto/$package/$1.al"; 428 my $al = "auto/$package/$1.al";
389 my $inc = find_inc $al; 429 my $inc = find_inc $al;
390 430
391 defined $inc or die "$al: autoload file not found, but should be there.\n"; 431 defined $inc or die "$al: autoload file not found, but should be there.\n";
392 432
393 $pm{$al} = "$inc/$al"; 433 $pm{$al} = $inc;
434 print "found autoload function '$al'\n"
435 if $VERBOSE >= 6;
394 436
395 } elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) { 437 } elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) {
396 ($package = $1) =~ s/::/\//g; 438 ($package = $1) =~ s/::/\//g;
397 } elsif (/^\s*(?:#|1?\s*;?\s*$)/) { 439 } elsif (/^\s*(?:#|1?\s*;?\s*$)/) {
398 # nop 440 # nop
399 } else { 441 } else {
400 warn "$ix: unparsable line, please report: $_"; 442 warn "WARNING: $ix: unparsable line, please report: $_";
401 } 443 }
402 } 444 }
403} 445}
404 446
405for my $pm (keys %pm) { 447for my $pm (keys %pm) {
406 if ($pm =~ /^(.*)\.pm$/) { 448 if ($pm =~ /^(.*)\.pm$/) {
407 my $auto = "auto/$1"; 449 my $auto = "auto/$1";
408 my $autodir = find_inc $auto; 450 my $autodir = find_inc $auto;
409 451
410 if (defined $autodir && -d "$autodir/$auto") { 452 if (defined $autodir && -d $autodir) {
411 $autodir = "$autodir/$auto";
412
413 # AutoLoader 453 # AutoLoader
414 scan_al $auto, $autodir 454 scan_al $auto, $autodir
415 if -f "$autodir/autosplit.ix"; 455 if -f "$autodir/autosplit.ix";
416 456
417 # extralibs.ld 457 # extralibs.ld
418 if (open my $fh, "<:perlio", "$autodir/extralibs.ld") { 458 if (open my $fh, "<:perlio", "$autodir/extralibs.ld") {
459 print "found extralibs for $pm\n"
460 if $VERBOSE >= 6;
461
419 local $/; 462 local $/;
420 $extralibs .= " " . <$fh>; 463 $extralibs .= " " . <$fh>;
421 } 464 }
422 465
423 $pm =~ /([^\/]+).pm$/ or die "$pm: unable to match last component"; 466 $pm =~ /([^\/]+).pm$/ or die "$pm: unable to match last component";
424 467
425 my $base = $1; 468 my $base = $1;
426 469
427 # static ext 470 # static ext
428 if (-f "$autodir/$base$Config{_a}") { 471 if (-f "$autodir/$base$Config{_a}") {
472 print "found static archive for $pm\n"
473 if $VERBOSE >= 3;
474
429 push @libs, "$autodir/$base$Config{_a}"; 475 push @libs, "$autodir/$base$Config{_a}";
430 push @static_ext, $pm; 476 push @static_ext, $pm;
431 } 477 }
432 478
433 # dynamic object 479 # dynamic object
434 die "ERROR: found shared object - can't link statically ($_)\n" 480 die "ERROR: found shared object - can't link statically ($_)\n"
435 if -f "$autodir/$base.$Config{dlext}"; 481 if -f "$autodir/$base.$Config{dlext}";
482
483 if ($PACKLIST && open my $fh, "<:perlio", "$autodir/.packlist") {
484 print "found .packlist for $pm\n"
485 if $VERBOSE >= 3;
486
487 while (<$fh>) {
488 chomp;
489 s/ .*$//; # newer-style .packlists might contain key=value pairs
490
491 # only include certain files (.al, .ix, .pm, .pl)
492 if (/\.(pm|pl|al|ix)$/) {
493 for my $inc (@INC) {
494 # in addition, we only add files that are below some @INC path
495 $inc =~ s/\/*$/\//;
496
497 if ($inc eq substr $_, 0, length $inc) {
498 my $base = substr $_, length $inc;
499 $pm{$base} = $_;
500
501 print "+ added .packlist dependency $base\n"
502 if $VERBOSE >= 3;
503 }
504
505 last;
506 }
507 }
508 }
509 }
436 } 510 }
437 } 511 }
438} 512}
439 513
440############################################################################# 514#############################################################################
515
516print "processing bundle files (try more -v power if you get bored waiting here)...\n"
517 if $VERBOSE >= 1;
441 518
442my $data; 519my $data;
443my @index; 520my @index;
444my @order = sort { 521my @order = sort {
445 length $a <=> length $b 522 length $a <=> length $b
… …
470 my $size = length $src; 547 my $size = length $src;
471 548
472 unless ($pmbin{$pm}) { # only do this unless the file is binary 549 unless ($pmbin{$pm}) { # only do this unless the file is binary
473 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { 550 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) {
474 if ($src =~ /^ unimpl \"/m) { 551 if ($src =~ /^ unimpl \"/m) {
475 warn "$pm: skipping (not implemented anyways).\n" 552 print "$pm: skipping (raises runtime error only).\n"
476 if $VERBOSE >= 2; 553 if $VERBOSE >= 3;
477 next; 554 next;
478 } 555 }
479 } 556 }
480 557
481 $src = cache "$UNISTRIP,$OPTIMISE_SIZE,$STRIP", $src, sub { 558 $src = cache +($STRIP eq "ppi" ? "$UNISTRIP,$OPTIMISE_SIZE" : undef), $src, sub {
482 if ($UNISTRIP && $pm =~ /^unicore\/.*\.pl$/) { 559 if ($UNISTRIP && $pm =~ /^unicore\/.*\.pl$/) {
560 print "applying unicore stripping $pm\n"
561 if $VERBOSE >= 6;
562
483 # special stripping for unicore swashes and properties 563 # special stripping for unicore swashes and properties
484 # much more could be done by going binary 564 # much more could be done by going binary
485 $src =~ s{ 565 $src =~ s{
486 (^return\ <<'END';\n) (.*?\n) (END(?:\n|\Z)) 566 (^return\ <<'END';\n) (.*?\n) (END(?:\n|\Z))
487 }{ 567 }{
… …
600 680
601 $src = $ppi->serialize; 681 $src = $ppi->serialize;
602 } else { 682 } else {
603 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n"; 683 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n";
604 } 684 }
605 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod 685 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses its own pod
606 require Pod::Strip; 686 require Pod::Strip;
607 687
608 my $stripper = Pod::Strip->new; 688 my $stripper = Pod::Strip->new;
609 689
610 my $out; 690 my $out;
… …
630# open my $fh, ">x" or die; print $fh $src;#d# 710# open my $fh, ">x" or die; print $fh $src;#d#
631# exit 1; 711# exit 1;
632# } 712# }
633 } 713 }
634 714
635 print "adding $pm{$pm} (original size $size, stored size ", length $src, ")\n" 715 print "adding $pm (original size $size, stored size ", length $src, ")\n"
636 if $VERBOSE >= 2; 716 if $VERBOSE >= 2;
637 717
638 push @index, ((length $pm) << 25) | length $data; 718 push @index, ((length $pm) << 25) | length $data;
639 $data .= $pm . $src; 719 $data .= $pm . $src;
640} 720}
641 721
642length $data < 2**25 722length $data < 2**25
643 or die "bundle too large (only 32MB supported)\n"; 723 or die "ERROR: bundle too large (only 32MB supported)\n";
644 724
645my $varpfx = "bundle_" . substr +(Digest::MD5::md5_hex $data), 0, 16; 725my $varpfx = "bundle_" . substr +(Digest::MD5::md5_hex $data), 0, 16;
646 726
647############################################################################# 727#############################################################################
648# output 728# output
649 729
650print "generating $PREFIX.h... "; 730print "generating $PREFIX.h... "
731 if $VERBOSE >= 1;
651 732
652{ 733{
653 open my $fh, ">", "$PREFIX.h" 734 open my $fh, ">", "$PREFIX.h"
654 or die "$PREFIX.h: $!\n"; 735 or die "$PREFIX.h: $!\n";
655 736
… …
661#include <XSUB.h> 742#include <XSUB.h>
662 743
663/* public API */ 744/* public API */
664EXTERN_C PerlInterpreter *staticperl; 745EXTERN_C PerlInterpreter *staticperl;
665EXTERN_C void staticperl_xs_init (pTHX); 746EXTERN_C void staticperl_xs_init (pTHX);
666EXTERN_C void staticperl_init (void); 747EXTERN_C void staticperl_init (XSINIT_t xs_init); /* argument can be 0 */
667EXTERN_C void staticperl_cleanup (void); 748EXTERN_C void staticperl_cleanup (void);
668 749
669EOF 750EOF
670} 751}
671 752
672print "\n"; 753print "\n"
754 if $VERBOSE >= 1;
673 755
674############################################################################# 756#############################################################################
675# output 757# output
676 758
677print "generating $PREFIX.c... "; 759print "generating $PREFIX.c... "
760 if $VERBOSE >= 1;
678 761
679open my $fh, ">", "$PREFIX.c" 762open my $fh, ">", "$PREFIX.c"
680 or die "$PREFIX.c: $!\n"; 763 or die "$PREFIX.c: $!\n";
681 764
682print $fh <<EOF; 765print $fh <<EOF;
… …
712printf $fh "0x%08x\n};\n", (length $data); 795printf $fh "0x%08x\n};\n", (length $data);
713 796
714print $fh "static const char $varpfx\_data [] =\n"; 797print $fh "static const char $varpfx\_data [] =\n";
715dump_string $fh, $data; 798dump_string $fh, $data;
716 799
717print $fh ";\n\n";; 800print $fh ";\n\n";
718 801
719############################################################################# 802#############################################################################
720# bootstrap 803# bootstrap
721 804
722# boot file for staticperl 805# boot file for staticperl
… …
738 $fh 821 $fh
739 }; 822 };
740} 823}
741'; 824';
742 825
743$bootstrap .= "require '//boot';" 826$bootstrap .= "require '&&boot';"
744 if exists $pm{"//boot"}; 827 if exists $pm{"&&boot"};
745 828
746$bootstrap =~ s/\s+/ /g; 829$bootstrap =~ s/\s+/ /g;
747$bootstrap =~ s/(\W) /$1/g; 830$bootstrap =~ s/(\W) /$1/g;
748$bootstrap =~ s/ (\W)/$1/g; 831$bootstrap =~ s/ (\W)/$1/g;
749 832
… …
869 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n"; 952 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n";
870} 953}
871 954
872print $fh <<EOF; 955print $fh <<EOF;
873 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1)); 956 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1));
957
958 if (PL_oldname)
959 ((XSINIT_t)PL_oldname)(aTHX);
874} 960}
875EOF 961EOF
876 962
877############################################################################# 963#############################################################################
878# optional perl_init/perl_destroy 964# optional perl_init/perl_destroy
879 965
966if ($IGNORE_ENV) {
967 $IGNORE_ENV = <<EOF;
968 unsetenv ("PERL_UNICODE");
969 unsetenv ("PERL_HASH_SEED_DEBUG");
970 unsetenv ("PERL_DESTRUCT_LEVEL");
971 unsetenv ("PERL_SIGNALS");
972 unsetenv ("PERL_DEBUG_MSTATS");
973 unsetenv ("PERL5OPT");
974 unsetenv ("PERLIO_DEBUG");
975 unsetenv ("PERLIO");
976 unsetenv ("PERL_HASH_SEED");
977EOF
978} else {
979 $IGNORE_ENV = "";
980}
981
880if ($APP) { 982if ($APP) {
983 print $fh <<EOF;
984
985int
986main (int argc, char *argv [])
987{
988 extern char **environ;
989 int i, exitstatus;
990 char **args = malloc ((argc + 3) * sizeof (const char *));
991
992 args [0] = argv [0];
993 args [1] = "-e";
994 args [2] = "0";
995 args [3] = "--";
996
997 for (i = 1; i < argc; ++i)
998 args [i + 3] = argv [i];
999
1000$IGNORE_ENV
1001 PERL_SYS_INIT3 (&argc, &argv, &environ);
1002 staticperl = perl_alloc ();
1003 perl_construct (staticperl);
1004
1005 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1006
1007 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc + 3, args, environ);
1008 free (args);
1009 if (!exitstatus)
1010 perl_run (staticperl);
1011
1012 exitstatus = perl_destruct (staticperl);
1013 perl_free (staticperl);
1014 PERL_SYS_TERM ();
1015
1016 return exitstatus;
1017}
1018EOF
1019} elsif ($PERL) {
881 print $fh <<EOF; 1020 print $fh <<EOF;
882 1021
883int 1022int
884main (int argc, char *argv []) 1023main (int argc, char *argv [])
885{ 1024{
886 extern char **environ; 1025 extern char **environ;
887 int exitstatus; 1026 int exitstatus;
888 1027
1028$IGNORE_ENV
1029 PERL_SYS_INIT3 (&argc, &argv, &environ);
1030 staticperl = perl_alloc ();
1031 perl_construct (staticperl);
1032
1033 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1034
1035 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
1036 if (!exitstatus)
1037 perl_run (staticperl);
1038
1039 exitstatus = perl_destruct (staticperl);
1040 perl_free (staticperl);
1041 PERL_SYS_TERM ();
1042
1043 return exitstatus;
1044}
1045EOF
1046} else {
1047 print $fh <<EOF;
1048
1049EXTERN_C void
1050staticperl_init (XSINIT_t xs_init)
1051{
889 static char *args[] = { 1052 static char *args[] = {
890 "staticperl", 1053 "staticperl",
891 "-e", 1054 "-e",
892 "0" 1055 "0"
893 }; 1056 };
894 1057
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; 1058 extern char **environ;
945 int argc = sizeof (args) / sizeof (args [0]); 1059 int argc = sizeof (args) / sizeof (args [0]);
946 char **argv = args; 1060 char **argv = args;
947 1061
948 static char *args[] = { 1062$IGNORE_ENV
949 "staticperl",
950 "-e",
951 "0"
952 };
953
954 PERL_SYS_INIT3 (&argc, &argv, &environ); 1063 PERL_SYS_INIT3 (&argc, &argv, &environ);
955 staticperl = perl_alloc (); 1064 staticperl = perl_alloc ();
956 perl_construct (staticperl); 1065 perl_construct (staticperl);
957 PL_origalen = 1; 1066 PL_origalen = 1;
958 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1067 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1068 PL_oldname = (char *)xs_init;
959 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ); 1069 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
960 1070
961 perl_run (staticperl); 1071 perl_run (staticperl);
962} 1072}
963 1073
… …
970 PERL_SYS_TERM (); 1080 PERL_SYS_TERM ();
971} 1081}
972EOF 1082EOF
973} 1083}
974 1084
975print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n"; 1085print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n"
1086 if $VERBOSE >= 1;
976 1087
977############################################################################# 1088#############################################################################
978# libs, cflags 1089# libs, cflags
979 1090
980{ 1091{
981 print "generating $PREFIX.ccopts... "; 1092 print "generating $PREFIX.ccopts... "
1093 if $VERBOSE >= 1;
982 1094
983 my $str = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE"; 1095 my $str = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE";
984 $str =~ s/([\(\)])/\\$1/g; 1096 $str =~ s/([\(\)])/\\$1/g;
985
986 print "$str\n\n";
987 1097
988 open my $fh, ">$PREFIX.ccopts" 1098 open my $fh, ">$PREFIX.ccopts"
989 or die "$PREFIX.ccopts: $!"; 1099 or die "$PREFIX.ccopts: $!";
990 print $fh $str; 1100 print $fh $str;
1101
1102 print "$str\n\n"
1103 if $VERBOSE >= 1;
991} 1104}
992 1105
993{ 1106{
994 print "generating $PREFIX.ldopts... "; 1107 print "generating $PREFIX.ldopts... ";
995 1108
… …
1003 for (@staticlibs) { 1116 for (@staticlibs) {
1004 $str =~ s/(^|\s) (-l\Q$_\E) ($|\s)/$1-Wl,-Bstatic $2 -Wl,-Bdynamic$3/gx; 1117 $str =~ s/(^|\s) (-l\Q$_\E) ($|\s)/$1-Wl,-Bstatic $2 -Wl,-Bdynamic$3/gx;
1005 } 1118 }
1006 1119
1007 $str =~ s/([\(\)])/\\$1/g; 1120 $str =~ s/([\(\)])/\\$1/g;
1008
1009 print "$str\n\n";
1010 1121
1011 open my $fh, ">$PREFIX.ldopts" 1122 open my $fh, ">$PREFIX.ldopts"
1012 or die "$PREFIX.ldopts: $!"; 1123 or die "$PREFIX.ldopts: $!";
1013 print $fh $str; 1124 print $fh $str;
1125
1126 print "$str\n\n"
1127 if $VERBOSE >= 1;
1014} 1128}
1015 1129
1016if ($PERL or defined $APP) { 1130if ($PERL or defined $APP) {
1017 $APP = "perl" unless defined $APP; 1131 $APP = "perl" unless defined $APP;
1018 1132
1019 print "generating $APP...\n"; 1133 print "building $APP...\n"
1134 if $VERBOSE >= 1;
1020 1135
1021 system "$Config{cc} \$(cat bundle.ccopts\) -o \Q$APP\E bundle.c \$(cat bundle.ldopts\)"; 1136 system "$Config{cc} \$(cat bundle.ccopts\) -o \Q$APP\E bundle.c \$(cat bundle.ldopts\)";
1022 1137
1023# unlink "$PREFIX.$_" 1138 unlink "$PREFIX.$_"
1024# for qw(ccopts ldopts c h); 1139 for qw(ccopts ldopts c h);
1025 1140
1026 print "\n"; 1141 print "\n"
1142 if $VERBOSE >= 1;
1027} 1143}
1028 1144

Diff Legend

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