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.17 by root, Wed Feb 9 09:52:27 2011 UTC

… …
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;
13 14
14our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression? 15our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression?
15 16
16our $CACHE; 17our $CACHE;
17our $CACHEVER = 1; # do not change unless you know what you are doing 18our $CACHEVER = 1; # do not change unless you know what you are doing
… …
35 36
36$|=1; 37$|=1;
37 38
38our ($TRACER_W, $TRACER_R); 39our ($TRACER_W, $TRACER_R);
39 40
40sub find_inc($) { 41sub find_incdir($) {
41 for (@INC) { 42 for (@INC) {
42 next if ref; 43 next if ref;
43 return $_ if -e "$_/$_[0]"; 44 return $_ if -e "$_/$_[0]";
44 } 45 }
45 46
46 undef 47 undef
47} 48}
48 49
50sub find_inc($) {
51 my $dir = find_incdir $_[0];
52
53 return "$dir/$_[0]"
54 if defined $dir;
55
56 undef
57}
58
49BEGIN { 59BEGIN {
50 # create a loader process to detect @INC requests before we load any modules 60 # create a loader process to detect @INC requests before we load any modules
51 my ($W_TRACER, $R_TRACER); # used by tracer 61 my ($W_TRACER, $R_TRACER); # used by tracer
52 62
53 pipe $R_TRACER, $TRACER_W or die "pipe: $!"; 63 pipe $R_TRACER, $TRACER_W or die "pipe: $!";
… …
55 65
56 unless (fork) { 66 unless (fork) {
57 close $TRACER_R; 67 close $TRACER_R;
58 close $TRACER_W; 68 close $TRACER_W;
59 69
70 my $pkg = "pkg000000";
71
60 unshift @INC, sub { 72 unshift @INC, sub {
61 my $dir = find_inc $_[1] 73 my $dir = find_incdir $_[1]
62 or return; 74 or return;
63 75
64 syswrite $W_TRACER, "-\n$dir\n$_[1]\n"; 76 syswrite $W_TRACER, "-\n$dir\n$_[1]\n";
65 77
66 open my $fh, "<:perlio", "$dir/$_[1]" 78 open my $fh, "<:perlio", "$dir/$_[1]"
… …
70 }; 82 };
71 83
72 while (<$R_TRACER>) { 84 while (<$R_TRACER>) {
73 if (/use (.*)$/) { 85 if (/use (.*)$/) {
74 my $mod = $1; 86 my $mod = $1;
87 my $pkg = ++$pkg;
88 my $eval = $mod = $mod =~ /[^A-Za-z0-9_:]/
75 eval "require $mod"; 89 ? "require $mod"
90 : "{ package $pkg; use $mod; }";
91 eval $eval;
76 warn "ERROR: $@ (while loading '$mod')\n" 92 warn "ERROR: $@ (while loading '$mod')\n"
77 if $@; 93 if $@;
78 syswrite $W_TRACER, "\n";
79 } elsif (/eval (.*)$/) { 94 } elsif (/eval (.*)$/) {
80 my $eval = $1; 95 my $eval = $1;
81 eval $eval; 96 eval $eval;
82 warn "ERROR: $@ (in '$eval')\n" 97 warn "ERROR: $@ (in '$eval')\n"
83 if $@; 98 if $@;
84 } 99 }
100
101 syswrite $W_TRACER, "\n";
85 } 102 }
86 103
87 exit 0; 104 exit 0;
88 } 105 }
89} 106}
90 107
91# module loading is now safe 108# module loading is now safe
92 109
93sub trace_module { 110sub trace_parse {
94 syswrite $TRACER_W, "use $_[0]\n";
95
96 for (;;) { 111 for (;;) {
97 <$TRACER_R> =~ /^-$/ or last; 112 <$TRACER_R> =~ /^-$/ or last;
98 my $dir = <$TRACER_R>; chomp $dir; 113 my $dir = <$TRACER_R>; chomp $dir;
99 my $name = <$TRACER_R>; chomp $name; 114 my $name = <$TRACER_R>; chomp $name;
100 115
101 $pm{$name} = "$dir/$name"; 116 $pm{$name} = "$dir/$name";
117
118 print "+ found potential dependency $name\n"
119 if $VERBOSE >= 3;
102 } 120 }
121}
122
123sub trace_module {
124 print "tracing module $_[0]\n"
125 if $VERBOSE >= 2;
126
127 syswrite $TRACER_W, "use $_[0]\n";
128 trace_parse;
103} 129}
104 130
105sub trace_eval { 131sub trace_eval {
132 print "tracing eval $_[0]\n"
133 if $VERBOSE >= 2;
134
106 syswrite $TRACER_W, "eval $_[0]\n"; 135 syswrite $TRACER_W, "eval $_[0]\n";
136 trace_parse;
107} 137}
108 138
109sub trace_finish { 139sub trace_finish {
110 close $TRACER_W; 140 close $TRACER_W;
111 close $TRACER_R; 141 close $TRACER_R;
… …
119use Digest::MD5; 149use Digest::MD5;
120 150
121sub cache($$$) { 151sub cache($$$) {
122 my ($variant, $src, $filter) = @_; 152 my ($variant, $src, $filter) = @_;
123 153
124 if (length $CACHE and 2048 <= length $src) { 154 if (length $CACHE and 2048 <= length $src and defined $variant) {
125 my $file = "$CACHE/" . Digest::MD5::md5_hex "$CACHEVER\x00$variant\x00$src"; 155 my $file = "$CACHE/" . Digest::MD5::md5_hex "$CACHEVER\x00$variant\x00$src";
126 156
127 if (open my $fh, "<:perlio", $file) { 157 if (open my $fh, "<:perlio", $file) {
158 print "using cache for $file\n"
159 if $VERBOSE >= 7;
160
128 local $/; 161 local $/;
129 return <$fh>; 162 return <$fh>;
130 } 163 }
131 164
132 $src = $filter->($src); 165 $src = $filter->($src);
166
167 print "creating cache entry $file\n"
168 if $VERBOSE >= 8;
133 169
134 if (open my $fh, ">:perlio", "$file~") { 170 if (open my $fh, ">:perlio", "$file~") {
135 if ((syswrite $fh, $src) == length $src) { 171 if ((syswrite $fh, $src) == length $src) {
136 close $fh; 172 close $fh;
137 rename "$file~", $file; 173 rename "$file~", $file;
… …
200 my $path = "$_[0]/$_"; 236 my $path = "$_[0]/$_";
201 237
202 if (-d "$path/.") { 238 if (-d "$path/.") {
203 $scan->($path); 239 $scan->($path);
204 } else { 240 } else {
205 next unless /\.(?:pm|pl)$/;
206
207 $path = substr $path, $skip; 241 $path = substr $path, $skip;
208 push @tree, $path 242 push @tree, $path
209 unless exists $INCSKIP{$path}; 243 unless exists $INCSKIP{$path};
210 } 244 }
211 } 245 }
… …
264 298
265 for (get_inctrees) { 299 for (get_inctrees) {
266 my ($dir, $files) = @$_; 300 my ($dir, $files) = @$_;
267 301
268 $pm{$_} = "$dir/$_" 302 $pm{$_} = "$dir/$_"
269 for grep /$pattern/, @$files; 303 for grep /$pattern/ && /\.(pl|pm)$/, @$files;
270 } 304 }
271} 305}
306
307sub parse_argv;
272 308
273sub cmd_file { 309sub cmd_file {
274 open my $fh, "<", $_[0] 310 open my $fh, "<", $_[0]
275 or die "$_[0]: $!\n"; 311 or die "$_[0]: $!\n";
276 312
313 local @ARGV;
314
277 while (<$fh>) { 315 while (<$fh>) {
278 chomp; 316 chomp;
317 next unless /\S/;
318 next if /^\s*#/;
319
320 s/^\s*-*/--/;
279 my ($cmd, $args) = split / /, $_, 2; 321 my ($cmd, $args) = split / /, $_, 2;
280 $cmd =~ s/^-+//;
281 322
282 if ($cmd eq "strip") { 323 push @ARGV, $cmd;
283 $STRIP = $args; 324 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 } 325 }
326
327 parse_argv;
315} 328}
316 329
317use Getopt::Long; 330use Getopt::Long;
318 331
332sub parse_argv {
333 GetOptions
334 "strip=s" => \$STRIP,
335 "cache=s" => \$CACHE, # internal option
336 "verbose|v" => sub { ++$VERBOSE },
337 "quiet|q" => sub { --$VERBOSE },
338 "perl" => \$PERL,
339 "app=s" => \$APP,
340 "eval|e=s" => sub { trace_eval $_[1] },
341 "use|M=s" => sub { trace_module $_[1] },
342 "boot=s" => sub { cmd_boot $_[1] },
343 "add=s" => sub { cmd_add $_[1], 0 },
344 "addbin=s" => sub { cmd_add $_[1], 1 },
345 "incglob=s" => sub { cmd_incglob $_[1] },
346 "include|i=s" => sub { cmd_include $_[1], 1 },
347 "exclude|x=s" => sub { cmd_include $_[1], 0 },
348 "static!" => \$STATIC,
349 "usepacklists!" => \$PACKLIST,
350 "staticlib=s" => sub { cmd_staticlib $_[1] },
351 "<>" => sub { cmd_file $_[0] },
352 or exit 1;
353}
354
319Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); 355Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
320 356
321GetOptions 357parse_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 358
341die "cannot specify both --app and --perl\n" 359die "cannot specify both --app and --perl\n"
342 if $PERL and defined $APP; 360 if $PERL and defined $APP;
343 361
344# required for @INC loading, unfortunately 362# required for @INC loading, unfortunately
345trace_module "PerlIO::scalar"; 363trace_module "PerlIO::scalar";
346 364
347############################################################################# 365#############################################################################
348# include/exclude apply 366# apply include/exclude
349 367
350{ 368{
351 my %pmi; 369 my %pmi;
352 370
353 for (@incext) { 371 for (@incext) {
… …
356 my @match = grep /$glob/, keys %pm; 374 my @match = grep /$glob/, keys %pm;
357 375
358 if ($inc) { 376 if ($inc) {
359 # include 377 # include
360 @pmi{@match} = delete @pm{@match}; 378 @pmi{@match} = delete @pm{@match};
379
380 print "applying include $glob - protected ", (scalar @match), " files.\n"
381 if $VERBOSE >= 5;
361 } else { 382 } else {
362 # exclude 383 # exclude
363 delete @pm{@match}; 384 delete @pm{@match};
385
386 print "applying exclude $glob - removed ", (scalar @match), " files.\n"
387 if $VERBOSE >= 5;
364 } 388 }
365 } 389 }
366 390
367 my @pmi = keys %pmi; 391 my @pmi = keys %pmi;
368 @pm{@pmi} = delete @pmi{@pmi}; 392 @pm{@pmi} = delete @pmi{@pmi};
369} 393}
370 394
371############################################################################# 395#############################################################################
372# scan for AutoLoader and static archives 396# scan for AutoLoader, static archives and other dependencies
373 397
374sub scan_al { 398sub scan_al {
375 my ($auto, $autodir) = @_; 399 my ($auto, $autodir) = @_;
376 400
377 my $ix = "$autodir/autosplit.ix"; 401 my $ix = "$autodir/autosplit.ix";
402
403 print "processing autoload index for '$auto'\n"
404 if $VERBOSE >= 6;
378 405
379 $pm{"$auto/autosplit.ix"} = $ix; 406 $pm{"$auto/autosplit.ix"} = $ix;
380 407
381 open my $fh, "<:perlio", $ix 408 open my $fh, "<:perlio", $ix
382 or die "$ix: $!"; 409 or die "$ix: $!";
… …
388 my $al = "auto/$package/$1.al"; 415 my $al = "auto/$package/$1.al";
389 my $inc = find_inc $al; 416 my $inc = find_inc $al;
390 417
391 defined $inc or die "$al: autoload file not found, but should be there.\n"; 418 defined $inc or die "$al: autoload file not found, but should be there.\n";
392 419
393 $pm{$al} = "$inc/$al"; 420 $pm{$al} = $inc;
421 print "found autoload function '$al'\n"
422 if $VERBOSE >= 6;
394 423
395 } elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) { 424 } elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) {
396 ($package = $1) =~ s/::/\//g; 425 ($package = $1) =~ s/::/\//g;
397 } elsif (/^\s*(?:#|1?\s*;?\s*$)/) { 426 } elsif (/^\s*(?:#|1?\s*;?\s*$)/) {
398 # nop 427 # nop
399 } else { 428 } else {
400 warn "$ix: unparsable line, please report: $_"; 429 warn "WARNING: $ix: unparsable line, please report: $_";
401 } 430 }
402 } 431 }
403} 432}
404 433
405for my $pm (keys %pm) { 434for my $pm (keys %pm) {
406 if ($pm =~ /^(.*)\.pm$/) { 435 if ($pm =~ /^(.*)\.pm$/) {
407 my $auto = "auto/$1"; 436 my $auto = "auto/$1";
408 my $autodir = find_inc $auto; 437 my $autodir = find_inc $auto;
409 438
410 if (defined $autodir && -d "$autodir/$auto") { 439 if (defined $autodir && -d $autodir) {
411 $autodir = "$autodir/$auto";
412
413 # AutoLoader 440 # AutoLoader
414 scan_al $auto, $autodir 441 scan_al $auto, $autodir
415 if -f "$autodir/autosplit.ix"; 442 if -f "$autodir/autosplit.ix";
416 443
417 # extralibs.ld 444 # extralibs.ld
418 if (open my $fh, "<:perlio", "$autodir/extralibs.ld") { 445 if (open my $fh, "<:perlio", "$autodir/extralibs.ld") {
446 print "found extralibs for $pm\n"
447 if $VERBOSE >= 6;
448
419 local $/; 449 local $/;
420 $extralibs .= " " . <$fh>; 450 $extralibs .= " " . <$fh>;
421 } 451 }
422 452
423 $pm =~ /([^\/]+).pm$/ or die "$pm: unable to match last component"; 453 $pm =~ /([^\/]+).pm$/ or die "$pm: unable to match last component";
424 454
425 my $base = $1; 455 my $base = $1;
426 456
427 # static ext 457 # static ext
428 if (-f "$autodir/$base$Config{_a}") { 458 if (-f "$autodir/$base$Config{_a}") {
459 print "found static archive for $pm\n"
460 if $VERBOSE >= 3;
461
429 push @libs, "$autodir/$base$Config{_a}"; 462 push @libs, "$autodir/$base$Config{_a}";
430 push @static_ext, $pm; 463 push @static_ext, $pm;
431 } 464 }
432 465
433 # dynamic object 466 # dynamic object
434 die "ERROR: found shared object - can't link statically ($_)\n" 467 die "ERROR: found shared object - can't link statically ($_)\n"
435 if -f "$autodir/$base.$Config{dlext}"; 468 if -f "$autodir/$base.$Config{dlext}";
469
470 if ($PACKLIST && open my $fh, "<:perlio", "$autodir/.packlist") {
471 print "found .packlist for $pm\n"
472 if $VERBOSE >= 3;
473
474 while (<$fh>) {
475 chomp;
476 s/ .*$//; # newer-style .packlists might contain key=value pairs
477
478 # only include certain files (.al, .ix, .pm, .pl)
479 if (/\.(pm|pl|al|ix)$/) {
480 for my $inc (@INC) {
481 # in addition, we only add files that are below some @INC path
482 $inc =~ s/\/*$/\//;
483
484 if ($inc eq substr $_, 0, length $inc) {
485 my $base = substr $_, length $inc;
486 $pm{$base} = $_;
487
488 print "+ added .packlist dependency $base\n"
489 if $VERBOSE >= 3;
490 }
491
492 last;
493 }
494 }
495 }
496 }
436 } 497 }
437 } 498 }
438} 499}
439 500
440############################################################################# 501#############################################################################
502
503print "processing bundle files (try more -v power if you get bored waiting here)...\n"
504 if $VERBOSE >= 1;
441 505
442my $data; 506my $data;
443my @index; 507my @index;
444my @order = sort { 508my @order = sort {
445 length $a <=> length $b 509 length $a <=> length $b
… …
470 my $size = length $src; 534 my $size = length $src;
471 535
472 unless ($pmbin{$pm}) { # only do this unless the file is binary 536 unless ($pmbin{$pm}) { # only do this unless the file is binary
473 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { 537 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) {
474 if ($src =~ /^ unimpl \"/m) { 538 if ($src =~ /^ unimpl \"/m) {
475 warn "$pm: skipping (not implemented anyways).\n" 539 print "$pm: skipping (raises runtime error only).\n"
476 if $VERBOSE >= 2; 540 if $VERBOSE >= 3;
477 next; 541 next;
478 } 542 }
479 } 543 }
480 544
481 $src = cache "$UNISTRIP,$OPTIMISE_SIZE,$STRIP", $src, sub { 545 $src = cache +($STRIP eq "ppi" ? "$UNISTRIP,$OPTIMISE_SIZE" : undef), $src, sub {
482 if ($UNISTRIP && $pm =~ /^unicore\/.*\.pl$/) { 546 if ($UNISTRIP && $pm =~ /^unicore\/.*\.pl$/) {
547 print "applying unicore stripping $pm\n"
548 if $VERBOSE >= 6;
549
483 # special stripping for unicore swashes and properties 550 # special stripping for unicore swashes and properties
484 # much more could be done by going binary 551 # much more could be done by going binary
485 $src =~ s{ 552 $src =~ s{
486 (^return\ <<'END';\n) (.*?\n) (END(?:\n|\Z)) 553 (^return\ <<'END';\n) (.*?\n) (END(?:\n|\Z))
487 }{ 554 }{
… …
600 667
601 $src = $ppi->serialize; 668 $src = $ppi->serialize;
602 } else { 669 } else {
603 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n"; 670 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n";
604 } 671 }
605 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod 672 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses its own pod
606 require Pod::Strip; 673 require Pod::Strip;
607 674
608 my $stripper = Pod::Strip->new; 675 my $stripper = Pod::Strip->new;
609 676
610 my $out; 677 my $out;
… …
630# open my $fh, ">x" or die; print $fh $src;#d# 697# open my $fh, ">x" or die; print $fh $src;#d#
631# exit 1; 698# exit 1;
632# } 699# }
633 } 700 }
634 701
635 print "adding $pm{$pm} (original size $size, stored size ", length $src, ")\n" 702 print "adding $pm (original size $size, stored size ", length $src, ")\n"
636 if $VERBOSE >= 2; 703 if $VERBOSE >= 2;
637 704
638 push @index, ((length $pm) << 25) | length $data; 705 push @index, ((length $pm) << 25) | length $data;
639 $data .= $pm . $src; 706 $data .= $pm . $src;
640} 707}
641 708
642length $data < 2**25 709length $data < 2**25
643 or die "bundle too large (only 32MB supported)\n"; 710 or die "ERROR: bundle too large (only 32MB supported)\n";
644 711
645my $varpfx = "bundle_" . substr +(Digest::MD5::md5_hex $data), 0, 16; 712my $varpfx = "bundle_" . substr +(Digest::MD5::md5_hex $data), 0, 16;
646 713
647############################################################################# 714#############################################################################
648# output 715# output
649 716
650print "generating $PREFIX.h... "; 717print "generating $PREFIX.h... "
718 if $VERBOSE >= 1;
651 719
652{ 720{
653 open my $fh, ">", "$PREFIX.h" 721 open my $fh, ">", "$PREFIX.h"
654 or die "$PREFIX.h: $!\n"; 722 or die "$PREFIX.h: $!\n";
655 723
… …
667EXTERN_C void staticperl_cleanup (void); 735EXTERN_C void staticperl_cleanup (void);
668 736
669EOF 737EOF
670} 738}
671 739
672print "\n"; 740print "\n"
741 if $VERBOSE >= 1;
673 742
674############################################################################# 743#############################################################################
675# output 744# output
676 745
677print "generating $PREFIX.c... "; 746print "generating $PREFIX.c... "
747 if $VERBOSE >= 1;
678 748
679open my $fh, ">", "$PREFIX.c" 749open my $fh, ">", "$PREFIX.c"
680 or die "$PREFIX.c: $!\n"; 750 or die "$PREFIX.c: $!\n";
681 751
682print $fh <<EOF; 752print $fh <<EOF;
… …
712printf $fh "0x%08x\n};\n", (length $data); 782printf $fh "0x%08x\n};\n", (length $data);
713 783
714print $fh "static const char $varpfx\_data [] =\n"; 784print $fh "static const char $varpfx\_data [] =\n";
715dump_string $fh, $data; 785dump_string $fh, $data;
716 786
717print $fh ";\n\n";; 787print $fh ";\n\n";
718 788
719############################################################################# 789#############################################################################
720# bootstrap 790# bootstrap
721 791
722# boot file for staticperl 792# boot file for staticperl
… …
882 952
883int 953int
884main (int argc, char *argv []) 954main (int argc, char *argv [])
885{ 955{
886 extern char **environ; 956 extern char **environ;
957 int i, exitstatus;
958 char **args = malloc ((argc + 3) * sizeof (const char *));
959
960 args [0] = argv [0];
961 args [1] = "-e";
962 args [2] = "0";
963 args [3] = "--";
964
965 for (i = 1; i < argc; ++i)
966 args [i + 3] = argv [i];
967
968 PERL_SYS_INIT3 (&argc, &argv, &environ);
969 staticperl = perl_alloc ();
970 perl_construct (staticperl);
971
972 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
973
974 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc + 3, args, environ);
975 free (args);
976 if (!exitstatus)
977 perl_run (staticperl);
978
979 exitstatus = perl_destruct (staticperl);
980 perl_free (staticperl);
981 PERL_SYS_TERM ();
982
983 return exitstatus;
984}
985EOF
986} elsif ($PERL) {
987 print $fh <<EOF;
988
989int
990main (int argc, char *argv [])
991{
992 extern char **environ;
887 int exitstatus; 993 int exitstatus;
888 994
995 PERL_SYS_INIT3 (&argc, &argv, &environ);
996 staticperl = perl_alloc ();
997 perl_construct (staticperl);
998
999 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1000
1001 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
1002 if (!exitstatus)
1003 perl_run (staticperl);
1004
1005 exitstatus = perl_destruct (staticperl);
1006 perl_free (staticperl);
1007 PERL_SYS_TERM ();
1008
1009 return exitstatus;
1010}
1011EOF
1012} else {
1013 print $fh <<EOF;
1014
1015EXTERN_C void
1016staticperl_init (void)
1017{
889 static char *args[] = { 1018 static char *args[] = {
890 "staticperl", 1019 "staticperl",
891 "-e", 1020 "-e",
892 "0" 1021 "0"
893 }; 1022 };
894 1023
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; 1024 extern char **environ;
945 int argc = sizeof (args) / sizeof (args [0]); 1025 int argc = sizeof (args) / sizeof (args [0]);
946 char **argv = args; 1026 char **argv = args;
947
948 static char *args[] = {
949 "staticperl",
950 "-e",
951 "0"
952 };
953 1027
954 PERL_SYS_INIT3 (&argc, &argv, &environ); 1028 PERL_SYS_INIT3 (&argc, &argv, &environ);
955 staticperl = perl_alloc (); 1029 staticperl = perl_alloc ();
956 perl_construct (staticperl); 1030 perl_construct (staticperl);
957 PL_origalen = 1; 1031 PL_origalen = 1;
… …
970 PERL_SYS_TERM (); 1044 PERL_SYS_TERM ();
971} 1045}
972EOF 1046EOF
973} 1047}
974 1048
975print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n"; 1049print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n"
1050 if $VERBOSE >= 1;
976 1051
977############################################################################# 1052#############################################################################
978# libs, cflags 1053# libs, cflags
979 1054
980{ 1055{
981 print "generating $PREFIX.ccopts... "; 1056 print "generating $PREFIX.ccopts... "
1057 if $VERBOSE >= 1;
982 1058
983 my $str = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE"; 1059 my $str = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE";
984 $str =~ s/([\(\)])/\\$1/g; 1060 $str =~ s/([\(\)])/\\$1/g;
985
986 print "$str\n\n";
987 1061
988 open my $fh, ">$PREFIX.ccopts" 1062 open my $fh, ">$PREFIX.ccopts"
989 or die "$PREFIX.ccopts: $!"; 1063 or die "$PREFIX.ccopts: $!";
990 print $fh $str; 1064 print $fh $str;
1065
1066 print "$str\n\n"
1067 if $VERBOSE >= 1;
991} 1068}
992 1069
993{ 1070{
994 print "generating $PREFIX.ldopts... "; 1071 print "generating $PREFIX.ldopts... ";
995 1072
… …
1003 for (@staticlibs) { 1080 for (@staticlibs) {
1004 $str =~ s/(^|\s) (-l\Q$_\E) ($|\s)/$1-Wl,-Bstatic $2 -Wl,-Bdynamic$3/gx; 1081 $str =~ s/(^|\s) (-l\Q$_\E) ($|\s)/$1-Wl,-Bstatic $2 -Wl,-Bdynamic$3/gx;
1005 } 1082 }
1006 1083
1007 $str =~ s/([\(\)])/\\$1/g; 1084 $str =~ s/([\(\)])/\\$1/g;
1008
1009 print "$str\n\n";
1010 1085
1011 open my $fh, ">$PREFIX.ldopts" 1086 open my $fh, ">$PREFIX.ldopts"
1012 or die "$PREFIX.ldopts: $!"; 1087 or die "$PREFIX.ldopts: $!";
1013 print $fh $str; 1088 print $fh $str;
1089
1090 print "$str\n\n"
1091 if $VERBOSE >= 1;
1014} 1092}
1015 1093
1016if ($PERL or defined $APP) { 1094if ($PERL or defined $APP) {
1017 $APP = "perl" unless defined $APP; 1095 $APP = "perl" unless defined $APP;
1018 1096
1019 print "generating $APP...\n"; 1097 print "building $APP...\n"
1098 if $VERBOSE >= 1;
1020 1099
1021 system "$Config{cc} \$(cat bundle.ccopts\) -o \Q$APP\E bundle.c \$(cat bundle.ldopts\)"; 1100 system "$Config{cc} \$(cat bundle.ccopts\) -o \Q$APP\E bundle.c \$(cat bundle.ldopts\)";
1022 1101
1023# unlink "$PREFIX.$_" 1102 unlink "$PREFIX.$_"
1024# for qw(ccopts ldopts c h); 1103 for qw(ccopts ldopts c h);
1025 1104
1026 print "\n"; 1105 print "\n"
1106 if $VERBOSE >= 1;
1027} 1107}
1028 1108

Diff Legend

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