#   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
#   file: lib/Dist/Zilla/Plugin/Manifest/Read.pm

#pod =encoding UTF-8
#pod
#pod =head1 COPYRIGHT AND LICENSE
#pod
#pod Copyright © 2015 Van de Bugger
#pod
#pod This file is part of perl-Dist-Zilla-Plugin-Manifest-Read.
#pod
#pod perl-Dist-Zilla-Plugin-Manifest-Read is free software: you can redistribute it and/or modify it
#pod under the terms of the GNU General Public License as published by the Free Software Foundation,
#pod either version 3 of the License, or (at your option) any later version.
#pod
#pod perl-Dist-Zilla-Plugin-Manifest-Read is distributed in the hope that it will be useful, but
#pod WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
#pod PARTICULAR PURPOSE. See the GNU General Public License for more details.
#pod
#pod You should have received a copy of the GNU General Public License along with
#pod perl-Dist-Zilla-Plugin-Manifest-Read. If not, see <http://www.gnu.org/licenses/>.
#pod
#pod =cut

# --------------------------------------------------------------------------------------------------

#pod =for :this This is C<Dist::Zilla::Plugin::Manifest::Read> module documentation. Read this if you are going to hack or
#pod extend C<Dist-Zilla-Plugin-Manifest-Read>, or use it programmatically.
#pod
#pod =for :those If you want to have annotated manifest in your source, read the L<user manual|Dist::Zilla::Plugin::Manifest::Read::Manual>.
#pod General topics like getting source, building, installing, bug reporting and some others are covered
#pod in the F<README>.
#pod
#pod =cut

# --------------------------------------------------------------------------------------------------

#pod =head1 SYNOPSIS
#pod
#pod In your plugin:
#pod
#pod     # Iterate through the distribution files listed in MANIFEST
#pod     # (files not included into distrubution are not iterated):
#pod     my $files = $self->zilla->plugin_named( 'Manifest::Read' )->find_files();
#pod     for my $file ( @$files ) {
#pod         …
#pod     };
#pod
#pod =head1 DESCRIPTION
#pod
#pod This class consumes L<Dist::Zilla::Role::FileGatherer> and C<Dist::Zilla::Role::FileFinder> role.
#pod In order to fulfill requirements, the class implements C<gather_files> and C<find_files> methods.
#pod Other methods are supporting.
#pod
#pod The class also consumes L<Dist::Zilla::Role::ErrorReporter> role. It allows the class not to stop
#pod at the first problem but continue and report multiple errors to user.
#pod
#pod =cut

# --------------------------------------------------------------------------------------------------

package Dist::Zilla::Plugin::Manifest::Read;

use Moose;
use namespace::autoclean;

# ABSTRACT: Read extended MANIFEST file
our $VERSION = '0.002'; # VERSION

with 'Dist::Zilla::Role::FileGatherer';
with 'Dist::Zilla::Role::FileFinder';
with 'Dist::Zilla::Role::ErrorLogger'  => { -version => 0.005 };

use Path::Tiny;
use List::Util qw{ min max };
use Try::Tiny;

# --------------------------------------------------------------------------------------------------

#pod =attr manifest
#pod
#pod Name of manifest file to read.
#pod
#pod C<Str>, read-only, default value is C<MANIFEST>.
#pod
#pod =cut

has manifest => (
    isa         => 'Str',
    is          => 'ro',
    default     => 'MANIFEST',
);

# --------------------------------------------------------------------------------------------------

#pod =method gather_files
#pod
#pod This method fulfills L<Dist::Zilla::Role::FileGatherer> role requirement. It adds files listed in
#pod manifest to distribution. Files marked to exclude from distribution and directories are not added,
#pod though.
#pod
#pod =cut

sub gather_files {
    my ( $self ) = @_;
    for my $file ( @{ $self->_files } ) {
        $self->add_file( $file );
    };
    return;
};

# --------------------------------------------------------------------------------------------------

#pod =method find_files
#pod
#pod This method fulfills L<Dist::Zilla::Role::FileFinder> role requirement. It returns C<ArrayRef> of
#pod files (objects of C<Dist::Zilla::File::OnDisk> class), listed in manifest and marked for inclusion
#pod to the distribution.
#pod
#pod This method can be called by other plugins to iterate through files added by C<Manifest::Read>,
#pod see L</"SYNOPSIS">.
#pod
#pod =cut

