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

Comparing App-Staticperl/mkbundle (file contents):
Revision 1.12 by root, Fri Dec 10 20:29:17 2010 UTC vs.
Revision 1.17 by root, Wed Feb 9 09:52:27 2011 UTC

65 65
66 unless (fork) { 66 unless (fork) {
67 close $TRACER_R; 67 close $TRACER_R;
68 close $TRACER_W; 68 close $TRACER_W;
69 69
70 my $pkg = "pkg000000";
71
70 unshift @INC, sub { 72 unshift @INC, sub {
71 my $dir = find_incdir $_[1] 73 my $dir = find_incdir $_[1]
72 or return; 74 or return;
73 75
74 syswrite $W_TRACER, "-\n$dir\n$_[1]\n"; 76 syswrite $W_TRACER, "-\n$dir\n$_[1]\n";
80 }; 82 };
81 83
82 while (<$R_TRACER>) { 84 while (<$R_TRACER>) {
83 if (/use (.*)$/) { 85 if (/use (.*)$/) {
84 my $mod = $1; 86 my $mod = $1;
87 my $pkg = ++$pkg;
88 my $eval = $mod = $mod =~ /[^A-Za-z0-9_:]/
85 eval "require $mod"; 89 ? "require $mod"
90 : "{ package $pkg; use $mod; }";
91 eval $eval;
86 warn "ERROR: $@ (while loading '$mod')\n" 92 warn "ERROR: $@ (while loading '$mod')\n"
87 if $@; 93 if $@;
88 } elsif (/eval (.*)$/) { 94 } elsif (/eval (.*)$/) {
89 my $eval = $1; 95 my $eval = $1;
90 eval $eval; 96 eval $eval;
230 my $path = "$_[0]/$_"; 236 my $path = "$_[0]/$_";
231 237
232 if (-d "$path/.") { 238 if (-d "$path/.") {
233 $scan->($path); 239 $scan->($path);
234 } else { 240 } else {
235 next unless /\.(?:pm|pl)$/;
236
237 $path = substr $path, $skip; 241 $path = substr $path, $skip;
238 push @tree, $path 242 push @tree, $path
239 unless exists $INCSKIP{$path}; 243 unless exists $INCSKIP{$path};
240 } 244 }
241 } 245 }
294 298
295 for (get_inctrees) { 299 for (get_inctrees) {
296 my ($dir, $files) = @$_; 300 my ($dir, $files) = @$_;
297 301
298 $pm{$_} = "$dir/$_" 302 $pm{$_} = "$dir/$_"
299 for grep /$pattern/, @$files; 303 for grep /$pattern/ && /\.(pl|pm)$/, @$files;
300 } 304 }
301} 305}
302 306
303sub parse_argv; 307sub parse_argv;
304 308
325 329
326use Getopt::Long; 330use Getopt::Long;
327 331
328sub parse_argv { 332sub parse_argv {
329 GetOptions 333 GetOptions
330 "strip=s" => \$STRIP, 334 "strip=s" => \$STRIP,
331 "cache=s" => \$CACHE, # internal option 335 "cache=s" => \$CACHE, # internal option
332 "verbose|v" => sub { ++$VERBOSE }, 336 "verbose|v" => sub { ++$VERBOSE },
333 "quiet|q" => sub { --$VERBOSE }, 337 "quiet|q" => sub { --$VERBOSE },
334 "perl" => \$PERL, 338 "perl" => \$PERL,
335 "app=s" => \$APP, 339 "app=s" => \$APP,
336 "eval|e=s" => sub { trace_eval $_[1] }, 340 "eval|e=s" => sub { trace_eval $_[1] },
337 "use|M=s" => sub { trace_module $_[1] }, 341 "use|M=s" => sub { trace_module $_[1] },
338 "boot=s" => sub { cmd_boot $_[1] }, 342 "boot=s" => sub { cmd_boot $_[1] },
339 "add=s" => sub { cmd_add $_[1], 0 }, 343 "add=s" => sub { cmd_add $_[1], 0 },
340 "addbin=s" => sub { cmd_add $_[1], 1 }, 344 "addbin=s" => sub { cmd_add $_[1], 1 },
341 "incglob=s" => sub { cmd_incglob $_[1] }, 345 "incglob=s" => sub { cmd_incglob $_[1] },
342 "include|i=s" => sub { cmd_include $_[1], 1 }, 346 "include|i=s" => sub { cmd_include $_[1], 1 },
343 "exclude|x=s" => sub { cmd_include $_[1], 0 }, 347 "exclude|x=s" => sub { cmd_include $_[1], 0 },
344 "static!" => \$STATIC, 348 "static!" => \$STATIC,
345 "usepacklist!" => \$PACKLIST, 349 "usepacklists!" => \$PACKLIST,
346 "staticlib=s" => sub { cmd_staticlib $_[1] }, 350 "staticlib=s" => sub { cmd_staticlib $_[1] },
347 "<>" => sub { cmd_file $_[0] }, 351 "<>" => sub { cmd_file $_[0] },
348 or exit 1; 352 or exit 1;
349} 353}
350 354
351Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); 355Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
352 356
357 361
358# required for @INC loading, unfortunately 362# required for @INC loading, unfortunately
359trace_module "PerlIO::scalar"; 363trace_module "PerlIO::scalar";
360 364
361############################################################################# 365#############################################################################
362# include/exclude apply 366# apply include/exclude
363 367
364{ 368{
365 my %pmi; 369 my %pmi;
366 370
367 for (@incext) { 371 for (@incext) {
377 if $VERBOSE >= 5; 381 if $VERBOSE >= 5;
378 } else { 382 } else {
379 # exclude 383 # exclude
380 delete @pm{@match}; 384 delete @pm{@match};
381 385
382 print "applying exclude $glob - excluded ", (scalar @match), " files.\n" 386 print "applying exclude $glob - removed ", (scalar @match), " files.\n"
383 if $VERBOSE >= 5; 387 if $VERBOSE >= 5;
384 } 388 }
385 } 389 }
386 390
387 my @pmi = keys %pmi; 391 my @pmi = keys %pmi;
388 @pm{@pmi} = delete @pmi{@pmi}; 392 @pm{@pmi} = delete @pmi{@pmi};
389} 393}
390 394
391############################################################################# 395#############################################################################
392# scan for AutoLoader and static archives 396# scan for AutoLoader, static archives and other dependencies
393 397
394sub scan_al { 398sub scan_al {
395 my ($auto, $autodir) = @_; 399 my ($auto, $autodir) = @_;
396 400
397 my $ix = "$autodir/autosplit.ix"; 401 my $ix = "$autodir/autosplit.ix";
467 print "found .packlist for $pm\n" 471 print "found .packlist for $pm\n"
468 if $VERBOSE >= 3; 472 if $VERBOSE >= 3;
469 473
470 while (<$fh>) { 474 while (<$fh>) {
471 chomp; 475 chomp;
476 s/ .*$//; # newer-style .packlists might contain key=value pairs
472 477
473 # only include certain files (.al, .ix, .pm, .pl) 478 # only include certain files (.al, .ix, .pm, .pl)
474 if (/\.(pm|pl|al|ix)$/) { 479 if (/\.(pm|pl|al|ix)$/) {
475 for my $inc (@INC) { 480 for my $inc (@INC) {
476 # in addition, we only add files that are below some @INC path 481 # in addition, we only add files that are below some @INC path
529 my $size = length $src; 534 my $size = length $src;
530 535
531 unless ($pmbin{$pm}) { # only do this unless the file is binary 536 unless ($pmbin{$pm}) { # only do this unless the file is binary
532 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { 537 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) {
533 if ($src =~ /^ unimpl \"/m) { 538 if ($src =~ /^ unimpl \"/m) {
534 print "$pm: skipping (only raises runtime error).\n" 539 print "$pm: skipping (raises runtime error only).\n"
535 if $VERBOSE >= 3; 540 if $VERBOSE >= 3;
536 next; 541 next;
537 } 542 }
538 } 543 }
539 544
662 667
663 $src = $ppi->serialize; 668 $src = $ppi->serialize;
664 } else { 669 } else {
665 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n"; 670 warn "WARNING: $pm{$pm}: PPI failed to parse this file\n";
666 } 671 }
667 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod 672 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses its own pod
668 require Pod::Strip; 673 require Pod::Strip;
669 674
670 my $stripper = Pod::Strip->new; 675 my $stripper = Pod::Strip->new;
671 676
672 my $out; 677 my $out;
947 952
948int 953int
949main (int argc, char *argv []) 954main (int argc, char *argv [])
950{ 955{
951 extern char **environ; 956 extern char **environ;
957 int i, exitstatus;
958 char **args = malloc ((argc + 3) * sizeof (const char *));
959
960 args [0] = argv [0];
961 args [1] = "-e";
962 args [2] = "0";
963 args [3] = "--";
964
965 for (i = 1; i < argc; ++i)
966 args [i + 3] = argv [i];
967
968 PERL_SYS_INIT3 (&argc, &argv, &environ);
969 staticperl = perl_alloc ();
970 perl_construct (staticperl);
971
972 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
973
974 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc + 3, args, environ);
975 free (args);
976 if (!exitstatus)
977 perl_run (staticperl);
978
979 exitstatus = perl_destruct (staticperl);
980 perl_free (staticperl);
981 PERL_SYS_TERM ();
982
983 return exitstatus;
984}
985EOF
986} elsif ($PERL) {
987 print $fh <<EOF;
988
989int
990main (int argc, char *argv [])
991{
992 extern char **environ;
952 int exitstatus; 993 int exitstatus;
953 994
995 PERL_SYS_INIT3 (&argc, &argv, &environ);
996 staticperl = perl_alloc ();
997 perl_construct (staticperl);
998
999 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1000
1001 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
1002 if (!exitstatus)
1003 perl_run (staticperl);
1004
1005 exitstatus = perl_destruct (staticperl);
1006 perl_free (staticperl);
1007 PERL_SYS_TERM ();
1008
1009 return exitstatus;
1010}
1011EOF
1012} else {
1013 print $fh <<EOF;
1014
1015EXTERN_C void
1016staticperl_init (void)
1017{
954 static char *args[] = { 1018 static char *args[] = {
955 "staticperl", 1019 "staticperl",
956 "-e", 1020 "-e",
957 "0" 1021 "0"
958 }; 1022 };
959 1023
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; 1024 extern char **environ;
1010 int argc = sizeof (args) / sizeof (args [0]); 1025 int argc = sizeof (args) / sizeof (args [0]);
1011 char **argv = args; 1026 char **argv = args;
1012
1013 static char *args[] = {
1014 "staticperl",
1015 "-e",
1016 "0"
1017 };
1018 1027
1019 PERL_SYS_INIT3 (&argc, &argv, &environ); 1028 PERL_SYS_INIT3 (&argc, &argv, &environ);
1020 staticperl = perl_alloc (); 1029 staticperl = perl_alloc ();
1021 perl_construct (staticperl); 1030 perl_construct (staticperl);
1022 PL_origalen = 1; 1031 PL_origalen = 1;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines