Сохранить новые строки для POD в случае PPR :: разложение

Question

При использовании кода наподобие:

    my $aFileData = read_file($sFilename);
    $aFileData =~ s/\r$//g;

    my @aRawFileData= split /(?<=\n)/, $aFileData;
    $self->{'_aRawFileData'} = \@aRawFileData;    

    my $aUncommentFileData_tmp = PPR::decomment(join($", $aFileData));
    my @aUncommentFileData = split /(?<=\n)/, $aUncommentFileData_tmp;
    $self->{'_aUncommentFileData'} = \@aUncommentFileData;

    print("@{$self->{'_aRawFileData'}}===============\n@{$self->{'_aUncommentFileData'}}========================\n");

и ввода, например, в файле $sFilename:

 my $z=1;
 =head1 HEADER

   Just some documentation

 =cut
 my $x=7;

 #  Just some documentation

 my $y=11;

 sub is_top_level {
 }

В выводе мы видим, что строки комментариев пропали и что ПОД ушло. Пока все хорошо:

 my $z=1;

 my $x=7;



 my $y=11;

 sub is_top_level {
 }

одна вещь, которую мы видим, состоит в том, что POD был заменен просто 1 строкой , тогда как строка комментария заменяется пустой строкой.

Возможно ли, что POD также будет заменен пустыми строками (в данном случае 5 строк )?

Answer 1

Вот пример того, как вы можете изменить исходный код для PPR::decomment(), чтобы заменить комментарии количеством символов перевода строки, найденных внутри комментария:

use feature qw(say);
use strict;
use warnings;
use PPR;

my $src = <<'END_SRC';
my $z=1;
=head1 HEADER

   Just some documentation

=cut
my $x=7;

#  Just some documentation

my $y=11;

sub is_top_level {
}
END_SRC

my $res = PPR::decomment2( $src );
print $res;

package PPR;
sub decomment2 {
    if ($] >= 5.014 && $] < 5.016) { _croak( "PPR::decomment() does not work under Perl 5.14" )}

    my ($str) = @_;

    local %PPR::comment_len;

    # Locate comments...
    $str =~ m{ \A (?&PerlDocument) \Z

                (?(DEFINE)
                    (?<decomment>
                       ( (?<! [\$@%] ) [#] [^\n]*+ )
                       (?{
                            my $len = length($^N);
                            my $pos = pos() - $len;
                            $PPR::comment_len{$pos} = $len;
                       })
                    )

                    (?<PerlOWS>
                        (?:
                            \h++
                        |
                            (?&PPR_newline_and_heredoc)
                        |
                            (?&decomment)
                        |
                            __ (?> END | DATA ) __ \b .*+ \z
                        )*+
                    ) # End of rule

                    (?<PerlNWS>
                        (?:
                            \h++
                        |
                            (?&PPR_newline_and_heredoc)
                        |
                            (?&decomment)
                        |
                            __ (?> END | DATA ) __ \b .*+ \z
                        )++

                    ) # End of rule

                    (?<PerlPod>
                        (
                            ^ = [^\W\d]\w*+
                            .*?
                            (?>
                                ^ = cut \b [^\n]*+ $
                            |
                                \z
                            )
                        )
                        (?{
                            my $len = length($^N);
                            my $pos = pos() - $len;
                            $PPR::comment_len{$pos} = $len;
                        })
                    ) # End of rule

                    $PPR::GRAMMAR
                )
            }xms or return;

    # Replace the comments found by the number of newlines inside the comment...
    for my $from_pos (_uniq(sort { $b <=> $a } keys %PPR::comment_len)) {
        my $comment = substr $str, $from_pos, $PPR::comment_len{$from_pos};
        my $count_newline = $comment =~ tr/\n//;
        my $replacement = q{};
        if ( $count_newline) {
            $replacement = "\n" x $count_newline;
        }
        substr($str, $from_pos, $PPR::comment_len{$from_pos}) = $replacement;
    }

    return $str;
}

Вывод :

my $z=1;





my $x=7;



my $y=11;

sub is_top_level {
}