sub find_files {
    my ( $self ) = @_;
    return [ @{ $self->_files } ];
};

# --------------------------------------------------------------------------------------------------

#pod =attr _files
#pod
#pod Array of files (object of C<Dist::Zilla::File::OnDisk> class) listed in the manifest and marked for
#pod inclusion to the distribution.
#pod
#pod C<ArrayRef>, read-only, lazy, initialized with builder.
#pod
#pod =cut

has _files => (
    isa         => 'ArrayRef[Object]',
    is          => 'ro',
    lazy        => 1,
    builder     => '_build_files',
    init_arg    => undef,
);

sub _build_files {
    my ( $self ) = @_;
    my $files = [];
    my $error = sub {
        my ( $item, $message ) = @_;
        return $self->log_error( [
            '%s %s at %s line %d.',
            $item->{ filename }, $message, $self->manifest, $item->{ line }
        ] );
    };
    foreach my $item ( $self->_parse_lines() ) {
        # TODO: _show_context.
        -e $item->{ filename } or $error->( $item, 'does not exist' ) and next;
        if ( $item->{ marker } eq '/' ) {
            -d _ or $error->( $item, 'is not a directory' ) and next;
        } else {
            -f _ or $error->( $item, 'is not a plain file' ) and next;
            if ( $item->{ marker } ne '-' ) {
                my $file = Dist::Zilla::File::OnDisk->new( { name => $item->{ filename } } );
                push( @$files, $file );
            };
        };
    };
    $self->abort_if_error();
    return $files;
};

# --------------------------------------------------------------------------------------------------

#pod =attr _lines
#pod
#pod Array of chomped manifest lines, including comments and empty lines.
#pod
#pod C<ArrayRef[Str]>, read-only, lazy, initialized with builder.
#pod
#pod =cut

has _lines => (
    isa         => 'ArrayRef[Str]',
    is          => 'ro',
    lazy        => 1,
    init_arg    => undef,
    builder     => '_build_lines',
);

sub _build_lines {
    my ( $self ) = @_;
    my $lines = [];
    try {
        my $manifest = path( $self->zilla->root )->child( $self->manifest );
        @$lines = $manifest->lines_utf8( { chomp => 1 } );
    } catch {
        my $ex = $_;
        if ( blessed( $ex ) and $ex->isa( 'Path::Tiny::Error' ) ) {
            $self->log_error( [ '%s: %s', $ex->{ file }, $ex->{ err } ] );
        } else {
            $self->log_error( "$ex" );
        };
        $self->abort();
    };
    return $lines;
};

# --------------------------------------------------------------------------------------------------

#pod =method _parse_lines
#pod
#pod This method parses manifest lines. Each line is parsed separately (there is no line continuation).
#pod
#pod If the method fails to parse a line, error is reported by calling method C<log_error> (implemented
#pod in L<Dist::Zilla::Role::ErrorLogger>). This means that parsing is not stopped at the first failure,
#pod but entire manifest will be parsed and all the found errors will be reported.
#pod
#pod The method returns list of hashrefs, a hash per file. Each hash has following keys and values:
#pod
#pod =for :list
#pod = filename
#pod Parsed filename (single-quoted filenames are unquoted, escape sequences are evaluated, if any).
#pod = marker
#pod Marker.
#pod = comment
#pod File comment, leading and trailed whitespaces are stripped.
#pod = line
#pod Number of manifest line the file listed in.
#pod
#pod =cut

