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.15 by root, Mon Jan 10 14:12:03 2011 UTC vs.
Revision 1.25 by root, Thu Feb 24 07:01:46 2011 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;
14 15
15our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression? 16our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression?
16 17
17our $CACHE; 18our $CACHE;
18our $CACHEVER = 1; # do not change unless you know what you are doing 19our $CACHEVER = 1; # do not change unless you know what you are doing
… …
65 66
66 unless (fork) { 67 unless (fork) {
67 close $TRACER_R; 68 close $TRACER_R;
68 close $TRACER_W; 69 close $TRACER_W;
69 70
71 my $pkg = "pkg000000";
72
70 unshift @INC, sub { 73 unshift @INC, sub {
71 my $dir = find_incdir $_[1] 74 my $dir = find_incdir $_[1]
72 or return; 75 or return;
73 76
74 syswrite $W_TRACER, "-\n$dir\n$_[1]\n"; 77 syswrite $W_TRACER, "-\n$dir\n$_[1]\n";
… …
80 }; 83 };
81 84
82 while (<$R_TRACER>) { 85 while (<$R_TRACER>) {
83 if (/use (.*)$/) { 86 if (/use (.*)$/) {
84 my $mod = $1; 87 my $mod = $1;
88 my $eval;
89
90 if ($mod =~ /^'.*'$/ or $mod =~ /^".*"$/) {
85 eval "require $mod"; 91 $eval = "require $mod";
92 } elsif ($mod =~ y%/.%%) {
93 $eval = "require q\x00$mod\x00";
94 } else {
95 my $pkg = ++$pkg;
96 $eval = "{ package $pkg; use $mod; }";
97 }
98
99 eval $eval;
86 warn "ERROR: $@ (while loading '$mod')\n" 100 warn "ERROR: $@ (while loading '$mod')\n"
87 if $@; 101 if $@;
88 } elsif (/eval (.*)$/) { 102 } elsif (/eval (.*)$/) {
89 my $eval = $1; 103 my $eval = $1;
90 eval $eval; 104 eval $eval;
… …
260} 274}
261 275
262############################################################################# 276#############################################################################
263 277
264sub cmd_boot { 278sub cmd_boot {
265 $pm{"//boot"} = $_[0]; 279 $pm{"&&boot"} = $_[0];
266} 280}
267 281
268sub cmd_add { 282sub cmd_add {
269 $_[0] =~ /^(.*)(?:\s+(\S+))$/ 283 $_[0] =~ /^(.*?)(?:\s+(\S+))?$/
270 or die "$_[0]: cannot parse"; 284 or die "$_[0]: cannot parse";
271 285
272 my $file = $1; 286 my $file = $1;
273 my $as = defined $2 ? $2 : "/$1"; 287 my $as = defined $2 ? $2 : $1;
274 288
275 $pm{$as} = $file; 289 $pm{$as} = $file;
276 $pmbin{$as} = 1 if $_[1]; 290 $pmbin{$as} = 1 if $_[1];
277} 291}
278 292
… …
323 337
324use Getopt::Long; 338use Getopt::Long;
325 339
326sub parse_argv { 340sub parse_argv {
327 GetOptions 341 GetOptions
342 "perl" => \$PERL,
343 "app=s" => \$APP,
344
345 "verbose|v" => sub { ++$VERBOSE },
346 "quiet|q" => sub { --$VERBOSE },
347
328 "strip=s" => \$STRIP, 348 "strip=s" => \$STRIP,
329 "cache=s" => \$CACHE, # internal option 349 "cache=s" => \$CACHE, # internal option
330 "verbose|v" => sub { ++$VERBOSE },
331 "quiet|q" => sub { --$VERBOSE },
332 "perl" => \$PERL,
333 "app=s" => \$APP,
334 "eval|e=s" => sub { trace_eval $_[1] }, 350 "eval|e=s" => sub { trace_eval $_[1] },
335 "use|M=s" => sub { trace_module $_[1] }, 351 "use|M=s" => sub { trace_module $_[1] },
336 "boot=s" => sub { cmd_boot $_[1] }, 352 "boot=s" => sub { cmd_boot $_[1] },
337 "add=s" => sub { cmd_add $_[1], 0 }, 353 "add=s" => sub { cmd_add $_[1], 0 },
338 "addbin=s" => sub { cmd_add $_[1], 1 }, 354 "addbin=s" => sub { cmd_add $_[1], 1 },
339 "incglob=s" => sub { cmd_incglob $_[1] }, 355 "incglob=s" => sub { cmd_incglob $_[1] },
340 "include|i=s" => sub { cmd_include $_[1], 1 }, 356 "include|i=s" => sub { cmd_include $_[1], 1 },
341 "exclude|x=s" => sub { cmd_include $_[1], 0 }, 357 "exclude|x=s" => sub { cmd_include $_[1], 0 },
358 "usepacklists!" => \$PACKLIST,
359
342 "static!" => \$STATIC, 360 "static!" => \$STATIC,
343 "usepacklists!" => \$PACKLIST,
344 "staticlib=s" => sub { cmd_staticlib $_[1] }, 361 "staticlib=s" => sub { cmd_staticlib $_[1] },
362 "ignore-env" => \$IGNORE_ENV,
363
345 "<>" => sub { cmd_file $_[0] }, 364 "<>" => sub { cmd_file $_[0] },
346 or exit 1; 365 or exit 1;
347} 366}
348 367
349Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); 368Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
… …
723#include <XSUB.h> 742#include <XSUB.h>
724 743
725/* public API */ 744/* public API */
726EXTERN_C PerlInterpreter *staticperl; 745EXTERN_C PerlInterpreter *staticperl;
727EXTERN_C void staticperl_xs_init (pTHX); 746EXTERN_C void staticperl_xs_init (pTHX);
728EXTERN_C void staticperl_init (void); 747EXTERN_C void staticperl_init (XSINIT_t xs_init); /* argument can be 0 */
729EXTERN_C void staticperl_cleanup (void); 748EXTERN_C void staticperl_cleanup (void);
730 749
731EOF 750EOF
732} 751}
733 752
… …
802 $fh 821 $fh
803 }; 822 };
804} 823}
805'; 824';
806 825
807$bootstrap .= "require '//boot';" 826$bootstrap .= "require '&&boot';"
808 if exists $pm{"//boot"}; 827 if exists $pm{"&&boot"};
809 828
810$bootstrap =~ s/\s+/ /g; 829$bootstrap =~ s/\s+/ /g;
811$bootstrap =~ s/(\W) /$1/g; 830$bootstrap =~ s/(\W) /$1/g;
812$bootstrap =~ s/ (\W)/$1/g; 831$bootstrap =~ s/ (\W)/$1/g;
813 832
… …
933 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n"; 952 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n";
934} 953}
935 954
936print $fh <<EOF; 955print $fh <<EOF;
937 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1)); 956 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1));
957
958 if (PL_oldname)
959 ((XSINIT_t)PL_oldname)(aTHX);
938} 960}
939EOF 961EOF
940 962
941############################################################################# 963#############################################################################
942# optional perl_init/perl_destroy 964# optional perl_init/perl_destroy
943 965
966if ($IGNORE_ENV) {
967 $IGNORE_ENV = <<EOF;
968 unsetenv ("PERL_UNICODE");
969 unsetenv ("PERL_HASH_SEED_DEBUG");
970 unsetenv ("PERL_DESTRUCT_LEVEL");
971 unsetenv ("PERL_SIGNALS");
972 unsetenv ("PERL_DEBUG_MSTATS");
973 unsetenv ("PERL5OPT");
974 unsetenv ("PERLIO_DEBUG");
975 unsetenv ("PERLIO");
976 unsetenv ("PERL_HASH_SEED");
977EOF
978} else {
979 $IGNORE_ENV = "";
980}
981
944if ($APP) { 982if ($APP) {
983 print $fh <<EOF;
984
985int
986main (int argc, char *argv [])
987{
988 extern char **environ;
989 int i, exitstatus;
990 char **args = malloc ((argc + 3) * sizeof (const char *));
991
992 args [0] = argv [0];
993 args [1] = "-e";
994 args [2] = "0";
995 args [3] = "--";
996
997 for (i = 1; i < argc; ++i)
998 args [i + 3] = argv [i];
999
1000$IGNORE_ENV
1001 PERL_SYS_INIT3 (&argc, &argv, &environ);
1002 staticperl = perl_alloc ();
1003 perl_construct (staticperl);
1004
1005 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1006
1007 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc + 3, args, environ);
1008 free (args);
1009 if (!exitstatus)
1010 perl_run (staticperl);
1011
1012 exitstatus = perl_destruct (staticperl);
1013 perl_free (staticperl);
1014 PERL_SYS_TERM ();
1015
1016 return exitstatus;
1017}
1018EOF
1019} elsif ($PERL) {
945 print $fh <<EOF; 1020 print $fh <<EOF;
946 1021
947int 1022int
948main (int argc, char *argv []) 1023main (int argc, char *argv [])
949{ 1024{
950 extern char **environ; 1025 extern char **environ;
951 int exitstatus; 1026 int exitstatus;
952 1027
1028$IGNORE_ENV
1029 PERL_SYS_INIT3 (&argc, &argv, &environ);
1030 staticperl = perl_alloc ();
1031 perl_construct (staticperl);
1032
1033 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1034
1035 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
1036 if (!exitstatus)
1037 perl_run (staticperl);
1038
1039 exitstatus = perl_destruct (staticperl);
1040 perl_free (staticperl);
1041 PERL_SYS_TERM ();
1042
1043 return exitstatus;
1044}
1045EOF
1046} else {
1047 print $fh <<EOF;
1048
1049EXTERN_C void
1050staticperl_init (XSINIT_t xs_init)
1051{
953 static char *args[] = { 1052 static char *args[] = {
954 "staticperl", 1053 "staticperl",
955 "-e", 1054 "-e",
956 "0" 1055 "0"
957 }; 1056 };
958 1057
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; 1058 extern char **environ;
1009 int argc = sizeof (args) / sizeof (args [0]); 1059 int argc = sizeof (args) / sizeof (args [0]);
1010 char **argv = args; 1060 char **argv = args;
1011 1061
1012 static char *args[] = { 1062$IGNORE_ENV
1013 "staticperl",
1014 "-e",
1015 "0"
1016 };
1017
1018 PERL_SYS_INIT3 (&argc, &argv, &environ); 1063 PERL_SYS_INIT3 (&argc, &argv, &environ);
1019 staticperl = perl_alloc (); 1064 staticperl = perl_alloc ();
1020 perl_construct (staticperl); 1065 perl_construct (staticperl);
1021 PL_origalen = 1; 1066 PL_origalen = 1;
1022 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1067 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1068 PL_oldname = (char *)xs_init;
1023 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ); 1069 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
1024 1070
1025 perl_run (staticperl); 1071 perl_run (staticperl);
1026} 1072}
1027 1073

Diff Legend

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