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

Comparing App-Staticperl/mkbundle (file contents):
Revision 1.4 by root, Mon Dec 6 21:10:41 2010 UTC vs.
Revision 1.5 by root, Tue Dec 7 09:08:06 2010 UTC

… …
76} 76}
77 77
78# module loading is now safe 78# module loading is now safe
79use Config; 79use Config;
80 80
81sub scan_al {
82 my ($auto, $autodir, $ix) = @_;
83
84 $pm{"$auto/$ix"} = "$autodir/$ix";
85
86 open my $fh, "<", "$autodir/$ix"
87 or die "$autodir/$ix: $!";
88
89 my $package;
90
91 while (<$fh>) {
92 if (/^\s*sub\s+([^[:space:];]+)\s*;?\s*$/) {
93 my $al = "auto/$package/$1.al";
94 my $inc = find_inc $al;
95
96 defined $inc or die "$al: autoload file not found, but should be there.\n";
97
98 $pm{$al} = "$inc/$al";
99
100 } elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) {
101 ($package = $1) =~ s/::/\//g;
102 } elsif (/^\s*(?:#|1?\s*;?\s*$)/) {
103 # nop
104 } else {
105 warn "$autodir/$ix: unparsable line, please report: $_";
106 }
107 }
108}
109
81sub trace_module { 110sub trace_module {
82 syswrite $TRACER_W, "use $_[0]\n"; 111 syswrite $TRACER_W, "use $_[0]\n";
83 112
84 for (;;) { 113 for (;;) {
85 <$TRACER_R> =~ /^-$/ or last; 114 <$TRACER_R> =~ /^-$/ or last;
… …
96 opendir my $dir, $autodir 125 opendir my $dir, $autodir
97 or die "$autodir: $!\n"; 126 or die "$autodir: $!\n";
98 127
99 for (readdir $dir) { 128 for (readdir $dir) {
100 # AutoLoader 129 # AutoLoader
101 $pm{"$auto/$_"} = "$autodir/$_" 130 scan_al $auto, $autodir, $_
102 if /\.(?:al|ix)$/; 131 if /\.ix$/;
103 132
104 # static ext 133 # static ext
105 if (/\Q$Config{_a}\E$/o) { 134 if (/\Q$Config{_a}\E$/o) {
106 push @libs, "$autodir/$_"; 135 push @libs, "$autodir/$_";
107 push @static_ext, $name; 136 push @static_ext, $name;
… …
117 } 146 }
118 147
119 # dynamic object 148 # dynamic object
120 warn "WARNING: found shared object - can't link statically ($_)\n" 149 warn "WARNING: found shared object - can't link statically ($_)\n"
121 if /\.\Q$Config{dlext}\E$/o; 150 if /\.\Q$Config{dlext}\E$/o;
122
123 #TODO: extralibs?
124 } 151 }
125 } 152 }
126 } 153 }
127 } 154 }
128} 155}
… …
247 or die "$pm: path too long (only 128 octets supported)\n"; 274 or die "$pm: path too long (only 128 octets supported)\n";
248 275
249 my $src = ref $path 276 my $src = ref $path
250 ? $$path 277 ? $$path
251 : do { 278 : do {
252 open my $pm, "<:perlio", $path 279 open my $pm, "<", $path
253 or die "$path: $!"; 280 or die "$path: $!";
254 281
255 local $/; 282 local $/;
256 283
257 <$pm> 284 <$pm>
… …
360 387
361 my $stripper = Pod::Strip->new; 388 my $stripper = Pod::Strip->new;
362 389
363 my $out; 390 my $out;
364 $stripper->output_string (\$out); 391 $stripper->output_string (\$out);
365 $stripper->parse_string_document ($src); 392 $stripper->parse_string_document ($src)
393 or die;
366 $src = $out; 394 $src = $out;
367 } 395 }
368 396
369 if ($VERIFY && $pm =~ /\.pm$/ && $pm ne "Opcode.pm") { 397 if ($VERIFY && $pm =~ /\.pm$/ && $pm ne "Opcode.pm") {
370 if (open my $fh, "-|") { 398 if (open my $fh, "-|") {
… …
401 open my $fh, ">", "$PREFIX.h" 429 open my $fh, ">", "$PREFIX.h"
402 or die "$PREFIX.h: $!\n"; 430 or die "$PREFIX.h: $!\n";
403 431
404 print $fh <<EOF; 432 print $fh <<EOF;
405/* do not edit, automatically created by mkstaticbundle */ 433/* do not edit, automatically created by mkstaticbundle */
434
406#include <EXTERN.h> 435#include <EXTERN.h>
407#include <perl.h> 436#include <perl.h>
408#include <XSUB.h> 437#include <XSUB.h>
409 438
410/* public API */ 439/* public API */
411EXTERN_C PerlInterpreter *staticperl; 440EXTERN_C PerlInterpreter *staticperl;
441EXTERN_C void staticperl_xs_init (pTHX);
412EXTERN_C void staticperl_init (void); 442EXTERN_C void staticperl_init (void);
413EXTERN_C void staticperl_cleanup (void); 443EXTERN_C void staticperl_cleanup (void);
444
414EOF 445EOF
415} 446}
416 447
417print "\n"; 448print "\n";
418 449
… …
424open my $fh, ">", "$PREFIX.c" 455open my $fh, ">", "$PREFIX.c"
425 or die "$PREFIX.c: $!\n"; 456 or die "$PREFIX.c: $!\n";
426 457
427print $fh <<EOF; 458print $fh <<EOF;
428/* do not edit, automatically created by mkstaticbundle */ 459/* do not edit, automatically created by mkstaticbundle */
429
430#include <EXTERN.h>
431#include <perl.h>
432#include <XSUB.h>
433 460
434#include "bundle.h" 461#include "bundle.h"
435 462
436/* public API */ 463/* public API */
437PerlInterpreter *staticperl; 464PerlInterpreter *staticperl;
… …
588 615
589############################################################################# 616#############################################################################
590# xs_init 617# xs_init
591 618
592print $fh <<EOF; 619print $fh <<EOF;
593static void 620void
594xs_init (pTHX) 621staticperl_xs_init (pTHX)
595{ 622{
596EOF 623EOF
597 624
598@static_ext = ("DynaLoader", sort @static_ext); 625@static_ext = ("DynaLoader", sort @static_ext);
599 626
… …
645 staticperl = perl_alloc (); 672 staticperl = perl_alloc ();
646 perl_construct (staticperl); 673 perl_construct (staticperl);
647 674
648 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 675 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
649 676
650 exitstatus = perl_parse (staticperl, xs_init, argc, argv, environ); 677 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
651 if (!exitstatus) 678 if (!exitstatus)
652 perl_run (staticperl); 679 perl_run (staticperl);
653 680
654 exitstatus = perl_destruct (staticperl); 681 exitstatus = perl_destruct (staticperl);
655 perl_free (staticperl); 682 perl_free (staticperl);
… …
671 PERL_SYS_INIT3 (&argc, &argv, &environ); 698 PERL_SYS_INIT3 (&argc, &argv, &environ);
672 staticperl = perl_alloc (); 699 staticperl = perl_alloc ();
673 perl_construct (staticperl); 700 perl_construct (staticperl);
674 PL_origalen = 1; 701 PL_origalen = 1;
675 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 702 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
676 perl_parse (staticperl, xs_init, argc, argv, environ); 703 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
677 704
678 perl_run (staticperl); 705 perl_run (staticperl);
679} 706}
680 707
681EXTERN_C void 708EXTERN_C void

Diff Legend

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