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

Comparing App-Staticperl/mkbundle (file contents):
Revision 1.5 by root, Tue Dec 7 09:08:06 2010 UTC vs.
Revision 1.6 by root, Tue Dec 7 09:27:54 2010 UTC

… …
11 11
12my $PREFIX = "bundle"; 12my $PREFIX = "bundle";
13my $PACKAGE = "static"; 13my $PACKAGE = "static";
14 14
15my %pm; 15my %pm;
16my %pmbin;
16my @libs; 17my @libs;
17my @static_ext; 18my @static_ext;
18my $extralibs; 19my $extralibs;
19 20
20@ARGV 21@ARGV
… …
81sub scan_al { 82sub scan_al {
82 my ($auto, $autodir, $ix) = @_; 83 my ($auto, $autodir, $ix) = @_;
83 84
84 $pm{"$auto/$ix"} = "$autodir/$ix"; 85 $pm{"$auto/$ix"} = "$autodir/$ix";
85 86
86 open my $fh, "<", "$autodir/$ix" 87 open my $fh, "<:perlio", "$autodir/$ix"
87 or die "$autodir/$ix: $!"; 88 or die "$autodir/$ix: $!";
88 89
89 my $package; 90 my $package;
90 91
91 while (<$fh>) { 92 while (<$fh>) {
… …
205 206
206 my $file = $1; 207 my $file = $1;
207 my $as = defined $2 ? $2 : "/$1"; 208 my $as = defined $2 ? $2 : "/$1";
208 209
209 $pm{$as} = $file; 210 $pm{$as} = $file;
211 $pmbin{$as} = 1 if $_[1];
210} 212}
211 213
212sub cmd_file { 214sub cmd_file {
213 open my $fh, "<", $_[0] 215 open my $fh, "<", $_[0]
214 or die "$_[0]: $!\n"; 216 or die "$_[0]: $!\n";
… …
228 } elsif ($cmd eq "boot") { 230 } elsif ($cmd eq "boot") {
229 cmd_boot $args; 231 cmd_boot $args;
230 } elsif ($cmd eq "static") { 232 } elsif ($cmd eq "static") {
231 $STATIC = 1; 233 $STATIC = 1;
232 } elsif ($cmd eq "add") { 234 } elsif ($cmd eq "add") {
233 cmd_add $args; 235 cmd_add $args, 0;
236 } elsif ($cmd eq "addbin") {
237 cmd_add $args, 1;
234 } elsif (/^\s*#/) { 238 } elsif (/^\s*#/) {
235 # comment 239 # comment
236 } elsif (/\S/) { 240 } elsif (/\S/) {
237 die "$_: unsupported directive\n"; 241 die "$_: unsupported directive\n";
238 } 242 }
… …
249 "quiet|q" => sub { --$VERBOSE }, 253 "quiet|q" => sub { --$VERBOSE },
250 "perl" => \$PERL, 254 "perl" => \$PERL,
251 "eval|e=s" => sub { trace_eval $_[1] }, 255 "eval|e=s" => sub { trace_eval $_[1] },
252 "use|M=s" => sub { trace_module $_[1] }, 256 "use|M=s" => sub { trace_module $_[1] },
253 "boot=s" => sub { cmd_boot $_[1] }, 257 "boot=s" => sub { cmd_boot $_[1] },
254 "add=s" => sub { cmd_add $_[1] }, 258 "add=s" => sub { cmd_add $_[1], 0 },
259 "addbin=s" => sub { cmd_add $_[1], 1 },
255 "static" => sub { $STATIC = 1 }, 260 "static" => sub { $STATIC = 1 },
256 "<>" => sub { cmd_file $_[0] }, 261 "<>" => sub { cmd_file $_[0] },
257 or exit 1; 262 or exit 1;
258 263
259my $data; 264my $data;
… …
282 local $/; 287 local $/;
283 288
284 <$pm> 289 <$pm>
285 }; 290 };
286 291
292 unless ($pmbin{$pm}) { # only do this unless the file is binary
293
287 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { 294 if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) {
288 if ($src =~ /^ unimpl \"/m) { 295 if ($src =~ /^ unimpl \"/m) {
289 warn "$pm: skipping (not implemented anyways).\n" 296 warn "$pm: skipping (not implemented anyways).\n"
290 if $VERBOSE >= 2; 297 if $VERBOSE >= 2;
291 next; 298 next;
292 }
293 }
294
295 if ($STRIP =~ /ppi/i) {
296 require PPI;
297
298 my $ppi = PPI::Document->new (\$src);
299 $ppi->prune ("PPI::Token::Comment");
300 $ppi->prune ("PPI::Token::Pod");
301
302 # prune END stuff
303 for (my $last = $ppi->last_element; $last; ) {
304 my $prev = $last->previous_token;
305
306 if ($last->isa (PPI::Token::Whitespace::)) {
307 $last->delete;
308 } elsif ($last->isa (PPI::Statement::End::)) {
309 $last->delete;
310 last;
311 } elsif ($last->isa (PPI::Token::Pod::)) {
312 $last->delete;
313 } else {
314 last;
315 } 299 }
300 }
316 301
302 if ($STRIP =~ /ppi/i) {
303 require PPI;
304
305 my $ppi = PPI::Document->new (\$src);
306 $ppi->prune ("PPI::Token::Comment");
307 $ppi->prune ("PPI::Token::Pod");
308
309 # prune END stuff
310 for (my $last = $ppi->last_element; $last; ) {
311 my $prev = $last->previous_token;
312
313 if ($last->isa (PPI::Token::Whitespace::)) {
314 $last->delete;
315 } elsif ($last->isa (PPI::Statement::End::)) {
316 $last->delete;
317 last;
318 } elsif ($last->isa (PPI::Token::Pod::)) {
319 $last->delete;
320 } else {
321 last;
322 }
323
317 $last = $prev; 324 $last = $prev;
318 } 325 }
319 326
320 # prune some but not all insignificant whitespace 327 # prune some but not all insignificant whitespace
321 for my $ws (@{ $ppi->find (PPI::Token::Whitespace::) }) { 328 for my $ws (@{ $ppi->find (PPI::Token::Whitespace::) }) {
322 my $prev = $ws->previous_token; 329 my $prev = $ws->previous_token;
323 my $next = $ws->next_token; 330 my $next = $ws->next_token;
324 331
325 if (!$prev || !$next) { 332 if (!$prev || !$next) {
326 $ws->delete;
327 } else {
328 if (
329 $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float
330 or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/
331 or $prev->isa (PPI::Token::Structure::)
332 # decrease size, decrease compressability
333 #or ($prev->isa (PPI::Token::Word::)
334 # && (PPI::Token::Symbol:: eq ref $next
335 # || $next->isa (PPI::Structure::Block::)
336 # || $next->isa (PPI::Structure::List::)
337 # || $next->isa (PPI::Structure::Condition::)))
338 ) {
339 $ws->delete; 333 $ws->delete;
340 } elsif ($prev->isa (PPI::Token::Whitespace::)) {
341 $ws->{content} = ' ';
342 $prev->delete;
343 } else { 334 } else {
335 if (
336 $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float
337 or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/
338 or $prev->isa (PPI::Token::Structure::)
339 # decrease size, decrease compressability
340 #or ($prev->isa (PPI::Token::Word::)
341 # && (PPI::Token::Symbol:: eq ref $next
342 # || $next->isa (PPI::Structure::Block::)
343 # || $next->isa (PPI::Structure::List::)
344 # || $next->isa (PPI::Structure::Condition::)))
345 ) {
346 $ws->delete;
347 } elsif ($prev->isa (PPI::Token::Whitespace::)) {
344 $ws->{content} = ' '; 348 $ws->{content} = ' ';
349 $prev->delete;
350 } else {
351 $ws->{content} = ' ';
352 }
345 } 353 }
346 } 354 }
347 }
348 355
349 # prune whitespace around blocks 356 # prune whitespace around blocks
350 if (0) { 357 if (0) {
351 # these usually decrease size, but decrease compressability more 358 # these usually decrease size, but decrease compressability more
352 for my $struct (PPI::Structure::Block::, PPI::Structure::Condition::) { 359 for my $struct (PPI::Structure::Block::, PPI::Structure::Condition::) {
353 for my $node (@{ $ppi->find ($struct) }) { 360 for my $node (@{ $ppi->find ($struct) }) {
361 my $n1 = $node->first_token;
362 my $n2 = $n1->previous_token;
363 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
364 $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
365 my $n1 = $node->last_token;
366 my $n2 = $n1->next_token;
367 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
368 $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
369 }
370 }
371
372 for my $node (@{ $ppi->find (PPI::Structure::List::) }) {
354 my $n1 = $node->first_token; 373 my $n1 = $node->first_token;
355 my $n2 = $n1->previous_token;
356 $n1->delete if $n1->isa (PPI::Token::Whitespace::); 374 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
357 $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
358 my $n1 = $node->last_token; 375 my $n1 = $node->last_token;
359 my $n2 = $n1->next_token;
360 $n1->delete if $n1->isa (PPI::Token::Whitespace::); 376 $n1->delete if $n1->isa (PPI::Token::Whitespace::);
361 $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
362 } 377 }
363 } 378 }
364 379
380 # reformat qw() lists which often have lots of whitespace
365 for my $node (@{ $ppi->find (PPI::Structure::List::) }) { 381 for my $node (@{ $ppi->find (PPI::Token::QuoteLike::Words::) }) {
366 my $n1 = $node->first_token; 382 if ($node->{content} =~ /^qw(.)(.*)(.)$/s) {
367 $n1->delete if $n1->isa (PPI::Token::Whitespace::); 383 my ($a, $qw, $b) = ($1, $2, $3);
368 my $n1 = $node->last_token; 384 $qw =~ s/^\s+//;
369 $n1->delete if $n1->isa (PPI::Token::Whitespace::); 385 $qw =~ s/\s+$//;
386 $qw =~ s/\s+/ /g;
387 $node->{content} = "qw$a$qw$b";
388 }
370 } 389 }
371 }
372 390
373 # reformat qw() lists which often have lots of whitespace 391 $src = $ppi->serialize;
374 for my $node (@{ $ppi->find (PPI::Token::QuoteLike::Words::) }) { 392 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod
375 if ($node->{content} =~ /^qw(.)(.*)(.)$/s) { 393 require Pod::Strip;
376 my ($a, $qw, $b) = ($1, $2, $3); 394
377 $qw =~ s/^\s+//; 395 my $stripper = Pod::Strip->new;
378 $qw =~ s/\s+$//; 396
379 $qw =~ s/\s+/ /g; 397 my $out;
380 $node->{content} = "qw$a$qw$b"; 398 $stripper->output_string (\$out);
399 $stripper->parse_string_document ($src)
400 or die;
401 $src = $out;
402 }
403
404 if ($VERIFY && $pm =~ /\.pm$/ && $pm ne "Opcode.pm") {
405 if (open my $fh, "-|") {
406 <$fh>;
407 } else {
408 eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n";
409 exit 0;
381 } 410 }
382 } 411 }
383 412
384 $src = $ppi->serialize; 413# if ($pm eq "Opcode.pm") {
385 } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod 414# open my $fh, ">x" or die; print $fh $src;#d#
386 require Pod::Strip; 415# exit 1;
387 416# }
388 my $stripper = Pod::Strip->new;
389
390 my $out;
391 $stripper->output_string (\$out);
392 $stripper->parse_string_document ($src)
393 or die;
394 $src = $out;
395 } 417 }
396
397 if ($VERIFY && $pm =~ /\.pm$/ && $pm ne "Opcode.pm") {
398 if (open my $fh, "-|") {
399 <$fh>;
400 } else {
401 eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n";
402 exit 0;
403 }
404 }
405
406# if ($pm eq "Opcode.pm") {
407# open my $fh, ">x" or die; print $fh $src;#d#
408# exit 1;
409# }
410 418
411 warn "adding $pm\n" 419 warn "adding $pm\n"
412 if $VERBOSE >= 2; 420 if $VERBOSE >= 2;
413 421
414 push @index, ((length $pm) << 25) | length $data; 422 push @index, ((length $pm) << 25) | length $data;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines