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.14 by root, Wed Dec 22 01:23:37 2010 UTC vs.
Revision 1.23 by root, Thu Feb 10 12:02:09 2011 UTC

… …
65 65
66 unless (fork) { 66 unless (fork) {
67 close $TRACER_R; 67 close $TRACER_R;
68 close $TRACER_W; 68 close $TRACER_W;
69 69
70 my $pkg = "pkg000000";
71
70 unshift @INC, sub { 72 unshift @INC, sub {
71 my $dir = find_incdir $_[1] 73 my $dir = find_incdir $_[1]
72 or return; 74 or return;
73 75
74 syswrite $W_TRACER, "-\n$dir\n$_[1]\n"; 76 syswrite $W_TRACER, "-\n$dir\n$_[1]\n";
… …
80 }; 82 };
81 83
82 while (<$R_TRACER>) { 84 while (<$R_TRACER>) {
83 if (/use (.*)$/) { 85 if (/use (.*)$/) {
84 my $mod = $1; 86 my $mod = $1;
87 my $pkg = ++$pkg;
88 my $eval = $mod =~ /[^A-Za-z0-9_:]/
85 eval "require $mod"; 89 ? "require $mod"
90 : "{ package $pkg; use $mod; }";
91 eval $eval;
86 warn "ERROR: $@ (while loading '$mod')\n" 92 warn "ERROR: $@ (while loading '$mod')\n"
87 if $@; 93 if $@;
88 } elsif (/eval (.*)$/) { 94 } elsif (/eval (.*)$/) {
89 my $eval = $1; 95 my $eval = $1;
90 eval $eval; 96 eval $eval;
… …
260} 266}
261 267
262############################################################################# 268#############################################################################
263 269
264sub cmd_boot { 270sub cmd_boot {
265 $pm{"//boot"} = $_[0]; 271 $pm{"&&boot"} = $_[0];
266} 272}
267 273
268sub cmd_add { 274sub cmd_add {
269 $_[0] =~ /^(.*)(?:\s+(\S+))$/ 275 $_[0] =~ /^(.*?)(?:\s+(\S+))?$/
270 or die "$_[0]: cannot parse"; 276 or die "$_[0]: cannot parse";
271 277
272 my $file = $1; 278 my $file = $1;
273 my $as = defined $2 ? $2 : "/$1"; 279 my $as = defined $2 ? $2 : "&$1";
274 280
275 $pm{$as} = $file; 281 $pm{$as} = $file;
276 $pmbin{$as} = 1 if $_[1]; 282 $pmbin{$as} = 1 if $_[1];
277} 283}
278 284
… …
661 667
662 $src = $ppi->serialize; 668 $src = $ppi->serialize;
663 } else { 669 } else {
664 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n"; 670 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n";
665 } 671 }
666 } 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
667 require Pod::Strip; 673 require Pod::Strip;
668 674
669 my $stripper = Pod::Strip->new; 675 my $stripper = Pod::Strip->new;
670 676
671 my $out; 677 my $out;
… …
723#include <XSUB.h> 729#include <XSUB.h>
724 730
725/* public API */ 731/* public API */
726EXTERN_C PerlInterpreter *staticperl; 732EXTERN_C PerlInterpreter *staticperl;
727EXTERN_C void staticperl_xs_init (pTHX); 733EXTERN_C void staticperl_xs_init (pTHX);
728EXTERN_C void staticperl_init (void); 734EXTERN_C void staticperl_init (XSINIT_t xs_init); /* argument can be 0 */
729EXTERN_C void staticperl_cleanup (void); 735EXTERN_C void staticperl_cleanup (void);
730 736
731EOF 737EOF
732} 738}
733 739
… …
802 $fh 808 $fh
803 }; 809 };
804} 810}
805'; 811';
806 812
807$bootstrap .= "require '//boot';" 813$bootstrap .= "require '&&boot';"
808 if exists $pm{"//boot"}; 814 if exists $pm{"&&boot"};
809 815
810$bootstrap =~ s/\s+/ /g; 816$bootstrap =~ s/\s+/ /g;
811$bootstrap =~ s/(\W) /$1/g; 817$bootstrap =~ s/(\W) /$1/g;
812$bootstrap =~ s/ (\W)/$1/g; 818$bootstrap =~ s/ (\W)/$1/g;
813 819
… …
933 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n"; 939 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n";
934} 940}
935 941
936print $fh <<EOF; 942print $fh <<EOF;
937 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1)); 943 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1));
944
945 if (PL_oldname)
946 ((XSINIT_t)PL_oldname)(aTHX);
938} 947}
939EOF 948EOF
940 949
941############################################################################# 950#############################################################################
942# optional perl_init/perl_destroy 951# optional perl_init/perl_destroy
943 952
944if ($APP) { 953if ($APP) {
954 print $fh <<EOF;
955
956int
957main (int argc, char *argv [])
958{
959 extern char **environ;
960 int i, exitstatus;
961 char **args = malloc ((argc + 3) * sizeof (const char *));
962
963 args [0] = argv [0];
964 args [1] = "-e";
965 args [2] = "0";
966 args [3] = "--";
967
968 for (i = 1; i < argc; ++i)
969 args [i + 3] = argv [i];
970
971 PERL_SYS_INIT3 (&argc, &argv, &environ);
972 staticperl = perl_alloc ();
973 perl_construct (staticperl);
974
975 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
976
977 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc + 3, args, environ);
978 free (args);
979 if (!exitstatus)
980 perl_run (staticperl);
981
982 exitstatus = perl_destruct (staticperl);
983 perl_free (staticperl);
984 PERL_SYS_TERM ();
985
986 return exitstatus;
987}
988EOF
989} elsif ($PERL) {
945 print $fh <<EOF; 990 print $fh <<EOF;
946 991
947int 992int
948main (int argc, char *argv []) 993main (int argc, char *argv [])
949{ 994{
950 extern char **environ; 995 extern char **environ;
951 int exitstatus; 996 int exitstatus;
952 997
998 PERL_SYS_INIT3 (&argc, &argv, &environ);
999 staticperl = perl_alloc ();
1000 perl_construct (staticperl);
1001
1002 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1003
1004 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
1005 if (!exitstatus)
1006 perl_run (staticperl);
1007
1008 exitstatus = perl_destruct (staticperl);
1009 perl_free (staticperl);
1010 PERL_SYS_TERM ();
1011
1012 return exitstatus;
1013}
1014EOF
1015} else {
1016 print $fh <<EOF;
1017
1018EXTERN_C void
1019staticperl_init (XSINIT_t xs_init)
1020{
953 static char *args[] = { 1021 static char *args[] = {
954 "staticperl", 1022 "staticperl",
955 "-e", 1023 "-e",
956 "0" 1024 "0"
957 }; 1025 };
958 1026
959 PERL_SYS_INIT3 (&argc, &argv, &environ);
960 staticperl = perl_alloc ();
961 perl_construct (staticperl);
962
963 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
964
965 exitstatus = perl_parse (staticperl, staticperl_xs_init, sizeof (args) / sizeof (*args), args, environ);
966 if (!exitstatus)
967 perl_run (staticperl);
968
969 exitstatus = perl_destruct (staticperl);
970 perl_free (staticperl);
971 PERL_SYS_TERM ();
972
973 return exitstatus;
974}
975EOF
976} elsif ($PERL) {
977 print $fh <<EOF;
978
979int
980main (int argc, char *argv [])
981{
982 extern char **environ;
983 int exitstatus;
984
985 PERL_SYS_INIT3 (&argc, &argv, &environ);
986 staticperl = perl_alloc ();
987 perl_construct (staticperl);
988
989 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
990
991 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
992 if (!exitstatus)
993 perl_run (staticperl);
994
995 exitstatus = perl_destruct (staticperl);
996 perl_free (staticperl);
997 PERL_SYS_TERM ();
998
999 return exitstatus;
1000}
1001EOF
1002} else {
1003 print $fh <<EOF;
1004
1005EXTERN_C void
1006staticperl_init (void)
1007{
1008 extern char **environ; 1027 extern char **environ;
1009 int argc = sizeof (args) / sizeof (args [0]); 1028 int argc = sizeof (args) / sizeof (args [0]);
1010 char **argv = args; 1029 char **argv = args;
1011
1012 static char *args[] = {
1013 "staticperl",
1014 "-e",
1015 "0"
1016 };
1017 1030
1018 PERL_SYS_INIT3 (&argc, &argv, &environ); 1031 PERL_SYS_INIT3 (&argc, &argv, &environ);
1019 staticperl = perl_alloc (); 1032 staticperl = perl_alloc ();
1020 perl_construct (staticperl); 1033 perl_construct (staticperl);
1021 PL_origalen = 1; 1034 PL_origalen = 1;
1022 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1035 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1036 PL_oldname = (char *)xs_init;
1023 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ); 1037 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
1024 1038
1025 perl_run (staticperl); 1039 perl_run (staticperl);
1026} 1040}
1027 1041

Diff Legend

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