… | |
… | |
4 | # cannot load modules till after the tracer BEGIN block |
4 | # cannot load modules till after the tracer BEGIN block |
5 | |
5 | |
6 | our $VERBOSE = 1; |
6 | our $VERBOSE = 1; |
7 | our $STRIP = "pod"; # none, pod or ppi |
7 | our $STRIP = "pod"; # none, pod or ppi |
8 | our $PERL = 0; |
8 | our $PERL = 0; |
|
|
9 | our $APP; |
9 | our $VERIFY = 0; |
10 | our $VERIFY = 0; |
10 | our $STATIC = 0; |
11 | our $STATIC = 0; |
11 | |
12 | |
12 | my $PREFIX = "bundle"; |
13 | my $PREFIX = "bundle"; |
13 | my $PACKAGE = "static"; |
14 | my $PACKAGE = "static"; |
… | |
… | |
88 | or die "$autodir/$ix: $!"; |
89 | or die "$autodir/$ix: $!"; |
89 | |
90 | |
90 | my $package; |
91 | my $package; |
91 | |
92 | |
92 | while (<$fh>) { |
93 | while (<$fh>) { |
93 | if (/^\s*sub\s+([^[:space:];]+)\s*;?\s*$/) { |
94 | if (/^\s*sub\s+ ([^[:space:];]+) \s* (?:\([^)]*\))? \s*;?\s*$/x) { |
94 | my $al = "auto/$package/$1.al"; |
95 | my $al = "auto/$package/$1.al"; |
95 | my $inc = find_inc $al; |
96 | my $inc = find_inc $al; |
96 | |
97 | |
97 | defined $inc or die "$al: autoload file not found, but should be there.\n"; |
98 | defined $inc or die "$al: autoload file not found, but should be there.\n"; |
98 | |
99 | |
… | |
… | |
220 | my ($cmd, $args) = split / /, $_, 2; |
221 | my ($cmd, $args) = split / /, $_, 2; |
221 | $cmd =~ s/^-+//; |
222 | $cmd =~ s/^-+//; |
222 | |
223 | |
223 | if ($cmd eq "strip") { |
224 | if ($cmd eq "strip") { |
224 | $STRIP = $args; |
225 | $STRIP = $args; |
|
|
226 | } elsif ($cmd eq "perl") { |
|
|
227 | $PERL = 1; |
|
|
228 | } elsif ($cmd eq "app") { |
|
|
229 | $APP = $args; |
225 | } elsif ($cmd eq "eval") { |
230 | } elsif ($cmd eq "eval") { |
226 | trace_eval $_; |
231 | trace_eval $_; |
227 | } elsif ($cmd eq "use") { |
232 | } elsif ($cmd eq "use") { |
228 | trace_module $_ |
233 | trace_module $_ |
229 | for split / /, $args; |
234 | for split / /, $args; |
… | |
… | |
250 | GetOptions |
255 | GetOptions |
251 | "strip=s" => \$STRIP, |
256 | "strip=s" => \$STRIP, |
252 | "verbose|v" => sub { ++$VERBOSE }, |
257 | "verbose|v" => sub { ++$VERBOSE }, |
253 | "quiet|q" => sub { --$VERBOSE }, |
258 | "quiet|q" => sub { --$VERBOSE }, |
254 | "perl" => \$PERL, |
259 | "perl" => \$PERL, |
|
|
260 | "app=s" => \$APP, |
255 | "eval|e=s" => sub { trace_eval $_[1] }, |
261 | "eval|e=s" => sub { trace_eval $_[1] }, |
256 | "use|M=s" => sub { trace_module $_[1] }, |
262 | "use|M=s" => sub { trace_module $_[1] }, |
257 | "boot=s" => sub { cmd_boot $_[1] }, |
263 | "boot=s" => sub { cmd_boot $_[1] }, |
258 | "add=s" => sub { cmd_add $_[1], 0 }, |
264 | "add=s" => sub { cmd_add $_[1], 0 }, |
259 | "addbin=s" => sub { cmd_add $_[1], 1 }, |
265 | "addbin=s" => sub { cmd_add $_[1], 1 }, |
260 | "static" => sub { $STATIC = 1 }, |
266 | "static" => sub { $STATIC = 1 }, |
261 | "<>" => sub { cmd_file $_[0] }, |
267 | "<>" => sub { cmd_file $_[0] }, |
262 | or exit 1; |
268 | or exit 1; |
|
|
269 | |
|
|
270 | die "cannot specify both --app and --perl\n" |
|
|
271 | if $PERL and defined $APP; |
263 | |
272 | |
264 | my $data; |
273 | my $data; |
265 | my @index; |
274 | my @index; |
266 | my @order = sort { |
275 | my @order = sort { |
267 | length $a <=> length $b |
276 | length $a <=> length $b |
… | |
… | |
611 | } |
620 | } |
612 | |
621 | |
613 | XSRETURN ($varpfx\_count); |
622 | XSRETURN ($varpfx\_count); |
614 | } |
623 | } |
615 | |
624 | |
616 | static char *args[] = { |
|
|
617 | "staticperl", |
|
|
618 | "-e", |
|
|
619 | "0" |
|
|
620 | }; |
|
|
621 | |
|
|
622 | EOF |
625 | EOF |
623 | |
626 | |
624 | ############################################################################# |
627 | ############################################################################# |
625 | # xs_init |
628 | # xs_init |
626 | |
629 | |
… | |
… | |
665 | EOF |
668 | EOF |
666 | |
669 | |
667 | ############################################################################# |
670 | ############################################################################# |
668 | # optional perl_init/perl_destroy |
671 | # optional perl_init/perl_destroy |
669 | |
672 | |
670 | if ($PERL) { |
673 | if ($APP) { |
671 | print $fh <<EOF; |
674 | print $fh <<EOF; |
672 | |
675 | |
673 | int |
676 | int |
674 | main (int argc, char *argv []) |
677 | main (int argc, char *argv []) |
675 | { |
678 | { |
676 | extern char **environ; |
679 | extern char **environ; |
677 | int exitstatus; |
680 | int exitstatus; |
|
|
681 | |
|
|
682 | static char *args[] = { |
|
|
683 | "staticperl", |
|
|
684 | "-e", |
|
|
685 | "0" |
|
|
686 | }; |
678 | |
687 | |
679 | PERL_SYS_INIT3 (&argc, &argv, &environ); |
688 | PERL_SYS_INIT3 (&argc, &argv, &environ); |
680 | staticperl = perl_alloc (); |
689 | staticperl = perl_alloc (); |
681 | perl_construct (staticperl); |
690 | perl_construct (staticperl); |
682 | |
691 | |
683 | PL_exit_flags |= PERL_EXIT_DESTRUCT_END; |
692 | PL_exit_flags |= PERL_EXIT_DESTRUCT_END; |
684 | |
693 | |
|
|
694 | exitstatus = perl_parse (staticperl, staticperl_xs_init, sizeof (args) / sizeof (*args), args, environ); |
|
|
695 | if (!exitstatus) |
|
|
696 | perl_run (staticperl); |
|
|
697 | |
|
|
698 | exitstatus = perl_destruct (staticperl); |
|
|
699 | perl_free (staticperl); |
|
|
700 | PERL_SYS_TERM (); |
|
|
701 | |
|
|
702 | return exitstatus; |
|
|
703 | } |
|
|
704 | EOF |
|
|
705 | } elsif ($PERL) { |
|
|
706 | print $fh <<EOF; |
|
|
707 | |
|
|
708 | int |
|
|
709 | main (int argc, char *argv []) |
|
|
710 | { |
|
|
711 | extern char **environ; |
|
|
712 | int exitstatus; |
|
|
713 | |
|
|
714 | PERL_SYS_INIT3 (&argc, &argv, &environ); |
|
|
715 | staticperl = perl_alloc (); |
|
|
716 | perl_construct (staticperl); |
|
|
717 | |
|
|
718 | PL_exit_flags |= PERL_EXIT_DESTRUCT_END; |
|
|
719 | |
685 | exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ); |
720 | exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ); |
686 | if (!exitstatus) |
721 | if (!exitstatus) |
687 | perl_run (staticperl); |
722 | perl_run (staticperl); |
688 | |
723 | |
689 | exitstatus = perl_destruct (staticperl); |
724 | exitstatus = perl_destruct (staticperl); |
… | |
… | |
700 | staticperl_init (void) |
735 | staticperl_init (void) |
701 | { |
736 | { |
702 | extern char **environ; |
737 | extern char **environ; |
703 | int argc = sizeof (args) / sizeof (args [0]); |
738 | int argc = sizeof (args) / sizeof (args [0]); |
704 | char **argv = args; |
739 | char **argv = args; |
|
|
740 | |
|
|
741 | static char *args[] = { |
|
|
742 | "staticperl", |
|
|
743 | "-e", |
|
|
744 | "0" |
|
|
745 | }; |
705 | |
746 | |
706 | PERL_SYS_INIT3 (&argc, &argv, &environ); |
747 | PERL_SYS_INIT3 (&argc, &argv, &environ); |
707 | staticperl = perl_alloc (); |
748 | staticperl = perl_alloc (); |
708 | perl_construct (staticperl); |
749 | perl_construct (staticperl); |
709 | PL_origalen = 1; |
750 | PL_origalen = 1; |
… | |
… | |
759 | open my $fh, ">$PREFIX.ldopts" |
800 | open my $fh, ">$PREFIX.ldopts" |
760 | or die "$PREFIX.ldopts: $!"; |
801 | or die "$PREFIX.ldopts: $!"; |
761 | print $fh $str; |
802 | print $fh $str; |
762 | } |
803 | } |
763 | |
804 | |
764 | if ($PERL) { |
805 | if ($PERL or defined $APP) { |
|
|
806 | $APP = "perl" unless defined $APP; |
|
|
807 | |
|
|
808 | print "generating $APP...\n"; |
|
|
809 | |
765 | system "$Config{cc} \$(cat bundle.ccopts\) -o perl bundle.c \$(cat bundle.ldopts\)"; |
810 | system "$Config{cc} \$(cat bundle.ccopts\) -o \Q$APP\E bundle.c \$(cat bundle.ldopts\)"; |
766 | |
811 | |
767 | unlink "$PREFIX.$_" |
812 | unlink "$PREFIX.$_" |
768 | for qw(ccopts ldopts c h); |
813 | for qw(ccopts ldopts c h); |
769 | } |
814 | } |
770 | |
815 | |