--- cvsroot/App-Staticperl/mkbundle 2010/12/09 09:51:32 1.10 +++ cvsroot/App-Staticperl/mkbundle 2011/02/10 08:58:36 1.19 @@ -5,10 +5,17 @@ our $VERBOSE = 1; our $STRIP = "pod"; # none, pod or ppi +our $UNISTRIP = 1; # always on, try to strip unicore swash data our $PERL = 0; our $APP; our $VERIFY = 0; our $STATIC = 0; +our $PACKLIST = 0; + +our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression? + +our $CACHE; +our $CACHEVER = 1; # do not change unless you know what you are doing my $PREFIX = "bundle"; my $PACKAGE = "static"; @@ -24,11 +31,14 @@ @ARGV or die "$0: use 'staticperl help' (or read the sources of staticperl)\n"; +# remove "." from @INC - staticperl.sh does it for us, but be on the safe side +BEGIN { @INC = grep !/^\.$/, @INC } + $|=1; our ($TRACER_W, $TRACER_R); -sub find_inc($) { +sub find_incdir($) { for (@INC) { next if ref; return $_ if -e "$_/$_[0]"; @@ -37,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 @@ -48,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"; @@ -63,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; @@ -80,40 +106,8 @@ } # module loading is now safe -use Config; - -sub scan_al { - my ($auto, $autodir, $ix) = @_; - - $pm{"$auto/$ix"} = "$autodir/$ix"; - - open my $fh, "<:perlio", "$autodir/$ix" - or die "$autodir/$ix: $!"; - - my $package; - - while (<$fh>) { - if (/^\s*sub\s+ ([^[:space:];]+) \s* (?:\([^)]*\))? \s*;?\s*$/x) { - my $al = "auto/$package/$1.al"; - my $inc = find_inc $al; - - defined $inc or die "$al: autoload file not found, but should be there.\n"; - - $pm{$al} = "$inc/$al"; - - } elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) { - ($package = $1) =~ s/::/\//g; - } elsif (/^\s*(?:#|1?\s*;?\s*$)/) { - # nop - } else { - warn "$autodir/$ix: unparsable line, please report: $_"; - } - } -} - -sub trace_module { - syswrite $TRACER_W, "use $_[0]\n"; +sub trace_parse { for (;;) { <$TRACER_R> =~ /^-$/ or last; my $dir = <$TRACER_R>; chomp $dir; @@ -121,45 +115,25 @@ $pm{$name} = "$dir/$name"; - if ($name =~ /^(.*)\.pm$/) { - my $auto = "auto/$1"; - my $autodir = "$dir/$auto"; - - if (-d $autodir) { - opendir my $dir, $autodir - or die "$autodir: $!\n"; - - for (readdir $dir) { - # AutoLoader - scan_al $auto, $autodir, $_ - if /\.ix$/; - - # static ext - if (/\Q$Config{_a}\E$/o) { - push @libs, "$autodir/$_"; - push @static_ext, $name; - } - - # extralibs.ld - if ($_ eq "extralibs.ld") { - open my $fh, "<:perlio", "$autodir/$_" - or die "$autodir/$_"; + print "+ found potential dependency $name\n" + if $VERBOSE >= 3; + } +} - local $/; - $extralibs .= " " . <$fh>; - } +sub trace_module { + print "tracing module $_[0]\n" + if $VERBOSE >= 2; - # dynamic object - warn "WARNING: found shared object - can't link statically ($_)\n" - if /\.\Q$Config{dlext}\E$/o; - } - } - } - } + 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 { @@ -171,8 +145,41 @@ # now we can use modules use common::sense; +use Config; use Digest::MD5; +sub cache($$$) { + my ($variant, $src, $filter) = @_; + + 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; + rename "$file~", $file; + } + } + + return $src; + } + + $filter->($src) +} + sub dump_string { my ($fh, $data) = @_; @@ -191,16 +198,77 @@ } } -# required for @INC loading, unfortunately -trace_module "PerlIO::scalar"; +############################################################################# + +sub glob2re { + for (quotemeta $_[0]) { + s/\\\*/\x00/g; + s/\x00\x00/.*/g; + s/\x00/[^\/]*/g; + s/\\\?/[^\/]/g; + + $_ = s/^\\\/// ? "^$_\$" : "(?:^|/)$_\$"; + + s/(?: \[\^\/\] | \. ) \*\$$//x; + + return qr<$_>s + } +} + +our %INCSKIP = ( + "unicore/TestProp.pl" => undef, # 3.5MB of insanity, apparently just some testcase +); + +sub get_dirtree { + my $root = shift; + + my @tree; + my $skip; + + my $scan; $scan = sub { + for (sort do { + opendir my $fh, $_[0] + or return; + readdir $fh + }) { + next if /^\./; + + my $path = "$_[0]/$_"; + + if (-d "$path/.") { + $scan->($path); + } else { + $path = substr $path, $skip; + push @tree, $path + unless exists $INCSKIP{$path}; + } + } + }; + + $root =~ s/\/$//; + $skip = 1 + length $root; + $scan->($root); + + \@tree +} -#trace_module "Term::ReadLine::readline"; # Term::ReadLine::Perl dependency -# URI is difficult -#trace_module "URI::http"; -#trace_module "URI::_generic"; +my $inctrees; + +sub get_inctrees { + unless ($inctrees) { + my %inctree; + $inctree{$_} ||= [$_, get_dirtree $_] # entries in @INC are often duplicates + for @INC; + $inctrees = [values %inctree]; + } + + @$inctrees +} + +############################################################################# sub cmd_boot { - $pm{"//boot"} = $_[0]; + $pm{"&&boot"} = $_[0]; } sub cmd_add { @@ -208,7 +276,7 @@ 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]; @@ -219,67 +287,222 @@ for split /\s+/, $_[0]; } +sub cmd_include { + push @incext, [$_[1], glob2re $_[0]]; +} + +sub cmd_incglob { + my ($pattern) = @_; + + $pattern = glob2re $pattern; + + for (get_inctrees) { + my ($dir, $files) = @$_; + + $pm{$_} = "$dir/$_" + 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 (/^\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, - "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 }, - "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; +# required for @INC loading, unfortunately +trace_module "PerlIO::scalar"; + +############################################################################# +# apply include/exclude + +{ + my %pmi; + + for (@incext) { + my ($inc, $glob) = @$_; + + my @match = grep /$glob/, keys %pm; + + 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; + } + } + + my @pmi = keys %pmi; + @pm{@pmi} = delete @pmi{@pmi}; +} + +############################################################################# +# 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 + or die "$ix: $!"; + + my $package; + + while (<$fh>) { + if (/^\s*sub\s+ ([^[:space:];]+) \s* (?:\([^)]*\))? \s*;?\s*$/x) { + my $al = "auto/$package/$1.al"; + my $inc = find_inc $al; + + defined $inc or die "$al: autoload file not found, but should be there.\n"; + + $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 "WARNING: $ix: unparsable line, please report: $_"; + } + } +} + +for my $pm (keys %pm) { + if ($pm =~ /^(.*)\.pm$/) { + my $auto = "auto/$1"; + my $autodir = find_inc $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>; + } + + $pm =~ /([^\/]+).pm$/ or die "$pm: unable to match last component"; + + my $base = $1; + + # 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; + } + + # 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 { @@ -295,7 +518,7 @@ my $path = $pm{$pm}; 128 > length $pm - or die "$pm: path too long (only 128 octets supported)\n"; + or die "ERROR: $pm: path too long (only 128 octets supported)\n"; my $src = ref $path ? $$path @@ -308,126 +531,167 @@ <$pm> }; - unless ($pmbin{$pm}) { # only do this unless the file is binary + my $size = length $src; + 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; } } - if ($STRIP =~ /ppi/i) { - require PPI; + $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{ + (^return\ <<'END';\n) (.*?\n) (END(?:\n|\Z)) + }{ + my ($pre, $data, $post) = ($1, $2, $3); + + for ($data) { + s/^([0-9a-fA-F]+)\t([0-9a-fA-F]+)\t/sprintf "%X\t%X", hex $1, hex $2/gem + if $OPTIMISE_SIZE; + +# s{ +# ^([0-9a-fA-F]+)\t([0-9a-fA-F]*)\t +# }{ +# # ww - smaller filesize, UU - compress better +# pack "C0UU", +# hex $1, +# length $2 ? (hex $2) - (hex $1) : 0 +# }gemx; - my $ppi = PPI::Document->new (\$src); - $ppi->prune ("PPI::Token::Comment"); - $ppi->prune ("PPI::Token::Pod"); - - # prune END stuff - for (my $last = $ppi->last_element; $last; ) { - my $prev = $last->previous_token; - - if ($last->isa (PPI::Token::Whitespace::)) { - $last->delete; - } elsif ($last->isa (PPI::Statement::End::)) { - $last->delete; - last; - } elsif ($last->isa (PPI::Token::Pod::)) { - $last->delete; - } else { - last; - } + s/#.*\n/\n/mg; + s/\s+\n/\n/mg; + } - $last = $prev; + "$pre$data$post" + }smex; } - # prune some but not all insignificant whitespace - for my $ws (@{ $ppi->find (PPI::Token::Whitespace::) }) { - my $prev = $ws->previous_token; - my $next = $ws->next_token; + if ($STRIP =~ /ppi/i) { + require PPI; - if (!$prev || !$next) { - $ws->delete; - } else { - if ( - $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float - or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/ - or $prev->isa (PPI::Token::Structure::) - # decrease size, decrease compressability - #or ($prev->isa (PPI::Token::Word::) - # && (PPI::Token::Symbol:: eq ref $next - # || $next->isa (PPI::Structure::Block::) - # || $next->isa (PPI::Structure::List::) - # || $next->isa (PPI::Structure::Condition::))) - ) { - $ws->delete; - } elsif ($prev->isa (PPI::Token::Whitespace::)) { - $ws->{content} = ' '; - $prev->delete; - } else { - $ws->{content} = ' '; + if (my $ppi = PPI::Document->new (\$src)) { + $ppi->prune ("PPI::Token::Comment"); + $ppi->prune ("PPI::Token::Pod"); + + # prune END stuff + for (my $last = $ppi->last_element; $last; ) { + my $prev = $last->previous_token; + + if ($last->isa (PPI::Token::Whitespace::)) { + $last->delete; + } elsif ($last->isa (PPI::Statement::End::)) { + $last->delete; + last; + } elsif ($last->isa (PPI::Token::Pod::)) { + $last->delete; + } else { + last; + } + + $last = $prev; } - } - } - # prune whitespace around blocks - if (0) { - # these usually decrease size, but decrease compressability more - for my $struct (PPI::Structure::Block::, PPI::Structure::Condition::) { - for my $node (@{ $ppi->find ($struct) }) { - my $n1 = $node->first_token; - my $n2 = $n1->previous_token; - $n1->delete if $n1->isa (PPI::Token::Whitespace::); - $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::); - my $n1 = $node->last_token; - my $n2 = $n1->next_token; - $n1->delete if $n1->isa (PPI::Token::Whitespace::); - $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::); + # prune some but not all insignificant whitespace + for my $ws (@{ $ppi->find (PPI::Token::Whitespace::) }) { + my $prev = $ws->previous_token; + my $next = $ws->next_token; + + if (!$prev || !$next) { + $ws->delete; + } else { + if ( + $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float + or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/ + or $prev->isa (PPI::Token::Structure::) + or ($OPTIMISE_SIZE && + ($prev->isa (PPI::Token::Word::) + && (PPI::Token::Symbol:: eq ref $next + || $next->isa (PPI::Structure::Block::) + || $next->isa (PPI::Structure::List::) + || $next->isa (PPI::Structure::Condition::))) + ) + ) { + $ws->delete; + } elsif ($prev->isa (PPI::Token::Whitespace::)) { + $ws->{content} = ' '; + $prev->delete; + } else { + $ws->{content} = ' '; + } + } } - } - for my $node (@{ $ppi->find (PPI::Structure::List::) }) { - my $n1 = $node->first_token; - $n1->delete if $n1->isa (PPI::Token::Whitespace::); - my $n1 = $node->last_token; - $n1->delete if $n1->isa (PPI::Token::Whitespace::); + # prune whitespace around blocks + if ($OPTIMISE_SIZE) { + # these usually decrease size, but decrease compressability more + for my $struct (PPI::Structure::Block::, PPI::Structure::Condition::) { + for my $node (@{ $ppi->find ($struct) }) { + my $n1 = $node->first_token; + my $n2 = $n1->previous_token; + $n1->delete if $n1->isa (PPI::Token::Whitespace::); + $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::); + my $n1 = $node->last_token; + my $n2 = $n1->next_token; + $n1->delete if $n1->isa (PPI::Token::Whitespace::); + $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::); + } + } + + for my $node (@{ $ppi->find (PPI::Structure::List::) }) { + my $n1 = $node->first_token; + $n1->delete if $n1->isa (PPI::Token::Whitespace::); + my $n1 = $node->last_token; + $n1->delete if $n1->isa (PPI::Token::Whitespace::); + } + } + + # reformat qw() lists which often have lots of whitespace + for my $node (@{ $ppi->find (PPI::Token::QuoteLike::Words::) }) { + if ($node->{content} =~ /^qw(.)(.*)(.)$/s) { + my ($a, $qw, $b) = ($1, $2, $3); + $qw =~ s/^\s+//; + $qw =~ s/\s+$//; + $qw =~ s/\s+/ /g; + $node->{content} = "qw$a$qw$b"; + } + } + + $src = $ppi->serialize; + } else { + warn "WARNING: $pm{$pm}: PPI failed to parse this file\n"; } + } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses its own pod + require Pod::Strip; + + my $stripper = Pod::Strip->new; + + my $out; + $stripper->output_string (\$out); + $stripper->parse_string_document ($src) + or die; + $src = $out; } - # reformat qw() lists which often have lots of whitespace - for my $node (@{ $ppi->find (PPI::Token::QuoteLike::Words::) }) { - if ($node->{content} =~ /^qw(.)(.*)(.)$/s) { - my ($a, $qw, $b) = ($1, $2, $3); - $qw =~ s/^\s+//; - $qw =~ s/\s+$//; - $qw =~ s/\s+/ /g; - $node->{content} = "qw$a$qw$b"; + if ($VERIFY && $pm =~ /\.pm$/ && $pm ne "Opcode.pm") { + if (open my $fh, "-|") { + <$fh>; + } else { + eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n"; + exit 0; } } - $src = $ppi->serialize; - } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod - require Pod::Strip; - - my $stripper = Pod::Strip->new; - - my $out; - $stripper->output_string (\$out); - $stripper->parse_string_document ($src) - or die; - $src = $out; - } - - if ($VERIFY && $pm =~ /\.pm$/ && $pm ne "Opcode.pm") { - if (open my $fh, "-|") { - <$fh>; - } else { - eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n"; - exit 0; - } - } + $src + }; # if ($pm eq "Opcode.pm") { # open my $fh, ">x" or die; print $fh $src;#d# @@ -435,7 +699,7 @@ # } } - warn "adding $pm\n" + print "adding $pm (original size $size, stored size ", length $src, ")\n" if $VERBOSE >= 2; push @index, ((length $pm) << 25) | length $data; @@ -443,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" @@ -466,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"; @@ -517,7 +784,7 @@ print $fh "static const char $varpfx\_data [] =\n"; dump_string $fh, $data; -print $fh ";\n\n";; +print $fh ";\n\n"; ############################################################################# # bootstrap @@ -543,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; @@ -674,6 +941,9 @@ print $fh <= 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; } { @@ -809,21 +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); + + print "\n" + if $VERBOSE >= 1; }