package Perl::LineNumber::Comment;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2020-11-28'; # DATE
our $DIST = 'Perl-LineNumber-Comment'; # DIST
our $VERSION = '0.003'; # VERSION

use 5.010001;
use warnings;
use strict;

use Exporter qw(import);
our @EXPORT_OK = qw(
                       add_line_number_comments_to_perl_source
);

our %SPEC;

$SPEC{':package'} = {
    v => 1.1,
    summary => 'Add line number to Perl source as comment',
};

sub _line_has {
    my ($line, $children, $sub) = @_;
    for my $child (@$children) {
        my $location = $child->location;
        next unless $location->[0] == $line;
        next unless $sub->($child);
        return 1;
    }
    0;
}

sub _line_has_class {
    my ($line, $children, $class) = @_;
    _line_has($line, $children, sub { ref($_[0]) eq $class });
}

sub _line_has_END {
    my ($line, $children) = @_;
    _line_has($line, $children, sub { ref($_[0]) eq 'PPI::Token::Separator' && $_[0]->content eq '__END__' });
}

sub _process_children {
    my ($level, $args, $lines, $node) = @_;
    return unless $node->can("children");

    my $every     = $args->{every};
    my $linum_col = $args->{column};
    my $fmt       = $args->{format};

    my @children = $node->children;
    my $i = 0;
    while ($i < @children) {
        my $child = $children[$i];

        my $location = $child->location;
        my ($line, undef, $col) = @$location;
        {
            my $class = ref($child);
            my $content = $child->content;
            #use DD; dd (("  " x $level) . "D: [$location->[0], $location->[1], $location->[2]] $i $class <$content>");

            # only insert comment after $EVERY line
            last unless $line % $every == 0;

            # insert after newline
            last unless $class eq 'PPI::Token::Whitespace' && $content =~ /\A\R\z/;

            # BUG HereDoc doesn't print content?

            # don't insert at __END__ line
            last if _line_has_END($line, \@children);

            # don't insert width excess $COLUMN setting

            #   we want to vertically align line number comment; but PPI reports
            #   column that are not reset after \n, so that's useless.
            #my $col_after_child = $col + length($content); # XXX use visual width

            #   so we just use the lines from original source for now
            my $col_after_child = length($lines->[$line-1]); # XXX use visual width
            next if $col_after_child >= $linum_col;

            # don't insert after a comment
            next if $i && ref($children[$i-1]) eq 'PPI::Token::Comment' && $children[$i-1]->content !~ /\R/;

            #say "  <-- insert ($col_after_child)";

            #my $el_ws = bless {
            #    _location => [$line, $col_after_child, $col_after_child, $location->[3], undef],
            #    content => (" " x ($linum_col - $col_after_child)),
            #}, 'PPI::Token::Whitespace';
            #my $el_comment = bless {
            #    _location => [$line, $linum_col, $linum_col, $location->[3], undef],
            #    content => sprintf($fmt, $line) . "\n",
            #}, 'PPI::Token::Comment';

            #splice @{ $node->{children} }, $i, 1, $el_ws, $el_comment;
            #$i += 1;
            #splice @{ $node->{children} }, $i, 1, $el_comment;

            $lines->[$line-1] =~ s/\R\z//;
            $lines->[$line-1] .=
                (" " x ($linum_col - $col_after_child)) .
                sprintf($fmt, $line) . "\n";
        }

        _process_children($level+1, $args, $lines, $child);
        $i++;
    }
}

$SPEC{add_line_number_comments_to_perl_source} = {
    v => 1.1,
    args => {
        source => {
            schema => 'str*',
            cmdline_src => 'stdin_or_file',
            req => 1,
            pos => 0,
        },
        format => {
            schema => 'str*',
            default => ' # line %d',
        },
        column => {
            schema => 'posint*',
            default => 80,
        },
        every => {
            schema => 'posint*',
            default => 5,
        },
    },
    result_naked => 1,
};
sub add_line_number_comments_to_perl_source {
    my %args = @_;
    $args{every}  //= 5;
    $args{column} //= 80;
    $args{format} //= ' # line %d';

    require PPI::Document;
    my $doc = PPI::Document->new(\$args{source});

    # provide an easier columns
    my $lines = [split /^/m, $args{source}];

    # $doc->find stops after some nodes?
    _process_children(0, \%args, $lines, $doc);

    #require PPI::Dumper; PPI::Dumper->new($doc)->print;
    #return "$doc";

    join "", @$lines;
}

1;
# ABSTRACT: Add line number to Perl source as comment

__END__

=pod

=encoding UTF-8

=head1 NAME

Perl::LineNumber::Comment - Add line number to Perl source as comment

=head1 VERSION

This document describes version 0.003 of Perl::LineNumber::Comment (from Perl distribution Perl-LineNumber-Comment), released on 2020-11-28.

=head1 SYNOPSIS

Content of F<sample.pl>:

 #!/usr/bin/env perl

 use 5.010001;
 use strict;
 use warnings;

 print "Hello, world 1!";
 print "Hello, world 2!";                   # a comment
 print "A multiline
 string";

 print <<EOF;
 A heredoc (not shown in node->content).

 Line three.
 EOF

 exit 0;

 __END__
 one
 two
 three

In your code:

 use File::Slurper qw(read_text);
 use Perl::LineNumber::Comment qw(add_line_number_comments_to_perl_source);

 my $source = read_text('sample.pl');
 print add_line_number_comments_to_perl_source(source => $source);

Output:

 #!/usr/bin/env perl

 use 5.010001;
 use strict;
 use warnings;                                                                   # line 5

 print "Hello, world 1!";
 print "Hello, world 2!";                   # a comment
 print "A multiline
 string";                                                                        # line 10

 print <<EOF;
 A heredoc (not shown in node->content).

 Line three.
 EOF

 exit 0;

 __END__
 one
 two
 three

With this code:

 print add_line_number_comments_to_perl_source(source => $source, every=>1);

Output:

 #!/usr/bin/env perl
                                                                                 # line 2
 use 5.010001;                                                                   # line 3
 use strict;                                                                     # line 4
 use warnings;                                                                   # line 5
                                                                                 # line 6
 print "Hello, world 1!";                                                        # line 7
 print "Hello, world 2!";                   # a comment
 print "A multiline
 string";                                                                        # line 10
                                                                                 # line 11
 print <<EOF;                                                                    # line 12
 A heredoc (not shown in node->content).

 Line three.
 EOF
                                                                                 # line 17
 exit 0;                                                                         # line 18
                                                                                 # line 19
 __END__
 one
 two
 three

=for Pod::Coverage ^(.+)$

=head1 FUNCTIONS


=head2 add_line_number_comments_to_perl_source

Usage:

 add_line_number_comments_to_perl_source(%args) -> any

This function is not exported by default, but exportable.

Arguments ('*' denotes required arguments):

=over 4

=item * B<column> => I<posint> (default: 80)

=item * B<every> => I<posint> (default: 5)

=item * B<format> => I<str> (default: " # line %d")

=item * B<source>* => I<str>


=back

Return value:  (any)

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/Perl-LineNumber-Comment>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-Perl-LineNumber-Comment>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perl-LineNumber-Comment>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 SEE ALSO

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2020 by perlancar@cpan.org.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
