--- cvsroot/App-Staticperl/mkbundle 2010/12/06 19:33:57 1.1 +++ cvsroot/App-Staticperl/mkbundle 2010/12/08 09:13:55 1.8 @@ -13,6 +13,7 @@ my $PACKAGE = "static"; my %pm; +my %pmbin; my @libs; my @static_ext; my $extralibs; @@ -78,6 +79,35 @@ # 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"; @@ -98,8 +128,8 @@ for (readdir $dir) { # AutoLoader - $pm{"$auto/$_"} = "$autodir/$_" - if /\.(?:al|ix)$/; + scan_al $auto, $autodir, $_ + if /\.ix$/; # static ext if (/\Q$Config{_a}\E$/o) { @@ -119,8 +149,6 @@ # dynamic object warn "WARNING: found shared object - can't link statically ($_)\n" if /\.\Q$Config{dlext}\E$/o; - - #TODO: extralibs? } } } @@ -173,13 +201,14 @@ } sub cmd_add { - $_[0] =~ /^(.*)(?:\s*(\S+))$/ + $_[0] =~ /^(.*)(?:\s+(\S+))$/ or die "$_[0]: cannot parse"; my $file = $1; my $as = defined $2 ? $2 : "/$1"; $pm{$as} = $file; + $pmbin{$as} = 1 if $_[1]; } sub cmd_file { @@ -189,6 +218,7 @@ while (<$fh>) { chomp; my ($cmd, $args) = split / /, $_, 2; + $cmd =~ s/^-+//; if ($cmd eq "strip") { $STRIP = $args; @@ -202,7 +232,9 @@ } elsif ($cmd eq "static") { $STATIC = 1; } elsif ($cmd eq "add") { - cmd_add $args; + cmd_add $args, 0; + } elsif ($cmd eq "addbin") { + cmd_add $args, 1; } elsif (/^\s*#/) { # comment } elsif (/\S/) { @@ -220,12 +252,13 @@ "verbose|v" => sub { ++$VERBOSE }, "quiet|q" => sub { --$VERBOSE }, "perl" => \$PERL, - "eval=s" => sub { trace_eval $_[1] }, + "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] }, + "add=s" => sub { cmd_add $_[1], 0 }, + "addbin=s" => sub { cmd_add $_[1], 1 }, "static" => sub { $STATIC = 1 }, - "<>" => sub { cmd_file $_[1] }, + "<>" => sub { cmd_file $_[0] }, or exit 1; my $data; @@ -248,7 +281,7 @@ my $src = ref $path ? $$path : do { - open my $pm, "<:perlio", $path + open my $pm, "<", $path or die "$path: $!"; local $/; @@ -256,129 +289,133 @@ <$pm> }; - if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { - if ($src =~ /^ unimpl \"/m) { - warn "$pm: skipping (not implemented anyways).\n" - if $VERBOSE >= 2; - next; + 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; + next; + } } - } - if ($STRIP =~ /ppi/i) { - require PPI; + if ($STRIP =~ /ppi/i) { + require PPI; - 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; - } + 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; - } + $last = $prev; + } - # 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; + # 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::) - # 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::))) - ) { + if (!$prev || !$next) { $ws->delete; - } elsif ($prev->isa (PPI::Token::Whitespace::)) { - $ws->{content} = ' '; - $prev->delete; } else { - $ws->{content} = ' '; + 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} = ' '; + } } } - } - # 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) }) { + # 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::); + } + } + + for my $node (@{ $ppi->find (PPI::Structure::List::) }) { 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"; + } } - } - # 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; + } 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 = $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); - $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; - } +# if ($pm eq "Opcode.pm") { +# open my $fh, ">x" or die; print $fh $src;#d# +# exit 1; +# } } -# if ($pm eq "Opcode.pm") { -# open my $fh, ">x" or die; print $fh $src;#d# -# exit 1; -# } - warn "adding $pm\n" if $VERBOSE >= 2; @@ -402,14 +439,17 @@ print $fh < #include #include /* public API */ EXTERN_C PerlInterpreter *staticperl; +EXTERN_C void staticperl_xs_init (pTHX); EXTERN_C void staticperl_init (void); EXTERN_C void staticperl_cleanup (void); + EOF } @@ -426,10 +466,6 @@ print $fh < -#include -#include - #include "bundle.h" /* public API */ @@ -589,8 +625,8 @@ # xs_init print $fh <