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.12 by root, Fri Dec 10 20:29:17 2010 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
… …
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;
… …
230 my $path = "$_[0]/$_"; 244 my $path = "$_[0]/$_";
231 245
232 if (-d "$path/.") { 246 if (-d "$path/.") {
233 $scan->($path); 247 $scan->($path);
234 } else { 248 } else {
235 next unless /\.(?:pm|pl)$/;
236
237 $path = substr $path, $skip; 249 $path = substr $path, $skip;
238 push @tree, $path 250 push @tree, $path
239 unless exists $INCSKIP{$path}; 251 unless exists $INCSKIP{$path};
240 } 252 }
241 } 253 }
… …
262} 274}
263 275
264############################################################################# 276#############################################################################
265 277
266sub cmd_boot { 278sub cmd_boot {
267 $pm{"//boot"} = $_[0]; 279 $pm{"&&boot"} = $_[0];
268} 280}
269 281
270sub cmd_add { 282sub cmd_add {
271 $_[0] =~ /^(.*)(?:\s+(\S+))$/ 283 $_[0] =~ /^(.*?)(?:\s+(\S+))?$/
272 or die "$_[0]: cannot parse"; 284 or die "$_[0]: cannot parse";
273 285
274 my $file = $1; 286 my $file = $1;
275 my $as = defined $2 ? $2 : "/$1"; 287 my $as = defined $2 ? $2 : $1;
276 288
277 $pm{$as} = $file; 289 $pm{$as} = $file;
278 $pmbin{$as} = 1 if $_[1]; 290 $pmbin{$as} = 1 if $_[1];
279} 291}
280 292
… …
294 306
295 for (get_inctrees) { 307 for (get_inctrees) {
296 my ($dir, $files) = @$_; 308 my ($dir, $files) = @$_;
297 309
298 $pm{$_} = "$dir/$_" 310 $pm{$_} = "$dir/$_"
299 for grep /$pattern/, @$files; 311 for grep /$pattern/ && /\.(pl|pm)$/, @$files;
300 } 312 }
301} 313}
302 314
303sub parse_argv; 315sub parse_argv;
304 316
… …
325 337
326use Getopt::Long; 338use Getopt::Long;
327 339
328sub parse_argv { 340sub parse_argv {
329 GetOptions 341 GetOptions
342 "perl" => \$PERL,
343 "app=s" => \$APP,
344
345 "verbose|v" => sub { ++$VERBOSE },
346 "quiet|q" => sub { --$VERBOSE },
347
330 "strip=s" => \$STRIP, 348 "strip=s" => \$STRIP,
331 "cache=s" => \$CACHE, # internal option 349 "cache=s" => \$CACHE, # internal option
332 "verbose|v" => sub { ++$VERBOSE },
333 "quiet|q" => sub { --$VERBOSE },
334 "perl" => \$PERL,
335 "app=s" => \$APP,
336 "eval|e=s" => sub { trace_eval $_[1] }, 350 "eval|e=s" => sub { trace_eval $_[1] },
337 "use|M=s" => sub { trace_module $_[1] }, 351 "use|M=s" => sub { trace_module $_[1] },
338 "boot=s" => sub { cmd_boot $_[1] }, 352 "boot=s" => sub { cmd_boot $_[1] },
339 "add=s" => sub { cmd_add $_[1], 0 }, 353 "add=s" => sub { cmd_add $_[1], 0 },
340 "addbin=s" => sub { cmd_add $_[1], 1 }, 354 "addbin=s" => sub { cmd_add $_[1], 1 },
341 "incglob=s" => sub { cmd_incglob $_[1] }, 355 "incglob=s" => sub { cmd_incglob $_[1] },
342 "include|i=s" => sub { cmd_include $_[1], 1 }, 356 "include|i=s" => sub { cmd_include $_[1], 1 },
343 "exclude|x=s" => sub { cmd_include $_[1], 0 }, 357 "exclude|x=s" => sub { cmd_include $_[1], 0 },
344 "static!" => \$STATIC,
345 "usepacklist!" => \$PACKLIST, 358 "usepacklists!" => \$PACKLIST,
359
360 "static!" => \$STATIC,
346 "staticlib=s" => sub { cmd_staticlib $_[1] }, 361 "staticlib=s" => sub { cmd_staticlib $_[1] },
362 "ignore-env" => \$IGNORE_ENV,
363
347 "<>" => sub { cmd_file $_[0] }, 364 "<>" => sub { cmd_file $_[0] },
348 or exit 1; 365 or exit 1;
349} 366}
350 367
351Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); 368Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
352 369
… …
357 374
358# required for @INC loading, unfortunately 375# required for @INC loading, unfortunately
359trace_module "PerlIO::scalar"; 376trace_module "PerlIO::scalar";
360 377
361############################################################################# 378#############################################################################
362# include/exclude apply 379# apply include/exclude
363 380
364{ 381{
365 my %pmi; 382 my %pmi;
366 383
367 for (@incext) { 384 for (@incext) {
… …
377 if $VERBOSE >= 5; 394 if $VERBOSE >= 5;
378 } else { 395 } else {
379 # exclude 396 # exclude
380 delete @pm{@match}; 397 delete @pm{@match};
381 398
382 print "applying exclude $glob - excluded ", (scalar @match), " files.\n" 399 print "applying exclude $glob - removed ", (scalar @match), " files.\n"
383 if $VERBOSE >= 5; 400 if $VERBOSE >= 5;
384 } 401 }
385 } 402 }
386 403
387 my @pmi = keys %pmi; 404 my @pmi = keys %pmi;
388 @pm{@pmi} = delete @pmi{@pmi}; 405 @pm{@pmi} = delete @pmi{@pmi};
389} 406}
390 407
391############################################################################# 408#############################################################################
392# scan for AutoLoader and static archives 409# scan for AutoLoader, static archives and other dependencies
393 410
394sub scan_al { 411sub scan_al {
395 my ($auto, $autodir) = @_; 412 my ($auto, $autodir) = @_;
396 413
397 my $ix = "$autodir/autosplit.ix"; 414 my $ix = "$autodir/autosplit.ix";
… …
467 print "found .packlist for $pm\n" 484 print "found .packlist for $pm\n"
468 if $VERBOSE >= 3; 485 if $VERBOSE >= 3;
469 486
470 while (<$fh>) { 487 while (<$fh>) {
471 chomp; 488 chomp;
489 s/ .*$//; # newer-style .packlists might contain key=value pairs
472 490
473 # only include certain files (.al, .ix, .pm, .pl) 491 # only include certain files (.al, .ix, .pm, .pl)
474 if (/\.(pm|pl|al|ix)$/) { 492 if (/\.(pm|pl|al|ix)$/) {
475 for my $inc (@INC) { 493 for my $inc (@INC) {
476 # in addition, we only add files that are below some @INC path 494 # in addition, we only add files that are below some @INC path
… …
529 my $size = length $src; 547 my $size = length $src;
530 548
531 unless ($pmbin{$pm}) { # only do this unless the file is binary 549 unless ($pmbin{$pm}) { # only do this unless the file is binary
532 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { 550 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) {
533 if ($src =~ /^ unimpl \"/m) { 551 if ($src =~ /^ unimpl \"/m) {
534 print "$pm: skipping (only raises runtime error).\n" 552 print "$pm: skipping (raises runtime error only).\n"
535 if $VERBOSE >= 3; 553 if $VERBOSE >= 3;
536 next; 554 next;
537 } 555 }
538 } 556 }
539 557
… …
662 680
663 $src = $ppi->serialize; 681 $src = $ppi->serialize;
664 } else { 682 } else {
665 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n"; 683 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n";
666 } 684 }
667 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod 685 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses its own pod
668 require Pod::Strip; 686 require Pod::Strip;
669 687
670 my $stripper = Pod::Strip->new; 688 my $stripper = Pod::Strip->new;
671 689
672 my $out; 690 my $out;
… …
702} 720}
703 721
704length $data < 2**25 722length $data < 2**25
705 or die "ERROR: bundle too large (only 32MB supported)\n"; 723 or die "ERROR: bundle too large (only 32MB supported)\n";
706 724
707my $varpfx = "bundle_" . substr +(Digest::MD5::md5_hex $data), 0, 16; 725my $varpfx = "bundle";
708 726
709############################################################################# 727#############################################################################
710# output 728# output
711 729
712print "generating $PREFIX.h... " 730print "generating $PREFIX.h... "
… …
715{ 733{
716 open my $fh, ">", "$PREFIX.h" 734 open my $fh, ">", "$PREFIX.h"
717 or die "$PREFIX.h: $!\n"; 735 or die "$PREFIX.h: $!\n";
718 736
719 print $fh <<EOF; 737 print $fh <<EOF;
720/* do not edit, automatically created by mkstaticbundle */ 738/* do not edit, automatically created by staticperl */
721 739
722#include <EXTERN.h> 740#include <EXTERN.h>
723#include <perl.h> 741#include <perl.h>
724#include <XSUB.h> 742#include <XSUB.h>
725 743
726/* public API */ 744/* public API */
727EXTERN_C PerlInterpreter *staticperl; 745EXTERN_C PerlInterpreter *staticperl;
728EXTERN_C void staticperl_xs_init (pTHX); 746EXTERN_C void staticperl_xs_init (pTHX);
729EXTERN_C void staticperl_init (void); 747EXTERN_C void staticperl_init (XSINIT_t xs_init); /* argument can be 0 */
730EXTERN_C void staticperl_cleanup (void); 748EXTERN_C void staticperl_cleanup (void);
731 749
732EOF 750EOF
733} 751}
734 752
… …
743 761
744open my $fh, ">", "$PREFIX.c" 762open my $fh, ">", "$PREFIX.c"
745 or die "$PREFIX.c: $!\n"; 763 or die "$PREFIX.c: $!\n";
746 764
747print $fh <<EOF; 765print $fh <<EOF;
748/* do not edit, automatically created by mkstaticbundle */ 766/* do not edit, automatically created by staticperl */
749 767
750#include "bundle.h" 768#include "bundle.h"
751 769
752/* public API */ 770/* public API */
753PerlInterpreter *staticperl; 771PerlInterpreter *staticperl;
… …
803 $fh 821 $fh
804 }; 822 };
805} 823}
806'; 824';
807 825
808$bootstrap .= "require '//boot';" 826$bootstrap .= "require '&&boot';"
809 if exists $pm{"//boot"}; 827 if exists $pm{"&&boot"};
810 828
811$bootstrap =~ s/\s+/ /g; 829$bootstrap =~ s/\s+/ /g;
812$bootstrap =~ s/(\W) /$1/g; 830$bootstrap =~ s/(\W) /$1/g;
813$bootstrap =~ s/ (\W)/$1/g; 831$bootstrap =~ s/ (\W)/$1/g;
814 832
… …
934 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n"; 952 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n";
935} 953}
936 954
937print $fh <<EOF; 955print $fh <<EOF;
938 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);
939} 960}
940EOF 961EOF
941 962
942############################################################################# 963#############################################################################
943# optional perl_init/perl_destroy 964# optional perl_init/perl_destroy
944 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
945if ($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) {
946 print $fh <<EOF; 1020 print $fh <<EOF;
947 1021
948int 1022int
949main (int argc, char *argv []) 1023main (int argc, char *argv [])
950{ 1024{
951 extern char **environ; 1025 extern char **environ;
952 int exitstatus; 1026 int exitstatus;
953 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{
954 static char *args[] = { 1052 static char *args[] = {
955 "staticperl", 1053 "staticperl",
956 "-e", 1054 "-e",
957 "0" 1055 "0"
958 }; 1056 };
959 1057
960 PERL_SYS_INIT3 (&argc, &argv, &environ);
961 staticperl = perl_alloc ();
962 perl_construct (staticperl);
963
964 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
965
966 exitstatus = perl_parse (staticperl, staticperl_xs_init, sizeof (args) / sizeof (*args), args, environ);
967 if (!exitstatus)
968 perl_run (staticperl);
969
970 exitstatus = perl_destruct (staticperl);
971 perl_free (staticperl);
972 PERL_SYS_TERM ();
973
974 return exitstatus;
975}
976EOF
977} elsif ($PERL) {
978 print $fh <<EOF;
979
980int
981main (int argc, char *argv [])
982{
983 extern char **environ;
984 int exitstatus;
985
986 PERL_SYS_INIT3 (&argc, &argv, &environ);
987 staticperl = perl_alloc ();
988 perl_construct (staticperl);
989
990 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
991
992 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
993 if (!exitstatus)
994 perl_run (staticperl);
995
996 exitstatus = perl_destruct (staticperl);
997 perl_free (staticperl);
998 PERL_SYS_TERM ();
999
1000 return exitstatus;
1001}
1002EOF
1003} else {
1004 print $fh <<EOF;
1005
1006EXTERN_C void
1007staticperl_init (void)
1008{
1009 extern char **environ; 1058 extern char **environ;
1010 int argc = sizeof (args) / sizeof (args [0]); 1059 int argc = sizeof (args) / sizeof (args [0]);
1011 char **argv = args; 1060 char **argv = args;
1012 1061
1013 static char *args[] = { 1062$IGNORE_ENV
1014 "staticperl",
1015 "-e",
1016 "0"
1017 };
1018
1019 PERL_SYS_INIT3 (&argc, &argv, &environ); 1063 PERL_SYS_INIT3 (&argc, &argv, &environ);
1020 staticperl = perl_alloc (); 1064 staticperl = perl_alloc ();
1021 perl_construct (staticperl); 1065 perl_construct (staticperl);
1022 PL_origalen = 1; 1066 PL_origalen = 1;
1023 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1067 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1068 PL_oldname = (char *)xs_init;
1024 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ); 1069 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
1025 1070
1026 perl_run (staticperl); 1071 perl_run (staticperl);
1027} 1072}
1028 1073

Diff Legend

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