my %RE = (
    filename => qr{ ' (*PRUNE) (?: [^'\\] ++ | \\ ['\\] ?+ ) ++ ' | \S ++ }x,
        # ^ TODO: Use Regexp::Common for quoted filename?
    marker   => qr{ [#/+-] }x,
    comment  => qr{ . *? }x,
);

sub _parse_lines {
    my ( $self ) = @_;
    my $manifest = $self->manifest;         # Shorter name.
    my ( %files, @files );
    my @errors;
    my $n = 0;
    for my $line ( @{ $self->_lines } ) {
        ++ $n;
        if ( $line =~ m{ \A \s * (?: \# | \z ) }x ) {   # Comment or empty line.
            next;
        };
        ## no critic ( ProhibitComplexRegexes )
        $line =~ m{
            \A
            \s *+                           # requires perl v5.10
            ( $RE{ filename } )
            (*PRUNE)                        # requires perl v5.10
            (?:
                \s ++
                ( $RE{ marker } )
                (*PRUNE)
                (?:
                    \s ++
                    ( $RE{ comment } )
                ) ?
            ) ?
            \s *
            \z
        }x and do {
            my ( $filename, $marker, $comment ) = ( $1, $2, $3 );
            if ( $filename =~ s{ \A ' ( . * ) ' \z }{ $1 }ex ) {
                $filename =~ s{  \\ ( ['\\] ) }{ $1 }gex;
            };
            if ( exists( $files{ $filename } ) ) {
                my $f = $files{ $filename };
                $self->log_error( [ '%s at %s line %d', $filename, $manifest, $n ] );
                $self->log_error( [ '    also listed at %s line %d.', $manifest, $f->{ line } ] );
                push( @errors,
                    $n           => 'The file also listed at line ' . $f->{ line },
                    $f->{ line } => 'The file also listed at line ' . $n,
                );
                next;
            };
            my $file = {
                filename => $filename,
                marker   => $marker // '+',     # requires perl v5.10
                comment  => $comment,
                line     => $n,
            };
            $files{ $filename } = $file;
            push( @files, $file );
            1;
        } or do {
            $self->log_error( [ 'Syntax error at %s line %d.', $manifest, $n ] );
            push( @errors, $n => 'Syntax error' );
            next;
        };
    };
    if ( @errors ) {
        $self->log_error( [ '%s:', $manifest ] );
        $self->_show_context( $self->_lines, @errors );
        $self->abort();
    };
    return @files;
};

# --------------------------------------------------------------------------------------------------

has mr_context => (
    isa         => 'Int',
    is          => 'ro',
    default     => 2,
);

# --------------------------------------------------------------------------------------------------

# TODO: Move it to error logger?

sub _show_context {
    my ( $self, $text, @notes ) = @_;
    #   TODO: Chop too long lines?
    if ( not ref( $text ) ) {
        $text  = [ split( "\n", $text ) ];
    };
    my %notes;
    while ( @notes ) {
        my ( $n, $msg ) = splice( @notes, 0, 2 );
        if ( $n > 0 ) {
            my $ctx = $self->mr_context;
            for my $i ( max( $n - $ctx, 1 ) .. min( $n + $ctx, @$text + 0 ) ) {
                if ( not $notes{ $i } ) {
                    $notes{ $i } = [];
                };
            };
            push( @{ $notes{ $n } }, $msg );
        };
    };
    my $w        = length( 0 + @$text );        # Width of linenumber column.
    my $indent = ' ' x 4;
    my $fline  = $indent . '%0' . $w . 'd: %s';
    my $fnote  = $indent . ( ' ' x $w ) . '  ^^^ %s ^^^';               # Notice line format.
    my $fskip  = $indent . ( ' ' x $w ) . '  ...skipped %d lines...';   # "Skipped" notice format.
    my $last   = 0;                             # Number of the last printed line.
    my $show_line = sub {
        my ( $n ) = @_;
        my $line = $text->[ $n - 1 ];
        chomp( $line );
        $self->log_error( [ $fline, $n, $line ] );
    };
    my $show_note = sub {
        my ( $n ) = @_;
        $self->log_error( [ $fnote, $_ ] ) for @{ $notes{ $n } };
    };
    my $show_skip = sub {
        my ( $n ) = @_;
        if ( $n > $last + 1 ) {                 # There are skipped line.
            my $count = $n - $last - 1;         # Number of skipped lines.
            if ( $count == 1 ) {
                $show_line->( $n - 1 );         # There is no sense to skip one line.
            } else {
                $self->log_error( [ $fskip, $count ] );
            };
        };
    };
    for my $n ( sort( { $a <=> $b } keys( %notes ) ) ) {
        $show_skip->( $n );
        $show_line->( $n );
        $show_note->( $n );
        $last = $n;
    };
    $show_skip->( @$text + 1 );
    return;
};

# --------------------------------------------------------------------------------------------------

__PACKAGE__->meta->make_immutable;

1;

# --------------------------------------------------------------------------------------------------

#pod =head1 SEE ALSO
#pod
#pod =for :list
#pod = L<Dist::Zilla>
#pod = L<Dist::Zilla::Role::FileGatherer>
#pod = L<Dist::Zilla::Role::ErrorLogger>
#pod = L<Dist::Zilla::Plugin::GatherFromManifest>
#pod
#pod =cut

# end of file #

__END__

=pod

=encoding UTF-8

=head1 NAME

Dist::Zilla::Plugin::Manifest::Read - Read extended MANIFEST file

=head1 VERSION

Version 0.002, released on 2015-08-29 18:32 UTC.

This is C<Dist::Zilla::Plugin::Manifest::Read> module documentation. Read this if you are going to hack or
extend C<Dist-Zilla-Plugin-Manifest-Read>, or use it programmatically.

If you want to have annotated manifest in your source, read the L<user manual|Dist::Zilla::Plugin::Manifest::Read::Manual>.
General topics like getting source, building, installing, bug reporting and some others are covered
in the F<README>.

=head1 SYNOPSIS

In your plugin:

    # Iterate through the distribution files listed in MANIFEST
    # (files not included into distrubution are not iterated):
    my $files = $self->zilla->plugin_named( 'Manifest::Read' )->find_files();
    for my $file ( @$files ) {
        …
    };

=head1 DESCRIPTION

This class consumes L<Dist::Zilla::Role::FileGatherer> and C<Dist::Zilla::Role::FileFinder> role.
In order to fulfill requirements, the class implements C<gather_files> and C<find_files> methods.
Other methods are supporting.

The class also consumes L<Dist::Zilla::Role::ErrorReporter> role. It allows the class not to stop
at the first problem but continue and report multiple errors to user.

=head1 OBJECT ATTRIBUTES

=head2 manifest

Name of manifest file to read.

C<Str>, read-only, default value is C<MANIFEST>.

=head2 _files

Array of files (object of C<Dist::Zilla::File::OnDisk> class) listed in the manifest and marked for
inclusion to the distribution.

C<ArrayRef>, read-only, lazy, initialized with builder.

=head2 _lines

Array of chomped manifest lines, including comments and empty lines.

C<ArrayRef[Str]>, read-only, lazy, initialized with builder.

=head1 OBJECT METHODS

=head2 gather_files

This method fulfills L<Dist::Zilla::Role::FileGatherer> role requirement. It adds files listed in
manifest to distribution. Files marked to exclude from distribution and directories are not added,
though.

=head2 find_files

This method fulfills L<Dist::Zilla::Role::FileFinder> role requirement. It returns C<ArrayRef> of
files (objects of C<Dist::Zilla::File::OnDisk> class), listed in manifest and marked for inclusion
to the distribution.

This method can be called by other plugins to iterate through files added by C<Manifest::Read>,
see L</"SYNOPSIS">.

=head2 _parse_lines

This method parses manifest lines. Each line is parsed separately (there is no line continuation).

If the method fails to parse a line, error is reported by calling method C<log_error> (implemented
in L<Dist::Zilla::Role::ErrorLogger>). This means that parsing is not stopped at the first failure,
but entire manifest will be parsed and all the found errors will be reported.

The method returns list of hashrefs, a hash per file. Each hash has following keys and values:

=over 4

=item filename

Parsed filename (single-quoted filenames are unquoted, escape sequences are evaluated, if any).

=item marker

Marker.

=item comment

File comment, leading and trailed whitespaces are stripped.

=item line

Number of manifest line the file listed in.

=back

=head1 SEE ALSO

=over 4

=item L<Dist::Zilla>

=item L<Dist::Zilla::Role::FileGatherer>

=item L<Dist::Zilla::Role::ErrorLogger>

=item L<Dist::Zilla::Plugin::GatherFromManifest>

=back

=head1 AUTHOR

Van de Bugger <van.de.bugger@gmail.com>

=head1 COPYRIGHT AND LICENSE

Copyright © 2015 Van de Bugger

This file is part of perl-Dist-Zilla-Plugin-Manifest-Read.

perl-Dist-Zilla-Plugin-Manifest-Read is free software: you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free Software Foundation,
either version 3 of the License, or (at your option) any later version.

perl-Dist-Zilla-Plugin-Manifest-Read is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
perl-Dist-Zilla-Plugin-Manifest-Read. If not, see <http://www.gnu.org/licenses/>.

=cut