… | |
… | |
230 | my $path = "$_[0]/$_"; |
230 | my $path = "$_[0]/$_"; |
231 | |
231 | |
232 | if (-d "$path/.") { |
232 | if (-d "$path/.") { |
233 | $scan->($path); |
233 | $scan->($path); |
234 | } else { |
234 | } else { |
235 | next unless /\.(?:pm|pl)$/; |
|
|
236 | |
|
|
237 | $path = substr $path, $skip; |
235 | $path = substr $path, $skip; |
238 | push @tree, $path |
236 | push @tree, $path |
239 | unless exists $INCSKIP{$path}; |
237 | unless exists $INCSKIP{$path}; |
240 | } |
238 | } |
241 | } |
239 | } |
… | |
… | |
294 | |
292 | |
295 | for (get_inctrees) { |
293 | for (get_inctrees) { |
296 | my ($dir, $files) = @$_; |
294 | my ($dir, $files) = @$_; |
297 | |
295 | |
298 | $pm{$_} = "$dir/$_" |
296 | $pm{$_} = "$dir/$_" |
299 | for grep /$pattern/, @$files; |
297 | for grep /$pattern/ && /\.(pl|pm)$/, @$files; |
300 | } |
298 | } |
301 | } |
299 | } |
302 | |
300 | |
303 | sub parse_argv; |
301 | sub parse_argv; |
304 | |
302 | |
… | |
… | |
325 | |
323 | |
326 | use Getopt::Long; |
324 | use Getopt::Long; |
327 | |
325 | |
328 | sub parse_argv { |
326 | sub parse_argv { |
329 | GetOptions |
327 | GetOptions |
330 | "strip=s" => \$STRIP, |
328 | "strip=s" => \$STRIP, |
331 | "cache=s" => \$CACHE, # internal option |
329 | "cache=s" => \$CACHE, # internal option |
332 | "verbose|v" => sub { ++$VERBOSE }, |
330 | "verbose|v" => sub { ++$VERBOSE }, |
333 | "quiet|q" => sub { --$VERBOSE }, |
331 | "quiet|q" => sub { --$VERBOSE }, |
334 | "perl" => \$PERL, |
332 | "perl" => \$PERL, |
335 | "app=s" => \$APP, |
333 | "app=s" => \$APP, |
336 | "eval|e=s" => sub { trace_eval $_[1] }, |
334 | "eval|e=s" => sub { trace_eval $_[1] }, |
337 | "use|M=s" => sub { trace_module $_[1] }, |
335 | "use|M=s" => sub { trace_module $_[1] }, |
338 | "boot=s" => sub { cmd_boot $_[1] }, |
336 | "boot=s" => sub { cmd_boot $_[1] }, |
339 | "add=s" => sub { cmd_add $_[1], 0 }, |
337 | "add=s" => sub { cmd_add $_[1], 0 }, |
340 | "addbin=s" => sub { cmd_add $_[1], 1 }, |
338 | "addbin=s" => sub { cmd_add $_[1], 1 }, |
341 | "incglob=s" => sub { cmd_incglob $_[1] }, |
339 | "incglob=s" => sub { cmd_incglob $_[1] }, |
342 | "include|i=s" => sub { cmd_include $_[1], 1 }, |
340 | "include|i=s" => sub { cmd_include $_[1], 1 }, |
343 | "exclude|x=s" => sub { cmd_include $_[1], 0 }, |
341 | "exclude|x=s" => sub { cmd_include $_[1], 0 }, |
344 | "static!" => \$STATIC, |
342 | "static!" => \$STATIC, |
345 | "usepacklist!" => \$PACKLIST, |
343 | "usepacklists!" => \$PACKLIST, |
346 | "staticlib=s" => sub { cmd_staticlib $_[1] }, |
344 | "staticlib=s" => sub { cmd_staticlib $_[1] }, |
347 | "<>" => sub { cmd_file $_[0] }, |
345 | "<>" => sub { cmd_file $_[0] }, |
348 | or exit 1; |
346 | or exit 1; |
349 | } |
347 | } |
350 | |
348 | |
351 | Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); |
349 | Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); |
352 | |
350 | |
… | |
… | |
357 | |
355 | |
358 | # required for @INC loading, unfortunately |
356 | # required for @INC loading, unfortunately |
359 | trace_module "PerlIO::scalar"; |
357 | trace_module "PerlIO::scalar"; |
360 | |
358 | |
361 | ############################################################################# |
359 | ############################################################################# |
362 | # include/exclude apply |
360 | # apply include/exclude |
363 | |
361 | |
364 | { |
362 | { |
365 | my %pmi; |
363 | my %pmi; |
366 | |
364 | |
367 | for (@incext) { |
365 | for (@incext) { |
… | |
… | |
377 | if $VERBOSE >= 5; |
375 | if $VERBOSE >= 5; |
378 | } else { |
376 | } else { |
379 | # exclude |
377 | # exclude |
380 | delete @pm{@match}; |
378 | delete @pm{@match}; |
381 | |
379 | |
382 | print "applying exclude $glob - excluded ", (scalar @match), " files.\n" |
380 | print "applying exclude $glob - removed ", (scalar @match), " files.\n" |
383 | if $VERBOSE >= 5; |
381 | if $VERBOSE >= 5; |
384 | } |
382 | } |
385 | } |
383 | } |
386 | |
384 | |
387 | my @pmi = keys %pmi; |
385 | my @pmi = keys %pmi; |
388 | @pm{@pmi} = delete @pmi{@pmi}; |
386 | @pm{@pmi} = delete @pmi{@pmi}; |
389 | } |
387 | } |
390 | |
388 | |
391 | ############################################################################# |
389 | ############################################################################# |
392 | # scan for AutoLoader and static archives |
390 | # scan for AutoLoader, static archives and other dependencies |
393 | |
391 | |
394 | sub scan_al { |
392 | sub scan_al { |
395 | my ($auto, $autodir) = @_; |
393 | my ($auto, $autodir) = @_; |
396 | |
394 | |
397 | my $ix = "$autodir/autosplit.ix"; |
395 | my $ix = "$autodir/autosplit.ix"; |
… | |
… | |
467 | print "found .packlist for $pm\n" |
465 | print "found .packlist for $pm\n" |
468 | if $VERBOSE >= 3; |
466 | if $VERBOSE >= 3; |
469 | |
467 | |
470 | while (<$fh>) { |
468 | while (<$fh>) { |
471 | chomp; |
469 | chomp; |
|
|
470 | s/ .*$//; # newer-style .packlists might contain key=value pairs |
472 | |
471 | |
473 | # only include certain files (.al, .ix, .pm, .pl) |
472 | # only include certain files (.al, .ix, .pm, .pl) |
474 | if (/\.(pm|pl|al|ix)$/) { |
473 | if (/\.(pm|pl|al|ix)$/) { |
475 | for my $inc (@INC) { |
474 | for my $inc (@INC) { |
476 | # in addition, we only add files that are below some @INC path |
475 | # in addition, we only add files that are below some @INC path |
… | |
… | |
529 | my $size = length $src; |
528 | my $size = length $src; |
530 | |
529 | |
531 | unless ($pmbin{$pm}) { # only do this unless the file is binary |
530 | unless ($pmbin{$pm}) { # only do this unless the file is binary |
532 | if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { |
531 | if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { |
533 | if ($src =~ /^ unimpl \"/m) { |
532 | if ($src =~ /^ unimpl \"/m) { |
534 | print "$pm: skipping (only raises runtime error).\n" |
533 | print "$pm: skipping (raises runtime error only).\n" |
535 | if $VERBOSE >= 3; |
534 | if $VERBOSE >= 3; |
536 | next; |
535 | next; |
537 | } |
536 | } |
538 | } |
537 | } |
539 | |
538 | |
… | |
… | |
662 | |
661 | |
663 | $src = $ppi->serialize; |
662 | $src = $ppi->serialize; |
664 | } else { |
663 | } else { |
665 | warn "WARNING: $pm{$pm}: PPI failed to parse this file\n"; |
664 | warn "WARNING: $pm{$pm}: PPI failed to parse this file\n"; |
666 | } |
665 | } |
667 | } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod |
666 | } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses its own pod |
668 | require Pod::Strip; |
667 | require Pod::Strip; |
669 | |
668 | |
670 | my $stripper = Pod::Strip->new; |
669 | my $stripper = Pod::Strip->new; |
671 | |
670 | |
672 | my $out; |
671 | my $out; |