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

Comparing App-Staticperl/mkbundle (file contents):
Revision 1.17 by root, Wed Feb 9 09:52:27 2011 UTC vs.
Revision 1.27 by root, Thu Feb 24 14:35:38 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
… …
82 }; 83 };
83 84
84 while (<$R_TRACER>) { 85 while (<$R_TRACER>) {
85 if (/use (.*)$/) { 86 if (/use (.*)$/) {
86 my $mod = $1; 87 my $mod = $1;
88 my $eval;
89
90 if ($mod =~ /^'.*'$/ or $mod =~ /^".*"$/) {
91 $eval = "require $mod";
92 } elsif ($mod =~ y%/.%%) {
93 $eval = "require q\x00$mod\x00";
94 } else {
87 my $pkg = ++$pkg; 95 my $pkg = ++$pkg;
88 my $eval = $mod = $mod =~ /[^A-Za-z0-9_:]/
89 ? "require $mod"
90 : "{ package $pkg; use $mod; }"; 96 $eval = "{ package $pkg; use $mod; }";
97 }
98
91 eval $eval; 99 eval $eval;
92 warn "ERROR: $@ (while loading '$mod')\n" 100 warn "ERROR: $@ (while loading '$mod')\n"
93 if $@; 101 if $@;
94 } elsif (/eval (.*)$/) { 102 } elsif (/eval (.*)$/) {
95 my $eval = $1; 103 my $eval = $1;
… …
266} 274}
267 275
268############################################################################# 276#############################################################################
269 277
270sub cmd_boot { 278sub cmd_boot {
271 $pm{"//boot"} = $_[0]; 279 $pm{"&&boot"} = $_[0];
272} 280}
273 281
274sub cmd_add { 282sub cmd_add {
275 $_[0] =~ /^(.*)(?:\s+(\S+))$/ 283 $_[0] =~ /^(.*?)(?:\s+(\S+))?$/
276 or die "$_[0]: cannot parse"; 284 or die "$_[0]: cannot parse";
277 285
278 my $file = $1; 286 my $file = $1;
279 my $as = defined $2 ? $2 : "/$1"; 287 my $as = defined $2 ? $2 : $1;
280 288
281 $pm{$as} = $file; 289 $pm{$as} = $file;
282 $pmbin{$as} = 1 if $_[1]; 290 $pmbin{$as} = 1 if $_[1];
283} 291}
284 292
… …
329 337
330use Getopt::Long; 338use Getopt::Long;
331 339
332sub parse_argv { 340sub parse_argv {
333 GetOptions 341 GetOptions
342 "perl" => \$PERL,
343 "app=s" => \$APP,
344
345 "verbose|v" => sub { ++$VERBOSE },
346 "quiet|q" => sub { --$VERBOSE },
347
334 "strip=s" => \$STRIP, 348 "strip=s" => \$STRIP,
335 "cache=s" => \$CACHE, # internal option 349 "cache=s" => \$CACHE, # internal option
336 "verbose|v" => sub { ++$VERBOSE },
337 "quiet|q" => sub { --$VERBOSE },
338 "perl" => \$PERL,
339 "app=s" => \$APP,
340 "eval|e=s" => sub { trace_eval $_[1] }, 350 "eval|e=s" => sub { trace_eval $_[1] },
341 "use|M=s" => sub { trace_module $_[1] }, 351 "use|M=s" => sub { trace_module $_[1] },
342 "boot=s" => sub { cmd_boot $_[1] }, 352 "boot=s" => sub { cmd_boot $_[1] },
343 "add=s" => sub { cmd_add $_[1], 0 }, 353 "add=s" => sub { cmd_add $_[1], 0 },
344 "addbin=s" => sub { cmd_add $_[1], 1 }, 354 "addbin=s" => sub { cmd_add $_[1], 1 },
345 "incglob=s" => sub { cmd_incglob $_[1] }, 355 "incglob=s" => sub { cmd_incglob $_[1] },
346 "include|i=s" => sub { cmd_include $_[1], 1 }, 356 "include|i=s" => sub { cmd_include $_[1], 1 },
347 "exclude|x=s" => sub { cmd_include $_[1], 0 }, 357 "exclude|x=s" => sub { cmd_include $_[1], 0 },
358 "usepacklists!" => \$PACKLIST,
359
348 "static!" => \$STATIC, 360 "static!" => \$STATIC,
349 "usepacklists!" => \$PACKLIST,
350 "staticlib=s" => sub { cmd_staticlib $_[1] }, 361 "staticlib=s" => sub { cmd_staticlib $_[1] },
362 "ignore-env" => \$IGNORE_ENV,
363
351 "<>" => sub { cmd_file $_[0] }, 364 "<>" => sub { cmd_file $_[0] },
352 or exit 1; 365 or exit 1;
353} 366}
354 367
355Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); 368Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
… …
707} 720}
708 721
709length $data < 2**25 722length $data < 2**25
710 or die "ERROR: bundle too large (only 32MB supported)\n"; 723 or die "ERROR: bundle too large (only 32MB supported)\n";
711 724
712my $varpfx = "bundle_" . substr +(Digest::MD5::md5_hex $data), 0, 16; 725my $varpfx = "bundle";
713 726
714############################################################################# 727#############################################################################
715# output 728# output
716 729
717print "generating $PREFIX.h... " 730print "generating $PREFIX.h... "
… …
720{ 733{
721 open my $fh, ">", "$PREFIX.h" 734 open my $fh, ">", "$PREFIX.h"
722 or die "$PREFIX.h: $!\n"; 735 or die "$PREFIX.h: $!\n";
723 736
724 print $fh <<EOF; 737 print $fh <<EOF;
725/* do not edit, automatically created by mkstaticbundle */ 738/* do not edit, automatically created by staticperl */
726 739
727#include <EXTERN.h> 740#include <EXTERN.h>
728#include <perl.h> 741#include <perl.h>
729#include <XSUB.h> 742#include <XSUB.h>
730 743
731/* public API */ 744/* public API */
732EXTERN_C PerlInterpreter *staticperl; 745EXTERN_C PerlInterpreter *staticperl;
733EXTERN_C void staticperl_xs_init (pTHX); 746EXTERN_C void staticperl_xs_init (pTHX);
734EXTERN_C void staticperl_init (void); 747EXTERN_C void staticperl_init (XSINIT_t xs_init); /* argument can be 0 */
735EXTERN_C void staticperl_cleanup (void); 748EXTERN_C void staticperl_cleanup (void);
736 749
737EOF 750EOF
738} 751}
739 752
… …
748 761
749open my $fh, ">", "$PREFIX.c" 762open my $fh, ">", "$PREFIX.c"
750 or die "$PREFIX.c: $!\n"; 763 or die "$PREFIX.c: $!\n";
751 764
752print $fh <<EOF; 765print $fh <<EOF;
753/* do not edit, automatically created by mkstaticbundle */ 766/* do not edit, automatically created by staticperl */
754 767
755#include "bundle.h" 768#include "bundle.h"
756 769
757/* public API */ 770/* public API */
758PerlInterpreter *staticperl; 771PerlInterpreter *staticperl;
… …
808 $fh 821 $fh
809 }; 822 };
810} 823}
811'; 824';
812 825
813$bootstrap .= "require '//boot';" 826$bootstrap .= "require '&&boot';"
814 if exists $pm{"//boot"}; 827 if exists $pm{"&&boot"};
815 828
816$bootstrap =~ s/\s+/ /g; 829$bootstrap =~ s/\s+/ /g;
817$bootstrap =~ s/(\W) /$1/g; 830$bootstrap =~ s/(\W) /$1/g;
818$bootstrap =~ s/ (\W)/$1/g; 831$bootstrap =~ s/ (\W)/$1/g;
819 832
… …
939 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n"; 952 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n";
940} 953}
941 954
942print $fh <<EOF; 955print $fh <<EOF;
943 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);
944} 960}
945EOF 961EOF
946 962
947############################################################################# 963#############################################################################
948# optional perl_init/perl_destroy 964# optional perl_init/perl_destroy
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}
949 981
950if ($APP) { 982if ($APP) {
951 print $fh <<EOF; 983 print $fh <<EOF;
952 984
953int 985int
… …
963 args [3] = "--"; 995 args [3] = "--";
964 996
965 for (i = 1; i < argc; ++i) 997 for (i = 1; i < argc; ++i)
966 args [i + 3] = argv [i]; 998 args [i + 3] = argv [i];
967 999
1000$IGNORE_ENV
968 PERL_SYS_INIT3 (&argc, &argv, &environ); 1001 PERL_SYS_INIT3 (&argc, &argv, &environ);
969 staticperl = perl_alloc (); 1002 staticperl = perl_alloc ();
970 perl_construct (staticperl); 1003 perl_construct (staticperl);
971 1004
972 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1005 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
… …
990main (int argc, char *argv []) 1023main (int argc, char *argv [])
991{ 1024{
992 extern char **environ; 1025 extern char **environ;
993 int exitstatus; 1026 int exitstatus;
994 1027
1028$IGNORE_ENV
995 PERL_SYS_INIT3 (&argc, &argv, &environ); 1029 PERL_SYS_INIT3 (&argc, &argv, &environ);
996 staticperl = perl_alloc (); 1030 staticperl = perl_alloc ();
997 perl_construct (staticperl); 1031 perl_construct (staticperl);
998 1032
999 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1033 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
… …
1011EOF 1045EOF
1012} else { 1046} else {
1013 print $fh <<EOF; 1047 print $fh <<EOF;
1014 1048
1015EXTERN_C void 1049EXTERN_C void
1016staticperl_init (void) 1050staticperl_init (XSINIT_t xs_init)
1017{ 1051{
1018 static char *args[] = { 1052 static char *args[] = {
1019 "staticperl", 1053 "staticperl",
1020 "-e", 1054 "-e",
1021 "0" 1055 "0"
… …
1023 1057
1024 extern char **environ; 1058 extern char **environ;
1025 int argc = sizeof (args) / sizeof (args [0]); 1059 int argc = sizeof (args) / sizeof (args [0]);
1026 char **argv = args; 1060 char **argv = args;
1027 1061
1062$IGNORE_ENV
1028 PERL_SYS_INIT3 (&argc, &argv, &environ); 1063 PERL_SYS_INIT3 (&argc, &argv, &environ);
1029 staticperl = perl_alloc (); 1064 staticperl = perl_alloc ();
1030 perl_construct (staticperl); 1065 perl_construct (staticperl);
1031 PL_origalen = 1; 1066 PL_origalen = 1;
1032 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1067 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1068 PL_oldname = (char *)xs_init;
1033 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ); 1069 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
1034 1070
1035 perl_run (staticperl); 1071 perl_run (staticperl);
1036} 1072}
1037 1073

Diff Legend

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