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.28 by root, Sat Jul 9 18:26:27 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;
15our $ALLOW_DLLS = 0;
16our $HAVE_DLLS; # maybe useful?
14 17
15our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression? 18our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression?
16 19
17our $CACHE; 20our $CACHE;
18our $CACHEVER = 1; # do not change unless you know what you are doing 21our $CACHEVER = 1; # do not change unless you know what you are doing
… …
82 }; 85 };
83 86
84 while (<$R_TRACER>) { 87 while (<$R_TRACER>) {
85 if (/use (.*)$/) { 88 if (/use (.*)$/) {
86 my $mod = $1; 89 my $mod = $1;
90 my $eval;
91
92 if ($mod =~ /^'.*'$/ or $mod =~ /^".*"$/) {
93 $eval = "require $mod";
94 } elsif ($mod =~ y%/.%%) {
95 $eval = "require q\x00$mod\x00";
96 } else {
87 my $pkg = ++$pkg; 97 my $pkg = ++$pkg;
88 my $eval = $mod = $mod =~ /[^A-Za-z0-9_:]/
89 ? "require $mod"
90 : "{ package $pkg; use $mod; }"; 98 $eval = "{ package $pkg; use $mod; }";
99 }
100
91 eval $eval; 101 eval $eval;
92 warn "ERROR: $@ (while loading '$mod')\n" 102 warn "ERROR: $@ (while loading '$mod')\n"
93 if $@; 103 if $@;
94 } elsif (/eval (.*)$/) { 104 } elsif (/eval (.*)$/) {
95 my $eval = $1; 105 my $eval = $1;
… …
266} 276}
267 277
268############################################################################# 278#############################################################################
269 279
270sub cmd_boot { 280sub cmd_boot {
271 $pm{"//boot"} = $_[0]; 281 $pm{"&&boot"} = $_[0];
272} 282}
273 283
274sub cmd_add { 284sub cmd_add {
275 $_[0] =~ /^(.*)(?:\s+(\S+))$/ 285 $_[0] =~ /^(.*?)(?:\s+(\S+))?$/
276 or die "$_[0]: cannot parse"; 286 or die "$_[0]: cannot parse";
277 287
278 my $file = $1; 288 my $file = $1;
279 my $as = defined $2 ? $2 : "/$1"; 289 my $as = defined $2 ? $2 : $1;
280 290
281 $pm{$as} = $file; 291 $pm{$as} = $file;
282 $pmbin{$as} = 1 if $_[1]; 292 $pmbin{$as} = 1 if $_[1];
283} 293}
284 294
… …
329 339
330use Getopt::Long; 340use Getopt::Long;
331 341
332sub parse_argv { 342sub parse_argv {
333 GetOptions 343 GetOptions
344 "perl" => \$PERL,
345 "app=s" => \$APP,
346
347 "verbose|v" => sub { ++$VERBOSE },
348 "quiet|q" => sub { --$VERBOSE },
349
334 "strip=s" => \$STRIP, 350 "strip=s" => \$STRIP,
335 "cache=s" => \$CACHE, # internal option 351 "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] }, 352 "eval|e=s" => sub { trace_eval $_[1] },
341 "use|M=s" => sub { trace_module $_[1] }, 353 "use|M=s" => sub { trace_module $_[1] },
342 "boot=s" => sub { cmd_boot $_[1] }, 354 "boot=s" => sub { cmd_boot $_[1] },
343 "add=s" => sub { cmd_add $_[1], 0 }, 355 "add=s" => sub { cmd_add $_[1], 0 },
344 "addbin=s" => sub { cmd_add $_[1], 1 }, 356 "addbin=s" => sub { cmd_add $_[1], 1 },
345 "incglob=s" => sub { cmd_incglob $_[1] }, 357 "incglob=s" => sub { cmd_incglob $_[1] },
346 "include|i=s" => sub { cmd_include $_[1], 1 }, 358 "include|i=s" => sub { cmd_include $_[1], 1 },
347 "exclude|x=s" => sub { cmd_include $_[1], 0 }, 359 "exclude|x=s" => sub { cmd_include $_[1], 0 },
360 "usepacklists!" => \$PACKLIST,
361
348 "static!" => \$STATIC, 362 "static!" => \$STATIC,
349 "usepacklists!" => \$PACKLIST,
350 "staticlib=s" => sub { cmd_staticlib $_[1] }, 363 "staticlib=s" => sub { cmd_staticlib $_[1] },
364 "allow-dlls" => \$ALLOW_DLLS,
365 "ignore-env" => \$IGNORE_ENV,
366
351 "<>" => sub { cmd_file $_[0] }, 367 "<>" => sub { cmd_file $_[0] },
352 or exit 1; 368 or exit 1;
353} 369}
354 370
355Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); 371Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
… …
462 push @libs, "$autodir/$base$Config{_a}"; 478 push @libs, "$autodir/$base$Config{_a}";
463 push @static_ext, $pm; 479 push @static_ext, $pm;
464 } 480 }
465 481
466 # dynamic object 482 # dynamic object
467 die "ERROR: found shared object - can't link statically ($_)\n"
468 if -f "$autodir/$base.$Config{dlext}"; 483 if (-f "$autodir/$base.$Config{dlext}") {
484 if ($ALLOW_DLLS) {
485 my $as = "&fs/perl/$auto/$base.$Config{dlext}";
486 $pm{$as} = "$autodir/$base.$Config{dlext}";
487 $pmbin{$as} = 1;
488
489 $HAVE_DLLS = 1;
490
491 print "+ added dynamic object $auto/$base.$Config{dlext}\n"
492 if $VERBOSE >= 3;
493 } else {
494 die "ERROR: found shared object '$_' but --allow-dlls not given, aborting.\n"
495 }
496 }
469 497
470 if ($PACKLIST && open my $fh, "<:perlio", "$autodir/.packlist") { 498 if ($PACKLIST && open my $fh, "<:perlio", "$autodir/.packlist") {
471 print "found .packlist for $pm\n" 499 print "found .packlist for $pm\n"
472 if $VERBOSE >= 3; 500 if $VERBOSE >= 3;
473 501
… …
707} 735}
708 736
709length $data < 2**25 737length $data < 2**25
710 or die "ERROR: bundle too large (only 32MB supported)\n"; 738 or die "ERROR: bundle too large (only 32MB supported)\n";
711 739
712my $varpfx = "bundle_" . substr +(Digest::MD5::md5_hex $data), 0, 16; 740my $varpfx = "bundle";
713 741
714############################################################################# 742#############################################################################
715# output 743# output
716 744
717print "generating $PREFIX.h... " 745print "generating $PREFIX.h... "
… …
720{ 748{
721 open my $fh, ">", "$PREFIX.h" 749 open my $fh, ">", "$PREFIX.h"
722 or die "$PREFIX.h: $!\n"; 750 or die "$PREFIX.h: $!\n";
723 751
724 print $fh <<EOF; 752 print $fh <<EOF;
725/* do not edit, automatically created by mkstaticbundle */ 753/* do not edit, automatically created by staticperl */
726 754
727#include <EXTERN.h> 755#include <EXTERN.h>
728#include <perl.h> 756#include <perl.h>
729#include <XSUB.h> 757#include <XSUB.h>
730 758
731/* public API */ 759/* public API */
732EXTERN_C PerlInterpreter *staticperl; 760EXTERN_C PerlInterpreter *staticperl;
733EXTERN_C void staticperl_xs_init (pTHX); 761EXTERN_C void staticperl_xs_init (pTHX);
734EXTERN_C void staticperl_init (void); 762EXTERN_C void staticperl_init (XSINIT_t xs_init); /* argument can be 0 */
735EXTERN_C void staticperl_cleanup (void); 763EXTERN_C void staticperl_cleanup (void);
736 764
737EOF 765EOF
738} 766}
739 767
… …
748 776
749open my $fh, ">", "$PREFIX.c" 777open my $fh, ">", "$PREFIX.c"
750 or die "$PREFIX.c: $!\n"; 778 or die "$PREFIX.c: $!\n";
751 779
752print $fh <<EOF; 780print $fh <<EOF;
753/* do not edit, automatically created by mkstaticbundle */ 781/* do not edit, automatically created by staticperl */
754 782
755#include "bundle.h" 783#include "bundle.h"
756 784
757/* public API */ 785/* public API */
758PerlInterpreter *staticperl; 786PerlInterpreter *staticperl;
… …
790# bootstrap 818# bootstrap
791 819
792# boot file for staticperl 820# boot file for staticperl
793# this file will be eval'ed at initialisation time 821# this file will be eval'ed at initialisation time
794 822
823# lines marked with "^D" are only used when $HAVE_DLLS
795my $bootstrap = ' 824my $bootstrap = '
796BEGIN { 825BEGIN {
797 package ' . $PACKAGE . '; 826 package ' . $PACKAGE . ';
798 827
799 PerlIO::scalar->bootstrap; 828 # the path prefix to use when putting files into %INC
829 our $inc_prefix;
800 830
801 @INC = sub { 831 # the @INC hook to use when we have PerlIO::scalar available
832 my $perlio_inc = sub {
802 my $data = find "$_[1]" 833 my $data = find "$_[1]"
803 or return; 834 or return;
804 835
805 $INC{$_[1]} = $_[1]; 836 $INC{$_[1]} = "$inc_prefix$_[1]";
806 837
807 open my $fh, "<", \$data; 838 open my $fh, "<", \$data;
808 $fh 839 $fh
809 }; 840 };
841
842D if (defined &PerlIO::scalar::bootstrap) {
843 # PerlIO::scalar statically compiled in
844 PerlIO::scalar->bootstrap;
845 @INC = $perlio_inc;
846D } else {
847D # PerlIO::scalar not available, use slower method
848D @INC = sub {
849D # always check if PerlIO::scalar might now be available
850D if (defined &PerlIO::scalar::bootstrap) {
851D # switch to the faster perlio_inc hook
852D @INC = map { $_ == $_[0] ? $perlio_inc : $_ } @INC;
853D goto &$perlio_inc;
854D }
855D
856D my $data = find "$_[1]"
857D or return;
858D
859D $INC{$_[1]} = "$inc_prefix$_[1]";
860D
861D sub {
862D $data =~ /\G([^\n]*\n?)/g
863D or return;
864D
865D $_ = $1;
866D 1
867D }
868D };
869D }
810} 870}
811'; 871';
812 872
813$bootstrap .= "require '//boot';" 873$bootstrap .= "require '&&boot';"
814 if exists $pm{"//boot"}; 874 if exists $pm{"&&boot"};
815 875
876if ($HAVE_DLLS) {
877 $bootstrap =~ s/^D/ /mg;
878} else {
879 $bootstrap =~ s/^D.*$//mg;
880}
881
882$bootstrap =~ s/#.*$//mg;
816$bootstrap =~ s/\s+/ /g; 883$bootstrap =~ s/\s+/ /g;
817$bootstrap =~ s/(\W) /$1/g; 884$bootstrap =~ s/(\W) /$1/g;
818$bootstrap =~ s/ (\W)/$1/g; 885$bootstrap =~ s/ (\W)/$1/g;
819 886
820print $fh "const char bootstrap [] = "; 887print $fh "const char bootstrap [] = ";
… …
866 } 933 }
867 934
868 XSRETURN (0); 935 XSRETURN (0);
869 936
870 found: 937 found:
871 ST (0) = res; 938 ST (0) = sv_2mortal (res);
872 sv_2mortal (ST (0));
873 } 939 }
874 940
875 XSRETURN (1); 941 XSRETURN (1);
876} 942}
877 943
… …
890 956
891 for (i = 0; i < $varpfx\_count; ++i) 957 for (i = 0; i < $varpfx\_count; ++i)
892 { 958 {
893 U32 idx = $varpfx\_index [i]; 959 U32 idx = $varpfx\_index [i];
894 960
895 PUSHs (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25)); 961 PUSHs (sv_2mortal (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25)));
896 } 962 }
897 } 963 }
898 964
899 XSRETURN ($varpfx\_count); 965 XSRETURN ($varpfx\_count);
900} 966}
… …
908void 974void
909staticperl_xs_init (pTHX) 975staticperl_xs_init (pTHX)
910{ 976{
911EOF 977EOF
912 978
913@static_ext = ("DynaLoader", sort @static_ext); 979@static_ext = sort @static_ext;
914 980
915# prototypes 981# prototypes
916for (@static_ext) { 982for (@static_ext) {
917 s/\.pm$//; 983 s/\.pm$//;
918 (my $cname = $_) =~ s/\//__/g; 984 (my $cname = $_) =~ s/\//__/g;
… …
932 s/\.pm$//; 998 s/\.pm$//;
933 999
934 (my $cname = $_) =~ s/\//__/g; 1000 (my $cname = $_) =~ s/\//__/g;
935 (my $pname = $_) =~ s/\//::/g; 1001 (my $pname = $_) =~ s/\//::/g;
936 1002
937 my $bootstrap = $pname eq "DynaLoader" ? "boot" : "bootstrap"; 1003 my $bootstrap = $pname eq "DynaLoader" ? "boot_DynaLoader" : "bootstrap";
938 1004
939 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n"; 1005 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n";
940} 1006}
941 1007
942print $fh <<EOF; 1008print $fh <<EOF;
943 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1)); 1009 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1));
1010
1011 if (PL_oldname)
1012 ((XSINIT_t)PL_oldname)(aTHX);
944} 1013}
945EOF 1014EOF
946 1015
947############################################################################# 1016#############################################################################
948# optional perl_init/perl_destroy 1017# optional perl_init/perl_destroy
1018
1019if ($IGNORE_ENV) {
1020 $IGNORE_ENV = <<EOF;
1021 unsetenv ("PERL_UNICODE");
1022 unsetenv ("PERL_HASH_SEED_DEBUG");
1023 unsetenv ("PERL_DESTRUCT_LEVEL");
1024 unsetenv ("PERL_SIGNALS");
1025 unsetenv ("PERL_DEBUG_MSTATS");
1026 unsetenv ("PERL5OPT");
1027 unsetenv ("PERLIO_DEBUG");
1028 unsetenv ("PERLIO");
1029 unsetenv ("PERL_HASH_SEED");
1030EOF
1031} else {
1032 $IGNORE_ENV = "";
1033}
949 1034
950if ($APP) { 1035if ($APP) {
951 print $fh <<EOF; 1036 print $fh <<EOF;
952 1037
953int 1038int
… …
963 args [3] = "--"; 1048 args [3] = "--";
964 1049
965 for (i = 1; i < argc; ++i) 1050 for (i = 1; i < argc; ++i)
966 args [i + 3] = argv [i]; 1051 args [i + 3] = argv [i];
967 1052
1053$IGNORE_ENV
968 PERL_SYS_INIT3 (&argc, &argv, &environ); 1054 PERL_SYS_INIT3 (&argc, &argv, &environ);
969 staticperl = perl_alloc (); 1055 staticperl = perl_alloc ();
970 perl_construct (staticperl); 1056 perl_construct (staticperl);
971 1057
972 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1058 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
… …
990main (int argc, char *argv []) 1076main (int argc, char *argv [])
991{ 1077{
992 extern char **environ; 1078 extern char **environ;
993 int exitstatus; 1079 int exitstatus;
994 1080
1081$IGNORE_ENV
995 PERL_SYS_INIT3 (&argc, &argv, &environ); 1082 PERL_SYS_INIT3 (&argc, &argv, &environ);
996 staticperl = perl_alloc (); 1083 staticperl = perl_alloc ();
997 perl_construct (staticperl); 1084 perl_construct (staticperl);
998 1085
999 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1086 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
… …
1011EOF 1098EOF
1012} else { 1099} else {
1013 print $fh <<EOF; 1100 print $fh <<EOF;
1014 1101
1015EXTERN_C void 1102EXTERN_C void
1016staticperl_init (void) 1103staticperl_init (XSINIT_t xs_init)
1017{ 1104{
1018 static char *args[] = { 1105 static char *args[] = {
1019 "staticperl", 1106 "staticperl",
1020 "-e", 1107 "-e",
1021 "0" 1108 "0"
… …
1023 1110
1024 extern char **environ; 1111 extern char **environ;
1025 int argc = sizeof (args) / sizeof (args [0]); 1112 int argc = sizeof (args) / sizeof (args [0]);
1026 char **argv = args; 1113 char **argv = args;
1027 1114
1115$IGNORE_ENV
1028 PERL_SYS_INIT3 (&argc, &argv, &environ); 1116 PERL_SYS_INIT3 (&argc, &argv, &environ);
1029 staticperl = perl_alloc (); 1117 staticperl = perl_alloc ();
1030 perl_construct (staticperl); 1118 perl_construct (staticperl);
1031 PL_origalen = 1; 1119 PL_origalen = 1;
1032 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1120 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1121 PL_oldname = (char *)xs_init;
1033 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ); 1122 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
1034 1123
1035 perl_run (staticperl); 1124 perl_run (staticperl);
1036} 1125}
1037 1126

Diff Legend

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