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

Comparing App-Staticperl/mkbundle (file contents):
Revision 1.12 by root, Fri Dec 10 20:29:17 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; 13our $PACKLIST = 0;
14our $IGNORE_ENV = 0;
15our $ALLOW_DYNAMIC = 0;
16our $HAVE_DYNAMIC; # maybe useful?
14 17
15our $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?
16 19
17our $CACHE; 20our $CACHE;
18our $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
… …
65 68
66 unless (fork) { 69 unless (fork) {
67 close $TRACER_R; 70 close $TRACER_R;
68 close $TRACER_W; 71 close $TRACER_W;
69 72
73 my $pkg = "pkg000000";
74
70 unshift @INC, sub { 75 unshift @INC, sub {
71 my $dir = find_incdir $_[1] 76 my $dir = find_incdir $_[1]
72 or return; 77 or return;
73 78
74 syswrite $W_TRACER, "-\n$dir\n$_[1]\n"; 79 syswrite $W_TRACER, "-\n$dir\n$_[1]\n";
75 80
76 open my $fh, "<:perlio", "$dir/$_[1]" 81 open my $fh, "<:raw:perlio", "$dir/$_[1]"
77 or warn "ERROR: $dir/$_[1]: $!\n"; 82 or warn "ERROR: $dir/$_[1]: $!\n";
78 83
79 $fh 84 $fh
80 }; 85 };
81 86
82 while (<$R_TRACER>) { 87 while (<$R_TRACER>) {
83 if (/use (.*)$/) { 88 if (/use (.*)$/) {
84 my $mod = $1; 89 my $mod = $1;
90 my $eval;
91
92 if ($mod =~ /^'.*'$/ or $mod =~ /^".*"$/) {
85 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;
86 warn "ERROR: $@ (while loading '$mod')\n" 102 warn "ERROR: $@ (while loading '$mod')\n"
87 if $@; 103 if $@;
88 } elsif (/eval (.*)$/) { 104 } elsif (/eval (.*)$/) {
89 my $eval = $1; 105 my $eval = $1;
90 eval $eval; 106 eval $eval;
… …
146 my ($variant, $src, $filter) = @_; 162 my ($variant, $src, $filter) = @_;
147 163
148 if (length $CACHE and 2048 <= length $src and defined $variant) { 164 if (length $CACHE and 2048 <= length $src and defined $variant) {
149 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";
150 166
151 if (open my $fh, "<:perlio", $file) { 167 if (open my $fh, "<:raw:perlio", $file) {
152 print "using cache for $file\n" 168 print "using cache for $file\n"
153 if $VERBOSE >= 7; 169 if $VERBOSE >= 7;
154 170
155 local $/; 171 local $/;
156 return <$fh>; 172 return <$fh>;
… …
159 $src = $filter->($src); 175 $src = $filter->($src);
160 176
161 print "creating cache entry $file\n" 177 print "creating cache entry $file\n"
162 if $VERBOSE >= 8; 178 if $VERBOSE >= 8;
163 179
164 if (open my $fh, ">:perlio", "$file~") { 180 if (open my $fh, ">:raw:perlio", "$file~") {
165 if ((syswrite $fh, $src) == length $src) { 181 if ((syswrite $fh, $src) == length $src) {
166 close $fh; 182 close $fh;
167 rename "$file~", $file; 183 rename "$file~", $file;
168 } 184 }
169 } 185 }
… …
176 192
177sub dump_string { 193sub dump_string {
178 my ($fh, $data) = @_; 194 my ($fh, $data) = @_;
179 195
180 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";
181 for ( 200 for (
182 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;
183 length (my $substr = substr $data, $ofs, 80); 212 length (my $substr = substr $data, $ofs, 80);
184 $ofs += 80 213 $ofs += 80
185 ) { 214 ) {
186 $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;
187 $substr =~ s/\?/\\?/g; # trigraphs... 216 $substr =~ s/\?/\\?/g; # trigraphs...
188 print $fh " \"$substr\"\n"; 217 print $fh " \"$substr\"\n";
218 }
189 } 219 }
190 } else { 220 } else {
191 print $fh " \"\"\n"; 221 print $fh " \"\"\n";
192 } 222 }
193} 223}
… …
230 my $path = "$_[0]/$_"; 260 my $path = "$_[0]/$_";
231 261
232 if (-d "$path/.") { 262 if (-d "$path/.") {
233 $scan->($path); 263 $scan->($path);
234 } else { 264 } else {
235 next unless /\.(?:pm|pl)$/;
236
237 $path = substr $path, $skip; 265 $path = substr $path, $skip;
238 push @tree, $path 266 push @tree, $path
239 unless exists $INCSKIP{$path}; 267 unless exists $INCSKIP{$path};
240 } 268 }
241 } 269 }
… …
262} 290}
263 291
264############################################################################# 292#############################################################################
265 293
266sub cmd_boot { 294sub cmd_boot {
267 $pm{"//boot"} = $_[0]; 295 $pm{"!boot"} = $_[0];
268} 296}
269 297
270sub cmd_add { 298sub cmd_add {
271 $_[0] =~ /^(.*)(?:\s+(\S+))$/ 299 $_[0] =~ /^(.*?)(?:\s+(\S+))?$/
272 or die "$_[0]: cannot parse"; 300 or die "$_[0]: cannot parse";
273 301
274 my $file = $1; 302 my $file = $1;
275 my $as = defined $2 ? $2 : "/$1"; 303 my $as = defined $2 ? $2 : $1;
276 304
277 $pm{$as} = $file; 305 $pm{$as} = $file;
278 $pmbin{$as} = 1 if $_[1]; 306 $pmbin{$as} = 1 if $_[1];
279} 307}
280 308
… …
294 322
295 for (get_inctrees) { 323 for (get_inctrees) {
296 my ($dir, $files) = @$_; 324 my ($dir, $files) = @$_;
297 325
298 $pm{$_} = "$dir/$_" 326 $pm{$_} = "$dir/$_"
299 for grep /$pattern/, @$files; 327 for grep /$pattern/ && /\.(pl|pm)$/, @$files;
300 } 328 }
301} 329}
302 330
303sub parse_argv; 331sub parse_argv;
304 332
… …
325 353
326use Getopt::Long; 354use Getopt::Long;
327 355
328sub parse_argv { 356sub parse_argv {
329 GetOptions 357 GetOptions
358 "perl" => \$PERL,
359 "app=s" => \$APP,
360
361 "verbose|v" => sub { ++$VERBOSE },
362 "quiet|q" => sub { --$VERBOSE },
363
330 "strip=s" => \$STRIP, 364 "strip=s" => \$STRIP,
331 "cache=s" => \$CACHE, # internal option 365 "cache=s" => \$CACHE, # internal option
332 "verbose|v" => sub { ++$VERBOSE },
333 "quiet|q" => sub { --$VERBOSE },
334 "perl" => \$PERL,
335 "app=s" => \$APP,
336 "eval|e=s" => sub { trace_eval $_[1] }, 366 "eval|e=s" => sub { trace_eval $_[1] },
337 "use|M=s" => sub { trace_module $_[1] }, 367 "use|M=s" => sub { trace_module $_[1] },
338 "boot=s" => sub { cmd_boot $_[1] }, 368 "boot=s" => sub { cmd_boot $_[1] },
339 "add=s" => sub { cmd_add $_[1], 0 }, 369 "add=s" => sub { cmd_add $_[1], 0 },
340 "addbin=s" => sub { cmd_add $_[1], 1 }, 370 "addbin=s" => sub { cmd_add $_[1], 1 },
341 "incglob=s" => sub { cmd_incglob $_[1] }, 371 "incglob=s" => sub { cmd_incglob $_[1] },
342 "include|i=s" => sub { cmd_include $_[1], 1 }, 372 "include|i=s" => sub { cmd_include $_[1], 1 },
343 "exclude|x=s" => sub { cmd_include $_[1], 0 }, 373 "exclude|x=s" => sub { cmd_include $_[1], 0 },
344 "static!" => \$STATIC,
345 "usepacklist!" => \$PACKLIST, 374 "usepacklists!" => \$PACKLIST,
375
376 "static!" => \$STATIC,
346 "staticlib=s" => sub { cmd_staticlib $_[1] }, 377 "staticlib=s" => sub { cmd_staticlib $_[1] },
378 "allow-dynamic!"=> \$ALLOW_DYNAMIC,
379 "ignore-env" => \$IGNORE_ENV,
380
347 "<>" => sub { cmd_file $_[0] }, 381 "<>" => sub { cmd_file $_[0] },
348 or exit 1; 382 or exit 1;
349} 383}
350 384
351Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); 385Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
352 386
… …
357 391
358# required for @INC loading, unfortunately 392# required for @INC loading, unfortunately
359trace_module "PerlIO::scalar"; 393trace_module "PerlIO::scalar";
360 394
361############################################################################# 395#############################################################################
362# include/exclude apply 396# apply include/exclude
363 397
364{ 398{
365 my %pmi; 399 my %pmi;
366 400
367 for (@incext) { 401 for (@incext) {
… …
377 if $VERBOSE >= 5; 411 if $VERBOSE >= 5;
378 } else { 412 } else {
379 # exclude 413 # exclude
380 delete @pm{@match}; 414 delete @pm{@match};
381 415
382 print "applying exclude $glob - excluded ", (scalar @match), " files.\n" 416 print "applying exclude $glob - removed ", (scalar @match), " files.\n"
383 if $VERBOSE >= 5; 417 if $VERBOSE >= 5;
384 } 418 }
385 } 419 }
386 420
387 my @pmi = keys %pmi; 421 my @pmi = keys %pmi;
388 @pm{@pmi} = delete @pmi{@pmi}; 422 @pm{@pmi} = delete @pmi{@pmi};
389} 423}
390 424
391############################################################################# 425#############################################################################
392# scan for AutoLoader and static archives 426# scan for AutoLoader, static archives and other dependencies
393 427
394sub scan_al { 428sub scan_al {
395 my ($auto, $autodir) = @_; 429 my ($auto, $autodir) = @_;
396 430
397 my $ix = "$autodir/autosplit.ix"; 431 my $ix = "$autodir/autosplit.ix";
… …
458 push @libs, "$autodir/$base$Config{_a}"; 492 push @libs, "$autodir/$base$Config{_a}";
459 push @static_ext, $pm; 493 push @static_ext, $pm;
460 } 494 }
461 495
462 # dynamic object 496 # dynamic object
463 die "ERROR: found shared object - can't link statically ($_)\n"
464 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 }
465 511
466 if ($PACKLIST && open my $fh, "<:perlio", "$autodir/.packlist") { 512 if ($PACKLIST && open my $fh, "<:perlio", "$autodir/.packlist") {
467 print "found .packlist for $pm\n" 513 print "found .packlist for $pm\n"
468 if $VERBOSE >= 3; 514 if $VERBOSE >= 3;
469 515
470 while (<$fh>) { 516 while (<$fh>) {
471 chomp; 517 chomp;
518 s/ .*$//; # newer-style .packlists might contain key=value pairs
472 519
473 # only include certain files (.al, .ix, .pm, .pl) 520 # only include certain files (.al, .ix, .pm, .pl)
474 if (/\.(pm|pl|al|ix)$/) { 521 if (/\.(pm|pl|al|ix)$/) {
475 for my $inc (@INC) { 522 for my $inc (@INC) {
476 # in addition, we only add files that are below some @INC path 523 # in addition, we only add files that are below some @INC path
… …
516 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";
517 564
518 my $src = ref $path 565 my $src = ref $path
519 ? $$path 566 ? $$path
520 : do { 567 : do {
521 open my $pm, "<", $path 568 open my $pm, "<:raw:perlio", $path
522 or die "$path: $!"; 569 or die "$path: $!";
523 570
524 local $/; 571 local $/;
525 572
526 <$pm> 573 <$pm>
… …
529 my $size = length $src; 576 my $size = length $src;
530 577
531 unless ($pmbin{$pm}) { # only do this unless the file is binary 578 unless ($pmbin{$pm}) { # only do this unless the file is binary
532 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { 579 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) {
533 if ($src =~ /^ unimpl \"/m) { 580 if ($src =~ /^ unimpl \"/m) {
534 print "$pm: skipping (only raises runtime error).\n" 581 print "$pm: skipping (raises runtime error only).\n"
535 if $VERBOSE >= 3; 582 if $VERBOSE >= 3;
536 next; 583 next;
537 } 584 }
538 } 585 }
539 586
… …
662 709
663 $src = $ppi->serialize; 710 $src = $ppi->serialize;
664 } else { 711 } else {
665 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n"; 712 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n";
666 } 713 }
667 } 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
668 require Pod::Strip; 715 require Pod::Strip;
669 716
670 my $stripper = Pod::Strip->new; 717 my $stripper = Pod::Strip->new;
671 718
672 my $out; 719 my $out;
… …
702} 749}
703 750
704length $data < 2**25 751length $data < 2**25
705 or die "ERROR: bundle too large (only 32MB supported)\n"; 752 or die "ERROR: bundle too large (only 32MB supported)\n";
706 753
707my $varpfx = "bundle_" . substr +(Digest::MD5::md5_hex $data), 0, 16; 754my $varpfx = "bundle";
708 755
709############################################################################# 756#############################################################################
710# output 757# output
711 758
712print "generating $PREFIX.h... " 759print "generating $PREFIX.h... "
… …
715{ 762{
716 open my $fh, ">", "$PREFIX.h" 763 open my $fh, ">", "$PREFIX.h"
717 or die "$PREFIX.h: $!\n"; 764 or die "$PREFIX.h: $!\n";
718 765
719 print $fh <<EOF; 766 print $fh <<EOF;
720/* do not edit, automatically created by mkstaticbundle */ 767/* do not edit, automatically created by staticperl */
721 768
722#include <EXTERN.h> 769#include <EXTERN.h>
723#include <perl.h> 770#include <perl.h>
724#include <XSUB.h> 771#include <XSUB.h>
725 772
726/* public API */ 773/* public API */
727EXTERN_C PerlInterpreter *staticperl; 774EXTERN_C PerlInterpreter *staticperl;
728EXTERN_C void staticperl_xs_init (pTHX); 775EXTERN_C void staticperl_xs_init (pTHX);
729EXTERN_C void staticperl_init (void); 776EXTERN_C void staticperl_init (XSINIT_t xs_init); /* argument can be 0 */
730EXTERN_C void staticperl_cleanup (void); 777EXTERN_C void staticperl_cleanup (void);
731 778
732EOF 779EOF
733} 780}
734 781
… …
743 790
744open my $fh, ">", "$PREFIX.c" 791open my $fh, ">", "$PREFIX.c"
745 or die "$PREFIX.c: $!\n"; 792 or die "$PREFIX.c: $!\n";
746 793
747print $fh <<EOF; 794print $fh <<EOF;
748/* do not edit, automatically created by mkstaticbundle */ 795/* do not edit, automatically created by staticperl */
749 796
750#include "bundle.h" 797#include "bundle.h"
751 798
752/* public API */ 799/* public API */
753PerlInterpreter *staticperl; 800PerlInterpreter *staticperl;
… …
785# bootstrap 832# bootstrap
786 833
787# boot file for staticperl 834# boot file for staticperl
788# this file will be eval'ed at initialisation time 835# this file will be eval'ed at initialisation time
789 836
837# lines marked with "^D" are only used when $HAVE_DYNAMIC
790my $bootstrap = ' 838my $bootstrap = '
791BEGIN { 839BEGIN {
792 package ' . $PACKAGE . '; 840 package ' . $PACKAGE . ';
793 841
794 PerlIO::scalar->bootstrap; 842 # the path prefix to use when putting files into %INC
843 our $inc_prefix;
795 844
796 @INC = sub { 845 # the @INC hook to use when we have PerlIO::scalar available
846 my $perlio_inc = sub {
797 my $data = find "$_[1]" 847 my $data = find "$_[1]"
798 or return; 848 or return;
799 849
800 $INC{$_[1]} = $_[1]; 850 $INC{$_[1]} = "$inc_prefix$_[1]";
801 851
802 open my $fh, "<", \$data; 852 open my $fh, "<", \$data;
803 $fh 853 $fh
804 }; 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 }
805} 884}
806'; 885';
807 886
808$bootstrap .= "require '//boot';" 887$bootstrap .= "require '!boot';"
809 if exists $pm{"//boot"}; 888 if exists $pm{"!boot"};
810 889
890if ($HAVE_DYNAMIC) {
891 $bootstrap =~ s/^D/ /mg;
892} else {
893 $bootstrap =~ s/^D.*$//mg;
894}
895
896$bootstrap =~ s/#.*$//mg;
811$bootstrap =~ s/\s+/ /g; 897$bootstrap =~ s/\s+/ /g;
812$bootstrap =~ s/(\W) /$1/g; 898$bootstrap =~ s/(\W) /$1/g;
813$bootstrap =~ s/ (\W)/$1/g; 899$bootstrap =~ s/ (\W)/$1/g;
814 900
815print $fh "const char bootstrap [] = "; 901print $fh "const char bootstrap [] = ";
… …
861 } 947 }
862 948
863 XSRETURN (0); 949 XSRETURN (0);
864 950
865 found: 951 found:
866 ST (0) = res; 952 ST (0) = sv_2mortal (res);
867 sv_2mortal (ST (0));
868 } 953 }
869 954
870 XSRETURN (1); 955 XSRETURN (1);
871} 956}
872 957
… …
885 970
886 for (i = 0; i < $varpfx\_count; ++i) 971 for (i = 0; i < $varpfx\_count; ++i)
887 { 972 {
888 U32 idx = $varpfx\_index [i]; 973 U32 idx = $varpfx\_index [i];
889 974
890 PUSHs (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25)); 975 PUSHs (sv_2mortal (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25)));
891 } 976 }
892 } 977 }
893 978
894 XSRETURN ($varpfx\_count); 979 XSRETURN ($varpfx\_count);
895} 980}
… …
903void 988void
904staticperl_xs_init (pTHX) 989staticperl_xs_init (pTHX)
905{ 990{
906EOF 991EOF
907 992
908@static_ext = ("DynaLoader", sort @static_ext); 993@static_ext = sort @static_ext;
909 994
910# prototypes 995# prototypes
911for (@static_ext) { 996for (@static_ext) {
912 s/\.pm$//; 997 s/\.pm$//;
913 (my $cname = $_) =~ s/\//__/g; 998 (my $cname = $_) =~ s/\//__/g;
… …
927 s/\.pm$//; 1012 s/\.pm$//;
928 1013
929 (my $cname = $_) =~ s/\//__/g; 1014 (my $cname = $_) =~ s/\//__/g;
930 (my $pname = $_) =~ s/\//::/g; 1015 (my $pname = $_) =~ s/\//::/g;
931 1016
932 my $bootstrap = $pname eq "DynaLoader" ? "boot" : "bootstrap"; 1017 my $bootstrap = $pname eq "DynaLoader" ? "boot_DynaLoader" : "bootstrap";
933 1018
934 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n"; 1019 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n";
935} 1020}
936 1021
937print $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
938 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);
939} 1037}
940EOF 1038EOF
941 1039
942############################################################################# 1040#############################################################################
943# optional perl_init/perl_destroy 1041# optional perl_init/perl_destroy
944 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
945if ($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) {
946 print $fh <<EOF; 1097 print $fh <<EOF;
947 1098
948int 1099int
949main (int argc, char *argv []) 1100main (int argc, char *argv [])
950{ 1101{
951 extern char **environ; 1102 extern char **environ;
952 int exitstatus; 1103 int exitstatus;
953 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{
954 static char *args[] = { 1129 static char *args[] = {
955 "staticperl", 1130 "staticperl",
956 "-e", 1131 "-e",
957 "0" 1132 "0"
958 }; 1133 };
959 1134
960 PERL_SYS_INIT3 (&argc, &argv, &environ);
961 staticperl = perl_alloc ();
962 perl_construct (staticperl);
963
964 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
965
966 exitstatus = perl_parse (staticperl, staticperl_xs_init, sizeof (args) / sizeof (*args), args, environ);
967 if (!exitstatus)
968 perl_run (staticperl);
969
970 exitstatus = perl_destruct (staticperl);
971 perl_free (staticperl);
972 PERL_SYS_TERM ();
973
974 return exitstatus;
975}
976EOF
977} elsif ($PERL) {
978 print $fh <<EOF;
979
980int
981main (int argc, char *argv [])
982{
983 extern char **environ;
984 int exitstatus;
985
986 PERL_SYS_INIT3 (&argc, &argv, &environ);
987 staticperl = perl_alloc ();
988 perl_construct (staticperl);
989
990 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
991
992 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
993 if (!exitstatus)
994 perl_run (staticperl);
995
996 exitstatus = perl_destruct (staticperl);
997 perl_free (staticperl);
998 PERL_SYS_TERM ();
999
1000 return exitstatus;
1001}
1002EOF
1003} else {
1004 print $fh <<EOF;
1005
1006EXTERN_C void
1007staticperl_init (void)
1008{
1009 extern char **environ; 1135 extern char **environ;
1010 int argc = sizeof (args) / sizeof (args [0]); 1136 int argc = sizeof (args) / sizeof (args [0]);
1011 char **argv = args; 1137 char **argv = args;
1012 1138
1013 static char *args[] = { 1139$IGNORE_ENV
1014 "staticperl",
1015 "-e",
1016 "0"
1017 };
1018
1019 PERL_SYS_INIT3 (&argc, &argv, &environ); 1140 PERL_SYS_INIT3 (&argc, &argv, &environ);
1020 staticperl = perl_alloc (); 1141 staticperl = perl_alloc ();
1021 perl_construct (staticperl); 1142 perl_construct (staticperl);
1022 PL_origalen = 1; 1143 PL_origalen = 1;
1023 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1144 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1145 PL_oldname = (char *)xs_init;
1024 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ); 1146 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
1025 1147
1026 perl_run (staticperl); 1148 perl_run (staticperl);
1027} 1149}
1028 1150
… …
1035 PERL_SYS_TERM (); 1157 PERL_SYS_TERM ();
1036} 1158}
1037EOF 1159EOF
1038} 1160}
1039 1161
1162close $fh;
1163
1040print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n" 1164print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n"
1041 if $VERBOSE >= 1; 1165 if $VERBOSE >= 1;
1042 1166
1043############################################################################# 1167#############################################################################
1044# libs, cflags 1168# libs, cflags
1169
1170my $ccopts;
1045 1171
1046{ 1172{
1047 print "generating $PREFIX.ccopts... " 1173 print "generating $PREFIX.ccopts... "
1048 if $VERBOSE >= 1; 1174 if $VERBOSE >= 1;
1049 1175
1050 my $str = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE"; 1176 $ccopts = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE";
1051 $str =~ s/([\(\)])/\\$1/g; 1177 $ccopts =~ s/([\(\)])/\\$1/g;
1052 1178
1053 open my $fh, ">$PREFIX.ccopts" 1179 open my $fh, ">$PREFIX.ccopts"
1054 or die "$PREFIX.ccopts: $!"; 1180 or die "$PREFIX.ccopts: $!";
1055 print $fh $str; 1181 print $fh $ccopts;
1056 1182
1057 print "$str\n\n" 1183 print "$ccopts\n\n"
1058 if $VERBOSE >= 1; 1184 if $VERBOSE >= 1;
1059} 1185}
1186
1187my $ldopts;
1060 1188
1061{ 1189{
1062 print "generating $PREFIX.ldopts... "; 1190 print "generating $PREFIX.ldopts... ";
1063 1191
1064 my $str = $STATIC ? "-static " : ""; 1192 $ldopts = $STATIC ? "-static " : "";
1065 1193
1066 $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}";
1067 1195
1068 my %seen; 1196 my %seen;
1069 $str .= " $_" for grep !$seen{$_}++, ($extralibs =~ /(\S+)/g); 1197 $ldopts .= " $_" for reverse grep !$seen{$_}++, reverse +($extralibs =~ /(\S+)/g);
1070 1198
1071 for (@staticlibs) { 1199 for (@staticlibs) {
1072 $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;
1073 } 1201 }
1074 1202
1075 $str =~ s/([\(\)])/\\$1/g; 1203 $ldopts =~ s/([\(\)])/\\$1/g;
1076 1204
1077 open my $fh, ">$PREFIX.ldopts" 1205 open my $fh, ">$PREFIX.ldopts"
1078 or die "$PREFIX.ldopts: $!"; 1206 or die "$PREFIX.ldopts: $!";
1079 print $fh $str; 1207 print $fh $ldopts;
1080 1208
1081 print "$str\n\n" 1209 print "$ldopts\n\n"
1082 if $VERBOSE >= 1; 1210 if $VERBOSE >= 1;
1083} 1211}
1084 1212
1085if ($PERL or defined $APP) { 1213if ($PERL or defined $APP) {
1086 $APP = "perl" unless defined $APP; 1214 $APP = "perl" unless defined $APP;
1087 1215
1216 my $build = "$Config{cc} $ccopts -o \Q$APP\E$Config{_exe} bundle.c $ldopts";
1217
1088 print "building $APP...\n" 1218 print "build $APP...\n"
1089 if $VERBOSE >= 1; 1219 if $VERBOSE >= 1;
1090 1220
1091 system "$Config{cc} \$(cat bundle.ccopts\) -o \Q$APP\E bundle.c \$(cat bundle.ldopts\)"; 1221 print "$build\n"
1222 if $VERBOSE >= 2;
1223
1224 system $build;
1092 1225
1093 unlink "$PREFIX.$_" 1226 unlink "$PREFIX.$_"
1094 for qw(ccopts ldopts c h); 1227 for qw(ccopts ldopts c h);
1095 1228
1096 print "\n" 1229 print "\n"

Diff Legend

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