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.1 by root, Mon Dec 6 19:33:57 2010 UTC vs.
Revision 1.10 by root, Thu Dec 9 09:51:32 2010 UTC

… …
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 $PERL = 0; 8our $PERL = 0;
9our $APP;
9our $VERIFY = 0; 10our $VERIFY = 0;
10our $STATIC = 0; 11our $STATIC = 0;
11 12
12my $PREFIX = "bundle"; 13my $PREFIX = "bundle";
13my $PACKAGE = "static"; 14my $PACKAGE = "static";
14 15
15my %pm; 16my %pm;
17my %pmbin;
16my @libs; 18my @libs;
17my @static_ext; 19my @static_ext;
18my $extralibs; 20my $extralibs;
21my @staticlibs;
22my @incext;
19 23
20@ARGV 24@ARGV
21 or die "$0: use 'staticperl help' (or read the sources of staticperl)\n"; 25 or die "$0: use 'staticperl help' (or read the sources of staticperl)\n";
22 26
23$|=1; 27$|=1;
… …
76} 80}
77 81
78# module loading is now safe 82# module loading is now safe
79use Config; 83use Config;
80 84
85sub scan_al {
86 my ($auto, $autodir, $ix) = @_;
87
88 $pm{"$auto/$ix"} = "$autodir/$ix";
89
90 open my $fh, "<:perlio", "$autodir/$ix"
91 or die "$autodir/$ix: $!";
92
93 my $package;
94
95 while (<$fh>) {
96 if (/^\s*sub\s+ ([^[:space:];]+) \s* (?:\([^)]*\))? \s*;?\s*$/x) {
97 my $al = "auto/$package/$1.al";
98 my $inc = find_inc $al;
99
100 defined $inc or die "$al: autoload file not found, but should be there.\n";
101
102 $pm{$al} = "$inc/$al";
103
104 } elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) {
105 ($package = $1) =~ s/::/\//g;
106 } elsif (/^\s*(?:#|1?\s*;?\s*$)/) {
107 # nop
108 } else {
109 warn "$autodir/$ix: unparsable line, please report: $_";
110 }
111 }
112}
113
81sub trace_module { 114sub trace_module {
82 syswrite $TRACER_W, "use $_[0]\n"; 115 syswrite $TRACER_W, "use $_[0]\n";
83 116
84 for (;;) { 117 for (;;) {
85 <$TRACER_R> =~ /^-$/ or last; 118 <$TRACER_R> =~ /^-$/ or last;
… …
96 opendir my $dir, $autodir 129 opendir my $dir, $autodir
97 or die "$autodir: $!\n"; 130 or die "$autodir: $!\n";
98 131
99 for (readdir $dir) { 132 for (readdir $dir) {
100 # AutoLoader 133 # AutoLoader
101 $pm{"$auto/$_"} = "$autodir/$_" 134 scan_al $auto, $autodir, $_
102 if /\.(?:al|ix)$/; 135 if /\.ix$/;
103 136
104 # static ext 137 # static ext
105 if (/\Q$Config{_a}\E$/o) { 138 if (/\Q$Config{_a}\E$/o) {
106 push @libs, "$autodir/$_"; 139 push @libs, "$autodir/$_";
107 push @static_ext, $name; 140 push @static_ext, $name;
… …
117 } 150 }
118 151
119 # dynamic object 152 # dynamic object
120 warn "WARNING: found shared object - can't link statically ($_)\n" 153 warn "WARNING: found shared object - can't link statically ($_)\n"
121 if /\.\Q$Config{dlext}\E$/o; 154 if /\.\Q$Config{dlext}\E$/o;
122
123 #TODO: extralibs?
124 } 155 }
125 } 156 }
126 } 157 }
127 } 158 }
128} 159}
… …
171sub cmd_boot { 202sub cmd_boot {
172 $pm{"//boot"} = $_[0]; 203 $pm{"//boot"} = $_[0];
173} 204}
174 205
175sub cmd_add { 206sub cmd_add {
176 $_[0] =~ /^(.*)(?:\s*(\S+))$/ 207 $_[0] =~ /^(.*)(?:\s+(\S+))$/
177 or die "$_[0]: cannot parse"; 208 or die "$_[0]: cannot parse";
178 209
179 my $file = $1; 210 my $file = $1;
180 my $as = defined $2 ? $2 : "/$1"; 211 my $as = defined $2 ? $2 : "/$1";
181 212
182 $pm{$as} = $file; 213 $pm{$as} = $file;
214 $pmbin{$as} = 1 if $_[1];
215}
216
217sub cmd_staticlib {
218 push @staticlibs, $_
219 for split /\s+/, $_[0];
183} 220}
184 221
185sub cmd_file { 222sub cmd_file {
186 open my $fh, "<", $_[0] 223 open my $fh, "<", $_[0]
187 or die "$_[0]: $!\n"; 224 or die "$_[0]: $!\n";
188 225
189 while (<$fh>) { 226 while (<$fh>) {
190 chomp; 227 chomp;
191 my ($cmd, $args) = split / /, $_, 2; 228 my ($cmd, $args) = split / /, $_, 2;
229 $cmd =~ s/^-+//;
192 230
193 if ($cmd eq "strip") { 231 if ($cmd eq "strip") {
194 $STRIP = $args; 232 $STRIP = $args;
233 } elsif ($cmd eq "perl") {
234 $PERL = 1;
235 } elsif ($cmd eq "app") {
236 $APP = $args;
195 } elsif ($cmd eq "eval") { 237 } elsif ($cmd eq "eval") {
196 trace_eval $_; 238 trace_eval $_;
197 } elsif ($cmd eq "use") { 239 } elsif ($cmd eq "use") {
198 trace_module $_ 240 trace_module $_
199 for split / /, $args; 241 for split / /, $args;
242 } elsif ($cmd eq "staticlib") {
243 cmd_staticlib $args;
200 } elsif ($cmd eq "boot") { 244 } elsif ($cmd eq "boot") {
201 cmd_boot $args; 245 cmd_boot $args;
202 } elsif ($cmd eq "static") { 246 } elsif ($cmd eq "static") {
203 $STATIC = 1; 247 $STATIC = 1;
204 } elsif ($cmd eq "add") { 248 } elsif ($cmd eq "add") {
205 cmd_add $args; 249 cmd_add $args, 0;
250 } elsif ($cmd eq "addbin") {
251 cmd_add $args, 1;
206 } elsif (/^\s*#/) { 252 } elsif (/^\s*#/) {
207 # comment 253 # comment
208 } elsif (/\S/) { 254 } elsif (/\S/) {
209 die "$_: unsupported directive\n"; 255 die "$_: unsupported directive\n";
210 } 256 }
… …
214use Getopt::Long; 260use Getopt::Long;
215 261
216Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); 262Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
217 263
218GetOptions 264GetOptions
219 "strip=s" => \$STRIP, 265 "strip=s" => \$STRIP,
220 "verbose|v" => sub { ++$VERBOSE }, 266 "verbose|v" => sub { ++$VERBOSE },
221 "quiet|q" => sub { --$VERBOSE }, 267 "quiet|q" => sub { --$VERBOSE },
222 "perl" => \$PERL, 268 "perl" => \$PERL,
269 "app=s" => \$APP,
223 "eval=s" => sub { trace_eval $_[1] }, 270 "eval|e=s" => sub { trace_eval $_[1] },
224 "use|M=s" => sub { trace_module $_[1] }, 271 "use|M=s" => sub { trace_module $_[1] },
225 "boot=s" => sub { cmd_boot $_[1] }, 272 "boot=s" => sub { cmd_boot $_[1] },
226 "add=s" => sub { cmd_add $_[1] }, 273 "add=s" => sub { cmd_add $_[1], 0 },
274 "addbin=s" => sub { cmd_add $_[1], 1 },
227 "static" => sub { $STATIC = 1 }, 275 "static" => sub { $STATIC = 1 },
276 "staticlib=s" => sub { cmd_staticlib $_[1] },
228 "<>" => sub { cmd_file $_[1] }, 277 "<>" => sub { cmd_file $_[0] },
229 or exit 1; 278 or exit 1;
279
280die "cannot specify both --app and --perl\n"
281 if $PERL and defined $APP;
230 282
231my $data; 283my $data;
232my @index; 284my @index;
233my @order = sort { 285my @order = sort {
234 length $a <=> length $b 286 length $a <=> length $b
… …
246 or die "$pm: path too long (only 128 octets supported)\n"; 298 or die "$pm: path too long (only 128 octets supported)\n";
247 299
248 my $src = ref $path 300 my $src = ref $path
249 ? $$path 301 ? $$path
250 : do { 302 : do {
251 open my $pm, "<:perlio", $path 303 open my $pm, "<", $path
252 or die "$path: $!"; 304 or die "$path: $!";
253 305
254 local $/; 306 local $/;
255 307
256 <$pm> 308 <$pm>
257 }; 309 };
258 310
311 unless ($pmbin{$pm}) { # only do this unless the file is binary
312
259 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { 313 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) {
260 if ($src =~ /^ unimpl \"/m) { 314 if ($src =~ /^ unimpl \"/m) {
261 warn "$pm: skipping (not implemented anyways).\n" 315 warn "$pm: skipping (not implemented anyways).\n"
262 if $VERBOSE >= 2; 316 if $VERBOSE >= 2;
263 next; 317 next;
264 }
265 }
266
267 if ($STRIP =~ /ppi/i) {
268 require PPI;
269
270 my $ppi = PPI::Document->new (\$src);
271 $ppi->prune ("PPI::Token::Comment");
272 $ppi->prune ("PPI::Token::Pod");
273
274 # prune END stuff
275 for (my $last = $ppi->last_element; $last; ) {
276 my $prev = $last->previous_token;
277
278 if ($last->isa (PPI::Token::Whitespace::)) {
279 $last->delete;
280 } elsif ($last->isa (PPI::Statement::End::)) {
281 $last->delete;
282 last;
283 } elsif ($last->isa (PPI::Token::Pod::)) {
284 $last->delete;
285 } else {
286 last;
287 } 318 }
319 }
288 320
321 if ($STRIP =~ /ppi/i) {
322 require PPI;
323
324 my $ppi = PPI::Document->new (\$src);
325 $ppi->prune ("PPI::Token::Comment");
326 $ppi->prune ("PPI::Token::Pod");
327
328 # prune END stuff
329 for (my $last = $ppi->last_element; $last; ) {
330 my $prev = $last->previous_token;
331
332 if ($last->isa (PPI::Token::Whitespace::)) {
333 $last->delete;
334 } elsif ($last->isa (PPI::Statement::End::)) {
335 $last->delete;
336 last;
337 } elsif ($last->isa (PPI::Token::Pod::)) {
338 $last->delete;
339 } else {
340 last;
341 }
342
289 $last = $prev; 343 $last = $prev;
290 } 344 }
291 345
292 # prune some but not all insignificant whitespace 346 # prune some but not all insignificant whitespace
293 for my $ws (@{ $ppi->find (PPI::Token::Whitespace::) }) { 347 for my $ws (@{ $ppi->find (PPI::Token::Whitespace::) }) {
294 my $prev = $ws->previous_token; 348 my $prev = $ws->previous_token;
295 my $next = $ws->next_token; 349 my $next = $ws->next_token;
296 350
297 if (!$prev || !$next) { 351 if (!$prev || !$next) {
298 $ws->delete;
299 } else {
300 if (
301 $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float
302 or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/
303 or $prev->isa (PPI::Token::Structure::)
304 # decrease size, decrease compressability
305 #or ($prev->isa (PPI::Token::Word::)
306 # && (PPI::Token::Symbol:: eq ref $next
307 # || $next->isa (PPI::Structure::Block::)
308 # || $next->isa (PPI::Structure::List::)
309 # || $next->isa (PPI::Structure::Condition::)))
310 ) {
311 $ws->delete; 352 $ws->delete;
312 } elsif ($prev->isa (PPI::Token::Whitespace::)) {
313 $ws->{content} = ' ';
314 $prev->delete;
315 } else { 353 } else {
354 if (
355 $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float
356 or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/
357 or $prev->isa (PPI::Token::Structure::)
358 # decrease size, decrease compressability
359 #or ($prev->isa (PPI::Token::Word::)
360 # && (PPI::Token::Symbol:: eq ref $next
361 # || $next->isa (PPI::Structure::Block::)
362 # || $next->isa (PPI::Structure::List::)
363 # || $next->isa (PPI::Structure::Condition::)))
364 ) {
365 $ws->delete;
366 } elsif ($prev->isa (PPI::Token::Whitespace::)) {
316 $ws->{content} = ' '; 367 $ws->{content} = ' ';
368 $prev->delete;
369 } else {
370 $ws->{content} = ' ';
371 }
317 } 372 }
318 } 373 }
319 }
320 374
321 # prune whitespace around blocks 375 # prune whitespace around blocks
322 if (0) { 376 if (0) {
323 # these usually decrease size, but decrease compressability more 377 # these usually decrease size, but decrease compressability more
324 for my $struct (PPI::Structure::Block::, PPI::Structure::Condition::) { 378 for my $struct (PPI::Structure::Block::, PPI::Structure::Condition::) {
325 for my $node (@{ $ppi->find ($struct) }) { 379 for my $node (@{ $ppi->find ($struct) }) {
380 my $n1 = $node->first_token;
381 my $n2 = $n1->previous_token;
382 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
383 $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
384 my $n1 = $node->last_token;
385 my $n2 = $n1->next_token;
386 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
387 $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
388 }
389 }
390
391 for my $node (@{ $ppi->find (PPI::Structure::List::) }) {
326 my $n1 = $node->first_token; 392 my $n1 = $node->first_token;
327 my $n2 = $n1->previous_token;
328 $n1->delete if $n1->isa (PPI::Token::Whitespace::); 393 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
329 $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
330 my $n1 = $node->last_token; 394 my $n1 = $node->last_token;
331 my $n2 = $n1->next_token;
332 $n1->delete if $n1->isa (PPI::Token::Whitespace::); 395 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
333 $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
334 } 396 }
335 } 397 }
336 398
399 # reformat qw() lists which often have lots of whitespace
337 for my $node (@{ $ppi->find (PPI::Structure::List::) }) { 400 for my $node (@{ $ppi->find (PPI::Token::QuoteLike::Words::) }) {
338 my $n1 = $node->first_token; 401 if ($node->{content} =~ /^qw(.)(.*)(.)$/s) {
339 $n1->delete if $n1->isa (PPI::Token::Whitespace::); 402 my ($a, $qw, $b) = ($1, $2, $3);
340 my $n1 = $node->last_token; 403 $qw =~ s/^\s+//;
341 $n1->delete if $n1->isa (PPI::Token::Whitespace::); 404 $qw =~ s/\s+$//;
405 $qw =~ s/\s+/ /g;
406 $node->{content} = "qw$a$qw$b";
407 }
342 } 408 }
343 }
344 409
345 # reformat qw() lists which often have lots of whitespace 410 $src = $ppi->serialize;
346 for my $node (@{ $ppi->find (PPI::Token::QuoteLike::Words::) }) { 411 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod
347 if ($node->{content} =~ /^qw(.)(.*)(.)$/s) { 412 require Pod::Strip;
348 my ($a, $qw, $b) = ($1, $2, $3); 413
349 $qw =~ s/^\s+//; 414 my $stripper = Pod::Strip->new;
350 $qw =~ s/\s+$//; 415
351 $qw =~ s/\s+/ /g; 416 my $out;
352 $node->{content} = "qw$a$qw$b"; 417 $stripper->output_string (\$out);
418 $stripper->parse_string_document ($src)
419 or die;
420 $src = $out;
421 }
422
423 if ($VERIFY && $pm =~ /\.pm$/ && $pm ne "Opcode.pm") {
424 if (open my $fh, "-|") {
425 <$fh>;
426 } else {
427 eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n";
428 exit 0;
353 } 429 }
354 } 430 }
355 431
356 $src = $ppi->serialize; 432# if ($pm eq "Opcode.pm") {
357 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod 433# open my $fh, ">x" or die; print $fh $src;#d#
358 require Pod::Strip; 434# exit 1;
359 435# }
360 my $stripper = Pod::Strip->new;
361
362 my $out;
363 $stripper->output_string (\$out);
364 $stripper->parse_string_document ($src);
365 $src = $out;
366 } 436 }
367
368 if ($VERIFY && $pm =~ /\.pm$/ && $pm ne "Opcode.pm") {
369 if (open my $fh, "-|") {
370 <$fh>;
371 } else {
372 eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n";
373 exit 0;
374 }
375 }
376
377# if ($pm eq "Opcode.pm") {
378# open my $fh, ">x" or die; print $fh $src;#d#
379# exit 1;
380# }
381 437
382 warn "adding $pm\n" 438 warn "adding $pm\n"
383 if $VERBOSE >= 2; 439 if $VERBOSE >= 2;
384 440
385 push @index, ((length $pm) << 25) | length $data; 441 push @index, ((length $pm) << 25) | length $data;
… …
400 open my $fh, ">", "$PREFIX.h" 456 open my $fh, ">", "$PREFIX.h"
401 or die "$PREFIX.h: $!\n"; 457 or die "$PREFIX.h: $!\n";
402 458
403 print $fh <<EOF; 459 print $fh <<EOF;
404/* do not edit, automatically created by mkstaticbundle */ 460/* do not edit, automatically created by mkstaticbundle */
461
405#include <EXTERN.h> 462#include <EXTERN.h>
406#include <perl.h> 463#include <perl.h>
407#include <XSUB.h> 464#include <XSUB.h>
408 465
409/* public API */ 466/* public API */
410EXTERN_C PerlInterpreter *staticperl; 467EXTERN_C PerlInterpreter *staticperl;
468EXTERN_C void staticperl_xs_init (pTHX);
411EXTERN_C void staticperl_init (void); 469EXTERN_C void staticperl_init (void);
412EXTERN_C void staticperl_cleanup (void); 470EXTERN_C void staticperl_cleanup (void);
471
413EOF 472EOF
414} 473}
415 474
416print "\n"; 475print "\n";
417 476
… …
423open my $fh, ">", "$PREFIX.c" 482open my $fh, ">", "$PREFIX.c"
424 or die "$PREFIX.c: $!\n"; 483 or die "$PREFIX.c: $!\n";
425 484
426print $fh <<EOF; 485print $fh <<EOF;
427/* do not edit, automatically created by mkstaticbundle */ 486/* do not edit, automatically created by mkstaticbundle */
428
429#include <EXTERN.h>
430#include <perl.h>
431#include <XSUB.h>
432 487
433#include "bundle.h" 488#include "bundle.h"
434 489
435/* public API */ 490/* public API */
436PerlInterpreter *staticperl; 491PerlInterpreter *staticperl;
… …
575 } 630 }
576 631
577 XSRETURN ($varpfx\_count); 632 XSRETURN ($varpfx\_count);
578} 633}
579 634
580static char *args[] = {
581 "staticperl",
582 "-e",
583 "0"
584};
585
586EOF 635EOF
587 636
588############################################################################# 637#############################################################################
589# xs_init 638# xs_init
590 639
591print $fh <<EOF; 640print $fh <<EOF;
592static void 641void
593xs_init (pTHX) 642staticperl_xs_init (pTHX)
594{ 643{
595EOF 644EOF
596 645
597@static_ext = ("DynaLoader", sort @static_ext); 646@static_ext = ("DynaLoader", sort @static_ext);
598 647
… …
629EOF 678EOF
630 679
631############################################################################# 680#############################################################################
632# optional perl_init/perl_destroy 681# optional perl_init/perl_destroy
633 682
634if ($PERL) { 683if ($APP) {
635 print $fh <<EOF; 684 print $fh <<EOF;
636 685
637int 686int
638main (int argc, char *argv []) 687main (int argc, char *argv [])
639{ 688{
640 extern char **environ; 689 extern char **environ;
641 int exitstatus; 690 int exitstatus;
691
692 static char *args[] = {
693 "staticperl",
694 "-e",
695 "0"
696 };
642 697
643 PERL_SYS_INIT3 (&argc, &argv, &environ); 698 PERL_SYS_INIT3 (&argc, &argv, &environ);
644 staticperl = perl_alloc (); 699 staticperl = perl_alloc ();
645 perl_construct (staticperl); 700 perl_construct (staticperl);
646 701
647 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 702 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
648 703
649 exitstatus = perl_parse (staticperl, xs_init, argc, argv, environ); 704 exitstatus = perl_parse (staticperl, staticperl_xs_init, sizeof (args) / sizeof (*args), args, environ);
650 if (!exitstatus) 705 if (!exitstatus)
651 perl_run (staticperl); 706 perl_run (staticperl);
652 707
653 exitstatus = perl_destruct (staticperl); 708 exitstatus = perl_destruct (staticperl);
654 perl_free (staticperl); 709 perl_free (staticperl);
655 PERL_SYS_TERM (); 710 PERL_SYS_TERM ();
656 711
657 return exitstatus; 712 return exitstatus;
658} 713}
659EOF 714EOF
715} elsif ($PERL) {
716 print $fh <<EOF;
717
718int
719main (int argc, char *argv [])
720{
721 extern char **environ;
722 int exitstatus;
723
724 PERL_SYS_INIT3 (&argc, &argv, &environ);
725 staticperl = perl_alloc ();
726 perl_construct (staticperl);
727
728 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
729
730 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
731 if (!exitstatus)
732 perl_run (staticperl);
733
734 exitstatus = perl_destruct (staticperl);
735 perl_free (staticperl);
736 PERL_SYS_TERM ();
737
738 return exitstatus;
739}
740EOF
660} else { 741} else {
661 print $fh <<EOF; 742 print $fh <<EOF;
662 743
663EXTERN_C void 744EXTERN_C void
664staticperl_init (void) 745staticperl_init (void)
665{ 746{
666 extern char **environ; 747 extern char **environ;
667 int argc = sizeof (args) / sizeof (args [0]); 748 int argc = sizeof (args) / sizeof (args [0]);
668 char **argv = args; 749 char **argv = args;
750
751 static char *args[] = {
752 "staticperl",
753 "-e",
754 "0"
755 };
669 756
670 PERL_SYS_INIT3 (&argc, &argv, &environ); 757 PERL_SYS_INIT3 (&argc, &argv, &environ);
671 staticperl = perl_alloc (); 758 staticperl = perl_alloc ();
672 perl_construct (staticperl); 759 perl_construct (staticperl);
673 PL_origalen = 1; 760 PL_origalen = 1;
674 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 761 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
675 perl_parse (staticperl, xs_init, argc, argv, environ); 762 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
676 763
677 perl_run (staticperl); 764 perl_run (staticperl);
678} 765}
679 766
680EXTERN_C void 767EXTERN_C void
… …
707} 794}
708 795
709{ 796{
710 print "generating $PREFIX.ldopts... "; 797 print "generating $PREFIX.ldopts... ";
711 798
712 my $str = $STATIC ? "--static " : ""; 799 my $str = $STATIC ? "-static " : "";
713 800
714 $str .= "$Config{ccdlflags} $Config{ldflags} @libs $Config{archlibexp}/CORE/$Config{libperl} $Config{perllibs}"; 801 $str .= "$Config{ccdlflags} $Config{ldflags} @libs $Config{archlibexp}/CORE/$Config{libperl} $Config{perllibs}";
715 802
716 my %seen; 803 my %seen;
717 $str .= " $_" for grep !$seen{$_}++, ($extralibs =~ /(\S+)/g); 804 $str .= " $_" for grep !$seen{$_}++, ($extralibs =~ /(\S+)/g);
805
806 for (@staticlibs) {
807 $str =~ s/(^|\s) (-l\Q$_\E) ($|\s)/$1-Wl,-Bstatic $2 -Wl,-Bdynamic$3/gx;
808 }
718 809
719 $str =~ s/([\(\)])/\\$1/g; 810 $str =~ s/([\(\)])/\\$1/g;
720 811
721 print "$str\n\n"; 812 print "$str\n\n";
722 813
723 open my $fh, ">$PREFIX.ldopts" 814 open my $fh, ">$PREFIX.ldopts"
724 or die "$PREFIX.ldopts: $!"; 815 or die "$PREFIX.ldopts: $!";
725 print $fh $str; 816 print $fh $str;
726} 817}
727 818
728if ($PERL) { 819if ($PERL or defined $APP) {
820 $APP = "perl" unless defined $APP;
821
822 print "generating $APP...\n";
823
729 system "$Config{cc} \$(cat bundle.ccopts\) -o perl bundle.c \$(cat bundle.ldopts\)"; 824 system "$Config{cc} \$(cat bundle.ccopts\) -o \Q$APP\E bundle.c \$(cat bundle.ldopts\)";
730 825
731 unlink "$PREFIX.$_" 826 unlink "$PREFIX.$_"
732 for qw(ccopts ldopts c h); 827 for qw(ccopts ldopts c h);
733} 828}
734 829

Diff Legend

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