| … | |
… | |
| 4 | # cannot load modules till after the tracer BEGIN block |
4 | # cannot load modules till after the tracer BEGIN block |
| 5 | |
5 | |
| 6 | our $VERBOSE = 1; |
6 | our $VERBOSE = 1; |
| 7 | our $STRIP = "pod"; # none, pod or ppi |
7 | our $STRIP = "pod"; # none, pod or ppi |
| 8 | our $COMPRESS = "lzf"; |
8 | our $COMPRESS = "lzf"; |
|
|
9 | our $KEEPNL = 0; |
| 9 | our $UNISTRIP = 1; # always on, try to strip unicore swash data |
10 | our $UNISTRIP = 1; # always on, try to strip unicore swash data |
| 10 | our $PERL = 0; |
11 | our $PERL = 0; |
| 11 | our $APP; |
12 | our $APP; |
| 12 | our $VERIFY = 0; |
13 | our $VERIFY = 0; |
| 13 | our $STATIC = 0; |
14 | our $STATIC = 0; |
| … | |
… | |
| 364 | |
365 | |
| 365 | "verbose|v" => sub { ++$VERBOSE }, |
366 | "verbose|v" => sub { ++$VERBOSE }, |
| 366 | "quiet|q" => sub { --$VERBOSE }, |
367 | "quiet|q" => sub { --$VERBOSE }, |
| 367 | |
368 | |
| 368 | "strip=s" => \$STRIP, |
369 | "strip=s" => \$STRIP, |
|
|
370 | "keepnl" => \$KEEPNL, |
| 369 | "compress=s" => \$COMPRESS, |
371 | "compress=s" => \$COMPRESS, |
| 370 | "cache=s" => \$CACHE, # internal option |
372 | "cache=s" => \$CACHE, # internal option |
| 371 | "eval|e=s" => sub { trace_eval $_[1] }, |
373 | "eval|e=s" => sub { trace_eval $_[1] }, |
| 372 | "use|M=s" => sub { trace_module $_[1] }, |
374 | "use|M=s" => sub { trace_module $_[1] }, |
| 373 | "boot=s" => sub { cmd_boot $_[1] }, |
375 | "boot=s" => sub { cmd_boot $_[1] }, |
| … | |
… | |
| 637 | } |
639 | } |
| 638 | |
640 | |
| 639 | if ($STRIP =~ /ppi/i) { |
641 | if ($STRIP =~ /ppi/i) { |
| 640 | require PPI; |
642 | require PPI; |
| 641 | |
643 | |
|
|
644 | # PPI (quite correctly) treeats pod in __DATA__ as data, not pod |
|
|
645 | |
| 642 | if (my $ppi = PPI::Document->new (\$src)) { |
646 | if (my $ppi = PPI::Document->new (\$src)) { |
| 643 | $ppi->prune ("PPI::Token::Comment"); |
647 | $ppi->prune ("PPI::Token::Comment"); |
| 644 | $ppi->prune ("PPI::Token::Pod"); |
648 | |
|
|
649 | for my $pod (@{ $ppi->find (PPI::Token::Pod::) }) { |
|
|
650 | # should somehow convert to whitespace token |
|
|
651 | if ($KEEPNL) { |
|
|
652 | $pod->{content} =~ s/[^\n]//g; |
|
|
653 | } else { |
|
|
654 | $pod->{content} = ''; |
|
|
655 | } |
|
|
656 | } |
| 645 | |
657 | |
| 646 | # prune END stuff |
658 | # prune END stuff |
| 647 | for (my $last = $ppi->last_element; $last; ) { |
659 | for (my $last = $ppi->last_element; $last; ) { |
| 648 | my $prev = $last->previous_token; |
660 | my $prev = $last->previous_token; |
| 649 | |
661 | |
| … | |
… | |
| 668 | |
680 | |
| 669 | if (!$prev || !$next) { |
681 | if (!$prev || !$next) { |
| 670 | $ws->delete; |
682 | $ws->delete; |
| 671 | } else { |
683 | } else { |
| 672 | if ($next->isa (PPI::Token::Whitespace::)) { |
684 | if ($next->isa (PPI::Token::Whitespace::)) { |
|
|
685 | # push this whitespace data into the next node |
|
|
686 | $next->{content} = "$ws->{content}$next->{content}"; |
| 673 | $ws->delete; |
687 | $ws->{content} = ""; |
| 674 | } elsif ( |
688 | } elsif ( |
|
|
689 | ( |
| 675 | $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float |
690 | $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float |
| 676 | or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/ |
691 | or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/ |
| 677 | or $prev->isa (PPI::Token::Structure::) |
692 | or $prev->isa (PPI::Token::Structure::) |
| 678 | or ($OPTIMISE_SIZE && |
693 | or ($OPTIMISE_SIZE && |
| 679 | ($prev->isa (PPI::Token::Word::) |
694 | ($prev->isa (PPI::Token::Word::) |
| 680 | && (PPI::Token::Symbol:: eq ref $next |
695 | && (PPI::Token::Symbol:: eq ref $next |
| 681 | || $next->isa (PPI::Structure::Block::) |
696 | || $next->isa (PPI::Structure::Block::) |
| 682 | || $next->isa (PPI::Structure::List::) |
697 | || $next->isa (PPI::Structure::List::) |
| 683 | || $next->isa (PPI::Structure::Condition::))) |
698 | || $next->isa (PPI::Structure::Condition::))) |
|
|
699 | ) |
| 684 | ) |
700 | ) |
|
|
701 | # perl has some idiotic warning about nonexisting operators (Reverse %s operator) |
|
|
702 | && !( |
|
|
703 | $prev->isa (PPI::Token::Operator::) && $prev->{content} eq "=" |
|
|
704 | && $next->isa (PPI::Token::Operator::) && $next->{content} =~ /[+\-]/ |
|
|
705 | ) |
| 685 | ) { |
706 | ) { |
| 686 | # perl has some idiotic warnigns about nonexisting operators |
|
|
| 687 | if ($prev->isa (PPI::Token::Operator::) && $prev->{content} eq "=" |
|
|
| 688 | && $next->isa (PPI::Token::Operator::) && $next->{content} =~ /[+\-]/ |
|
|
| 689 | ) { |
707 | if ($KEEPNL) { |
| 690 | # avoid "Reverse %s operator" diagnostic |
708 | $ws->{content} =~ s/[^\n]//g; |
| 691 | } else { |
709 | } else { |
| 692 | $ws->delete; |
710 | $ws->{content} = ''; |
| 693 | } |
711 | } |
| 694 | } else { |
712 | } else { |
|
|
713 | if ($KEEPNL) { |
|
|
714 | $ws->{content} =~ s/[^\n]//g; |
|
|
715 | $ws->{content} ||= ' '; # keep at least one space |
|
|
716 | } else { |
| 695 | $ws->{content} = ' '; |
717 | $ws->{content} = ' '; |
|
|
718 | } |
| 696 | } |
719 | } |
| 697 | } |
720 | } |
| 698 | } |
721 | } |
| 699 | |
722 | |
| 700 | # prune whitespace around blocks |
723 | # prune whitespace around blocks |
