--- cvsroot/App-Staticperl/mkbundle	2010/12/10 02:35:54	1.11
+++ cvsroot/App-Staticperl/mkbundle	2011/02/10 11:49:19	1.22
@@ -10,6 +10,7 @@
 our $APP;
 our $VERIFY   = 0;
 our $STATIC   = 0;
+our $PACKLIST = 0;
 
 our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression?
 
@@ -37,7 +38,7 @@
 
 our ($TRACER_W, $TRACER_R);
 
-sub find_inc($) {
+sub find_incdir($) {
    for (@INC) {
       next if ref;
       return $_ if -e "$_/$_[0]";
@@ -46,6 +47,15 @@
    undef
 }
 
+sub find_inc($) {
+   my $dir = find_incdir $_[0];
+
+   return "$dir/$_[0]"
+      if defined $dir;
+
+   undef
+}
+
 BEGIN {
    # create a loader process to detect @INC requests before we load any modules
    my ($W_TRACER, $R_TRACER); # used by tracer
@@ -57,8 +67,10 @@
       close $TRACER_R;
       close $TRACER_W;
 
+      my $pkg = "pkg000000";
+
       unshift @INC, sub {
-         my $dir = find_inc $_[1]
+         my $dir = find_incdir $_[1]
             or return;
 
          syswrite $W_TRACER, "-\n$dir\n$_[1]\n";
@@ -72,16 +84,21 @@
       while (<$R_TRACER>) {
          if (/use (.*)$/) {
             my $mod = $1;
-            eval "require $mod";
+            my $pkg = ++$pkg;
+            my $eval = $mod = $mod =~ /[^A-Za-z0-9_:]/
+                       ? "require $mod"
+                       : "{ package $pkg; use $mod; }";
+            eval $eval;
             warn "ERROR: $@ (while loading '$mod')\n"
                if $@;
-            syswrite $W_TRACER, "\n";
          } elsif (/eval (.*)$/) {
             my $eval = $1;
             eval $eval;
             warn "ERROR: $@ (in '$eval')\n"
                if $@;
          }
+
+         syswrite $W_TRACER, "\n";
       }
 
       exit 0;
@@ -90,20 +107,33 @@
 
 # module loading is now safe
 
-sub trace_module {
-   syswrite $TRACER_W, "use $_[0]\n";
-
+sub trace_parse {
    for (;;) {
       <$TRACER_R> =~ /^-$/ or last;
       my $dir  = <$TRACER_R>; chomp $dir;
       my $name = <$TRACER_R>; chomp $name;
 
       $pm{$name} = "$dir/$name";
+
+      print "+ found potential dependency $name\n"
+         if $VERBOSE >= 3;
    }
 }
 
+sub trace_module {
+   print "tracing module $_[0]\n"
+      if $VERBOSE >= 2;
+
+   syswrite $TRACER_W, "use $_[0]\n";
+   trace_parse;
+}
+
 sub trace_eval {
+   print "tracing eval $_[0]\n"
+      if $VERBOSE >= 2;
+
    syswrite $TRACER_W, "eval $_[0]\n";
+   trace_parse;
 }
 
 sub trace_finish {
@@ -121,16 +151,22 @@
 sub cache($$$) {
    my ($variant, $src, $filter) = @_;
 
-   if (length $CACHE and 2048 <= length $src) {
+   if (length $CACHE and 2048 <= length $src and defined $variant) {
       my $file = "$CACHE/" . Digest::MD5::md5_hex "$CACHEVER\x00$variant\x00$src";
 
       if (open my $fh, "<:perlio", $file) {
+         print "using cache for $file\n"
+            if $VERBOSE >= 7;
+
          local $/;
          return <$fh>;
       }
 
       $src = $filter->($src);
 
+      print "creating cache entry $file\n"
+         if $VERBOSE >= 8;
+
       if (open my $fh, ">:perlio", "$file~") {
          if ((syswrite $fh, $src) == length $src) {
             close $fh;
@@ -202,8 +238,6 @@
          if (-d "$path/.") {
             $scan->($path);
          } else {
-            next unless /\.(?:pm|pl)$/;
-
             $path = substr $path, $skip;
             push @tree, $path
                unless exists $INCSKIP{$path};
@@ -234,15 +268,15 @@
 #############################################################################
 
 sub cmd_boot {
-   $pm{"//boot"} = $_[0];
+   $pm{"&&boot"} = $_[0];
 }
 
 sub cmd_add {
-   $_[0] =~ /^(.*)(?:\s+(\S+))$/
+   $_[0] =~ /^(.*?)(?:\s+(\S+))?$/
       or die "$_[0]: cannot parse";
 
    my $file = $1;
-   my $as   = defined $2 ? $2 : "/$1";
+   my $as   = defined $2 ? $2 : "&$1";
 
    $pm{$as} = $file;
    $pmbin{$as} = 1 if $_[1];
@@ -266,77 +300,61 @@
       my ($dir, $files) = @$_;
 
       $pm{$_} = "$dir/$_"
-         for grep /$pattern/, @$files;
+         for grep /$pattern/ && /\.(pl|pm)$/, @$files;
    }
 }
 
+sub parse_argv;
+
 sub cmd_file {
    open my $fh, "<", $_[0]
       or die "$_[0]: $!\n";
 
+   local @ARGV;
+
    while (<$fh>) {
       chomp;
+      next unless /\S/;
+      next if /^\s*#/;
+
+      s/^\s*-*/--/;
       my ($cmd, $args) = split / /, $_, 2;
-      $cmd =~ s/^-+//;
 
-      if ($cmd eq "strip") {
-         $STRIP = $args;
-      } elsif ($cmd eq "perl") {
-         $PERL = 1;
-      } elsif ($cmd eq "app") {
-         $APP = $args;
-      } elsif ($cmd eq "eval") {
-         trace_eval $_;
-      } elsif ($cmd eq "use") {
-         trace_module $_
-            for split / /, $args;
-      } elsif ($cmd eq "staticlib") {
-         cmd_staticlib $args;
-      } elsif ($cmd eq "boot") {
-         cmd_boot $args;
-      } elsif ($cmd eq "static") {
-         $STATIC = 1;
-      } elsif ($cmd eq "add") {
-         cmd_add $args, 0;
-      } elsif ($cmd eq "addbin") {
-         cmd_add $args, 1;
-      } elsif ($cmd eq "incglob") {
-         cmd_incglob $args;
-      } elsif ($cmd eq "include") {
-         cmd_include $args, 1;
-      } elsif ($cmd eq "exclude") {
-         cmd_include $args, 0;
-      } elsif (/^\s*#/) {
-         # comment
-      } elsif (/\S/) {
-         die "$_: unsupported directive\n";
-      }
+      push @ARGV, $cmd;
+      push @ARGV, $args if defined $args;
    }
+
+   parse_argv;
 }
 
 use Getopt::Long;
 
+sub parse_argv {
+   GetOptions
+      "strip=s"       => \$STRIP,
+      "cache=s"       => \$CACHE, # internal option
+      "verbose|v"     => sub { ++$VERBOSE },
+      "quiet|q"       => sub { --$VERBOSE },
+      "perl"          => \$PERL,
+      "app=s"         => \$APP,
+      "eval|e=s"      => sub { trace_eval    $_[1] },
+      "use|M=s"       => sub { trace_module  $_[1] },
+      "boot=s"        => sub { cmd_boot      $_[1] },
+      "add=s"         => sub { cmd_add       $_[1], 0 },
+      "addbin=s"      => sub { cmd_add       $_[1], 1 },
+      "incglob=s"     => sub { cmd_incglob   $_[1] },
+      "include|i=s"   => sub { cmd_include   $_[1], 1 },
+      "exclude|x=s"   => sub { cmd_include   $_[1], 0 },
+      "static!"       => \$STATIC,
+      "usepacklists!" => \$PACKLIST,
+      "staticlib=s"   => sub { cmd_staticlib $_[1] },
+      "<>"            => sub { cmd_file      $_[0] },
+      or exit 1;
+}
+
 Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
 
-GetOptions
-   "strip=s"     => \$STRIP,
-   "cache=s"     => \$CACHE, # internal option
-   "verbose|v"   => sub { ++$VERBOSE },
-   "quiet|q"     => sub { --$VERBOSE },
-   "perl"        => \$PERL,
-   "app=s"       => \$APP,
-   "eval|e=s"    => sub { trace_eval    $_[1] },
-   "use|M=s"     => sub { trace_module  $_[1] },
-   "boot=s"      => sub { cmd_boot      $_[1] },
-   "add=s"       => sub { cmd_add       $_[1], 0 },
-   "addbin=s"    => sub { cmd_add       $_[1], 1 },
-   "incglob=s"   => sub { cmd_incglob   $_[1] },
-   "include|i=s" => sub { cmd_include   $_[1], 1 },
-   "exclude|x=s" => sub { cmd_include   $_[1], 0 },
-   "static"      => sub { $STATIC = 1 },
-   "staticlib=s" => sub { cmd_staticlib $_[1] },
-   "<>"          => sub { cmd_file      $_[0] },
-   or exit 1;
+parse_argv;
 
 die "cannot specify both --app and --perl\n"
    if $PERL and defined $APP;
@@ -345,7 +363,7 @@
 trace_module "PerlIO::scalar";
 
 #############################################################################
-# include/exclude apply
+# apply include/exclude
 
 {
    my %pmi;
@@ -358,9 +376,15 @@
       if ($inc) {
          # include
          @pmi{@match} = delete @pm{@match};
+
+         print "applying include $glob - protected ", (scalar @match), " files.\n"
+            if $VERBOSE >= 5;
       } else {
          # exclude
          delete @pm{@match};
+
+         print "applying exclude $glob - removed ", (scalar @match), " files.\n"
+            if $VERBOSE >= 5;
       }
    }
 
@@ -369,13 +393,16 @@
 }
 
 #############################################################################
-# scan for AutoLoader and static archives
+# scan for AutoLoader, static archives and other dependencies
 
 sub scan_al {
    my ($auto, $autodir) = @_;
 
    my $ix = "$autodir/autosplit.ix";
 
+   print "processing autoload index for '$auto'\n"
+      if $VERBOSE >= 6;
+
    $pm{"$auto/autosplit.ix"} = $ix;
 
    open my $fh, "<:perlio", $ix
@@ -390,14 +417,16 @@
 
          defined $inc or die "$al: autoload file not found, but should be there.\n";
 
-         $pm{$al} = "$inc/$al";
+         $pm{$al} = $inc;
+         print "found autoload function '$al'\n"
+            if $VERBOSE >= 6;
 
       } elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) {
          ($package = $1) =~ s/::/\//g;
       } elsif (/^\s*(?:#|1?\s*;?\s*$)/) {
          # nop
       } else {
-         warn "$ix: unparsable line, please report: $_";
+         warn "WARNING: $ix: unparsable line, please report: $_";
       }
    }
 }
@@ -407,15 +436,16 @@
       my $auto    = "auto/$1";
       my $autodir = find_inc $auto;
 
-      if (defined $autodir && -d "$autodir/$auto") {
-         $autodir = "$autodir/$auto";
-
+      if (defined $autodir && -d $autodir) {
          # AutoLoader
          scan_al $auto, $autodir
             if -f "$autodir/autosplit.ix";
 
          # extralibs.ld
          if (open my $fh, "<:perlio", "$autodir/extralibs.ld") {
+            print "found extralibs for $pm\n"
+               if $VERBOSE >= 6;
+
             local $/;
             $extralibs .= " " . <$fh>;
          }
@@ -426,6 +456,9 @@
 
          # static ext
          if (-f "$autodir/$base$Config{_a}") {
+            print "found static archive for $pm\n"
+               if $VERBOSE >= 3;
+
             push @libs, "$autodir/$base$Config{_a}";
             push @static_ext, $pm;
          }
@@ -433,12 +466,43 @@
          # dynamic object
          die "ERROR: found shared object - can't link statically ($_)\n"
             if -f "$autodir/$base.$Config{dlext}";
+
+         if ($PACKLIST && open my $fh, "<:perlio", "$autodir/.packlist") {
+            print "found .packlist for $pm\n"
+               if $VERBOSE >= 3;
+
+            while (<$fh>) {
+               chomp;
+               s/ .*$//; # newer-style .packlists might contain key=value pairs
+
+               # only include certain files (.al, .ix, .pm, .pl)
+               if (/\.(pm|pl|al|ix)$/) {
+                  for my $inc (@INC) {
+                     # in addition, we only add files that are below some @INC path
+                     $inc =~ s/\/*$/\//;
+
+                     if ($inc eq substr $_, 0, length $inc) {
+                        my $base = substr $_, length $inc;
+                        $pm{$base} = $_;
+
+                        print "+ added .packlist dependency $base\n"
+                           if $VERBOSE >= 3;
+                     }
+
+                     last;
+                  }
+               }
+            }
+         }
       }
    }
 }
 
 #############################################################################
 
+print "processing bundle files (try more -v power if you get bored waiting here)...\n"
+   if $VERBOSE >= 1;
+
 my $data;
 my @index;
 my @order = sort {
@@ -472,14 +536,17 @@
    unless ($pmbin{$pm}) { # only do this unless the file is binary
       if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) {
          if ($src =~ /^    unimpl \"/m) {
-            warn "$pm: skipping (not implemented anyways).\n"
-               if $VERBOSE >= 2;
+            print "$pm: skipping (raises runtime error only).\n"
+               if $VERBOSE >= 3;
             next;
          }
       }
 
-      $src = cache "$UNISTRIP,$OPTIMISE_SIZE,$STRIP", $src, sub {
+      $src = cache +($STRIP eq "ppi" ? "$UNISTRIP,$OPTIMISE_SIZE" : undef), $src, sub {
          if ($UNISTRIP && $pm =~ /^unicore\/.*\.pl$/) {
+            print "applying unicore stripping $pm\n"
+               if $VERBOSE >= 6;
+
             # special stripping for unicore swashes and properties
             # much more could be done by going binary
             $src =~ s{
@@ -602,7 +669,7 @@
             } else {
                warn "WARNING: $pm{$pm}: PPI failed to parse this file\n";
             }
-         } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod
+         } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses its own pod
             require Pod::Strip;
 
             my $stripper = Pod::Strip->new;
@@ -632,7 +699,7 @@
 #      }
    }
 
-   print "adding $pm{$pm} (original size $size, stored size ", length $src, ")\n"
+   print "adding $pm (original size $size, stored size ", length $src, ")\n"
       if $VERBOSE >= 2;
 
    push @index, ((length $pm) << 25) | length $data;
@@ -640,14 +707,15 @@
 }
 
 length $data < 2**25
-   or die "bundle too large (only 32MB supported)\n";
+   or die "ERROR: bundle too large (only 32MB supported)\n";
 
 my $varpfx = "bundle_" . substr +(Digest::MD5::md5_hex $data), 0, 16;
 
 #############################################################################
 # output
 
-print "generating $PREFIX.h... ";
+print "generating $PREFIX.h... "
+   if $VERBOSE >= 1;
 
 {
    open my $fh, ">", "$PREFIX.h"
@@ -663,18 +731,20 @@
 /* public API */
 EXTERN_C PerlInterpreter *staticperl;
 EXTERN_C void staticperl_xs_init (pTHX);
-EXTERN_C void staticperl_init (void);
+EXTERN_C void staticperl_init (XSINIT_t xs_init); /* argument can be 0 */
 EXTERN_C void staticperl_cleanup (void);
 
 EOF
 }
 
-print "\n";
+print "\n"
+   if $VERBOSE >= 1;
 
 #############################################################################
 # output
 
-print "generating $PREFIX.c... ";
+print "generating $PREFIX.c... "
+   if $VERBOSE >= 1;
 
 open my $fh, ">", "$PREFIX.c"
    or die "$PREFIX.c: $!\n";
@@ -714,7 +784,7 @@
 print $fh "static const char $varpfx\_data [] =\n";
 dump_string $fh, $data;
 
-print $fh ";\n\n";;
+print $fh ";\n\n";
 
 #############################################################################
 # bootstrap
@@ -740,8 +810,8 @@
 }
 ';
 
-$bootstrap .= "require '//boot';"
-   if exists $pm{"//boot"};
+$bootstrap .= "require '&&boot';"
+   if exists $pm{"&&boot"};
 
 $bootstrap =~ s/\s+/ /g;
 $bootstrap =~ s/(\W) /$1/g;
@@ -871,6 +941,9 @@
 
 print $fh <<EOF;
   Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1));
+
+  if (PL_oldname)
+    ((XSINIT_t)PL_oldname)(aTHX);
 }
 EOF
 
@@ -884,13 +957,16 @@
 main (int argc, char *argv [])
 {
   extern char **environ;
-  int exitstatus;
+  int i, exitstatus;
+  char **args = malloc ((argc + 3) * sizeof (const char *));
 
-  static char *args[] = {
-    "staticperl",
-    "-e",
-    "0"
-  };
+  args [0] = argv [0];
+  args [1] = "-e";
+  args [2] = "0";
+  args [3] = "--";
+
+  for (i = 1; i < argc; ++i)
+    args [i + 3] = argv [i];
 
   PERL_SYS_INIT3 (&argc, &argv, &environ);
   staticperl = perl_alloc ();
@@ -898,7 +974,8 @@
 
   PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
 
-  exitstatus = perl_parse (staticperl, staticperl_xs_init, sizeof (args) / sizeof (*args), args, environ);
+  exitstatus = perl_parse (staticperl, staticperl_xs_init, argc + 3, args, environ);
+  free (args);
   if (!exitstatus)
     perl_run (staticperl);
 
@@ -939,23 +1016,24 @@
    print $fh <<EOF;
 
 EXTERN_C void
-staticperl_init (void)
+staticperl_init (XSINIT_t xs_init)
 {
-  extern char **environ;
-  int argc = sizeof (args) / sizeof (args [0]);
-  char **argv = args;
-
   static char *args[] = {
     "staticperl",
     "-e",
     "0"
   };
 
+  extern char **environ;
+  int argc = sizeof (args) / sizeof (args [0]);
+  char **argv = args;
+
   PERL_SYS_INIT3 (&argc, &argv, &environ);
   staticperl = perl_alloc ();
   perl_construct (staticperl);
   PL_origalen = 1;
   PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
+  PL_oldname = (char *)xs_init;
   perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
 
   perl_run (staticperl);
@@ -972,22 +1050,25 @@
 EOF
 }
 
-print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n";
+print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n"
+   if $VERBOSE >= 1;
 
 #############################################################################
 # libs, cflags
 
 {
-   print "generating $PREFIX.ccopts... ";
+   print "generating $PREFIX.ccopts... "
+      if $VERBOSE >= 1;
 
    my $str = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE";
    $str =~ s/([\(\)])/\\$1/g;
 
-   print "$str\n\n";
-
    open my $fh, ">$PREFIX.ccopts"
       or die "$PREFIX.ccopts: $!";
    print $fh $str;
+
+   print "$str\n\n"
+      if $VERBOSE >= 1;
 }
 
 {
@@ -1006,23 +1087,26 @@
 
    $str =~ s/([\(\)])/\\$1/g;
 
-   print "$str\n\n";
-
    open my $fh, ">$PREFIX.ldopts"
       or die "$PREFIX.ldopts: $!";
    print $fh $str;
+
+   print "$str\n\n"
+      if $VERBOSE >= 1;
 }
 
 if ($PERL or defined $APP) {
    $APP = "perl" unless defined $APP;
 
-   print "generating $APP...\n";
+   print "building $APP...\n"
+      if $VERBOSE >= 1;
 
    system "$Config{cc} \$(cat bundle.ccopts\) -o \Q$APP\E bundle.c \$(cat bundle.ldopts\)";
 
-#   unlink "$PREFIX.$_"
-#      for qw(ccopts ldopts c h);
+   unlink "$PREFIX.$_"
+      for qw(ccopts ldopts c h);
 
-   print "\n";
+   print "\n"
+      if $VERBOSE >= 1;
 }