# lib/Dist/Zilla/Plugin/Manifes/Write.pm #


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



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


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

package Dist::Zilla::Plugin::Manifest::Write;

use Moose;          # Let `perlcritic` shut up: it complains on code (`$VERSION`) before `strict`.
use namespace::autoclean;

# PODNAME: Dist::Zilla::Plugin::Manifest::Write
# ABSTRACT: Have annotated MANIFEST in your distribution
our $VERSION = '0.004'; # VERSION

with 'Dist::Zilla::Role::FileGatherer';

use Dist::Zilla::File::FromCode;
use List::Util;

use Dist::Zilla::Role::File 5.023 ();       # Hint for `AutoPrereqs`.
    #   We do not consume the role but just require the specified version. Before this version
    #   `_added_by` was a string, not arrayref.

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


around BUILDARGS => sub {
    my ( $orig, $class, $args ) = @_;
    for my $providers ( qw{ source_providers metainfo_providers } ) {
        if ( exists( $args->{ $providers } ) ) {
            $args->{ $providers } = [
                map( split( m{\s+}, $_ ), @{ $args->{ $providers } } )
            ];
        };
    };
    return $class->$orig( $args );
};

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


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

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

has source_provider_list => (
    is       => 'ro',
    isa      => 'ArrayRef[Str]',
    builder  => '_build_source_provider_list',
    init_arg => 'source_providers',
);

has metainfo_provider_list => (
    is       => 'ro',
    isa      => 'ArrayRef[Str]',
    builder  => '_build_metainfo_provider_list',
    init_arg => 'metainfo_providers',
);

has source_provider_hash => (
    is       => 'ro',
    isa      => 'HashRef',
    lazy     => 1,
    builder  => '_build_source_provider_hash',
    init_arg => undef,
);

has metainfo_provider_hash => (
    is       => 'ro',
    isa      => 'HashRef',
    lazy     => 1,
    builder  => '_build_metainfo_provider_hash',
    init_arg => undef,
);

has file_types => (
    is       => 'ro',
    isa      => 'HashRef[Str]',
    lazy     => 1,
    builder  => '_build_file_types',
    init_arg => undef,
);

sub _build_source_provider_list {
    return [];
};

sub _build_metainfo_provider_list {
    my ( $self ) = @_;
    ref( $self ) =~ m{\ADist::Zilla::Plugin::(\S+)\z} or die;
    my $this = $1;
    return [
        qw{ MetaYAML MetaJSON Manifest Manifest::Write },
        $this eq 'Manifest::Write' ? () : $this
    ];
};

sub _build_source_provider_hash {
    my ( $self ) = @_;
    return { map( ( $_ => 1 ), @{ $self->source_provider_list } ) };
};

sub _build_metainfo_provider_hash {
    my ( $self ) = @_;
    return { map( ( $_ => 1 ), @{ $self->metainfo_provider_list } ) };
};

sub _build_file_types {
    my ( $self ) = @_;
    return {
        source   => $self->zilla->name,
        metainfo => 'metainfo',
        other    => '3rd party',
    };
};

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


sub _filename {
    my ( $self, $file ) = @_;
    my $filename = $file->name;
    if ( $filename =~ m{[ '\\]} ) {
        $filename =~ s{([\\'])}{\\$1}g;
        $filename = "'" . $filename . "'";
    };
    return $filename;
};

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


sub _comment {
    my ( $self, $file ) = @_;
    my $added_by = $file->{ added_by };
    my @entries;
    my $error = sub {
        my ( $n, $message ) = @_;
        $self->log(
            sprintf(
                "Bad record in \"added_by\" log of %s file:\n%s\n%s",
                $file->name,
                join( "\n", map( ( $_ == $n ? '--> ' : '    ' ) . $added_by->[ $_ ], 0 .. @$added_by - 1 ) ),
                $message
            )
        );
        $self->log_fatal( 'Aborting...' );
    };
    foreach my $n ( 0 .. @$added_by - 1 ) {
        my $entry = $added_by->[ $n ];

        #   Typical entries look like:
        #       content added by COPYING (Dist::Zilla::Plugin::GenerateFile line 114)
        #       filename set by GatherFromManifest (Dist::Zilla::Plugin::GatherFromManifest line 125)
        #       encoded_content added by GatherFromManifest (Dist::Zilla::Plugin::GatherFromManifest line 126)
        #       bytes from coderef added by VdB::WriteManifest (Dist::Zilla::Plugin::VdB::WriteManifest line 94)
        #       text from coderef added by MetaJSON (Dist::Zilla::Plugin::MetaJSON line 83)
        #       content set by TemplateFiles (Dist::Zilla::Plugin::TemplateFiles line 35)
        #       content set by OurPkgVersion (Dist::Zilla::Plugin::OurPkgVersion line 82)
        #       content set by PodWeaver (Dist::Zilla::Plugin::PodWeaver line 175)
        #   Thus, entries have following format:
        #       *action* by *plugin name* (*plugin type* line *linenumber*)
        #   Note, that often plugin name matches the last part of plugin type, e. g. plugin name
        #   "GatherFromManifest" matches plugin type "Dist::Zilla::Plugin::GatherFromManifest".
        #   However, if `dist.ini` has lines like this:
        #       [GenerateFile/COPYING]
        #   then plugin name will be "COPYING", while plugin type will be
        #   "Dist::Zilla::Plugin::GenerateFile". For my purposes, plugin type is preferred to
        #   plugin plugin name. However, let me drop common prefix "Dist::Zilla::Plugin::".

        #   Parse entry: find out action and plugin type:
        $entry =~ m{\A(.*?) by .* \(Dist::Zilla::Plugin::(\S+) line \d+\)\z}
            or $error->( $n, "Parsing failed" );
        my ( $action, $plugin ) = ( $1, $2 );

        #   Now translate code-centric actions to user-friendly language.
        if ( 0 ) {
        } elsif ( $action =~ m{\Afilename set\z} ) {
            # Ignore 'filename set' action — it does not important.
            next;
        } elsif ( $action =~ m{\A(?:encoded_)?content added\z} ) {
            $action = 'added';
            @entries == 0       # Should be the first entry.
                or $error->( $n, "It is expected to be the first content action", 23 );
        } elsif ( $action =~ m{\A(?:text|bytes) from coderef added\z} ) {
            $action = 'generated';
            @entries == 0       # Should be the first entry.
                or $error->( $n, "It is expected to be the first content action" );
        } elsif ( $action =~ m{\A(?:encoded_)?content set\z} ) {
            $action = 'modified';
            @entries > 0        # Should *not* be the first entry.
                or $error->( $n, "It is not expected to be the first content action" );
            if ( $entries[ 0 ]->{ plugin } eq $plugin ) {
                next;
            };
        } else {
            $error->( $n, "Unsupported action" );
        };
        push( @entries, { action => $action, plugin => $plugin } );
    };

    #   Typical action sequence is: the first action is ether "added" or "generated", followed by
    #   zero or more "modified" actions.
    my $comment = '';
    my $max_len = List::Util::max( map( length( $_ ), values( %{ $self->file_types } ) ) );
    if ( @entries > 0 ) {
        my $first = $entries[ 0 ];
        my $file_type;
        if ( $self->source_provider_hash->{ $first->{ plugin } } ) {
            $file_type = $self->file_types->{ source };
        } elsif ( $self->metainfo_provider_hash->{ $first->{ plugin } } ) {
            $file_type = $self->file_types->{ metainfo };
        } else {
            $file_type = $self->file_types->{ other };
        };
        $comment .=
            sprintf(
                "%${max_len}s file %s by %s",
                $file_type, $first->{ action }, $first->{ plugin }
            );
    };
    if ( @entries > 1 ) {
        #   Write series of "modified" actions in compact form — do not repeat "modified by".
        $comment .=
            ' and modified by ' .
            join(
                ', ',
                map( $_->{ plugin }, @entries[ 1 .. $#entries ] )
            );
    };
    return $comment;
};

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


sub gather_files {
    my ( $self, $arg ) = @_;
    my $zilla = $self->zilla;
    my $file = Dist::Zilla::File::FromCode->new( {
        name                => $self->manifest,
        code_return_type    => 'bytes',
        code                => sub {
            my @list;
            #   Process all files in alphbetical order.
            foreach my $file ( sort( { $a->name cmp $b->name } @{ $zilla->files } ) ) {
                push( @list, {
                    filename => $self->_filename( $file ),
                    comment  => $self->_comment( $file )
                } );
            };
            #   Find max length of file name.
            my $max_len = List::Util::max( map( length( $_->{ filename } ), @list ) );
            #   Output formats.
            my $head = "# This file was generated with %s %s\n";
            my $body = "%-${max_len}s # %s\n";
            return
                join(
                    '',
                    sprintf( $head, ref( $self ), $self->VERSION ),
                    map( sprintf( $body, $_->{ filename }, $_->{ comment } ), @list ),
                );
        },
    } );
    $self->add_file( $file );
    return;
};

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


sub mvp_multivalue_args {
    return qw{ source_providers metainfo_providers };
};

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

__PACKAGE__->meta->make_immutable;

1;

# doc/what.pod #


# end of file #


# end of file #

__END__

=pod

=encoding UTF-8

=head1 NAME

Dist::Zilla::Plugin::Manifest::Write - Have annotated MANIFEST in your distribution

=head1 VERSION

Version 0.004, released on 2015-07-09 14:23 UTC.

=head1 WHAT?

C<Dist-Zilla-Plugin-Manifest-Write> is a plugin for C<Dist-Zilla>, a replacement for standard plugin C<Manifest>. C<Dist-Zilla-Plugin-Manifest-Write> writes annotated F<MANIFEST>: each filename is followed by a comment, explaining origin
of the file, whether it is part of software, meta information, or 3rd party file.

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

If you want to have annotated MANIFEST in your distribution, read the L<C<Manual>|Dist::Zilla::Plugin::Manifest::Write::Manual>. General
topics like getting source, building, installing, bug reporting and some others are covered in the
L<C<ReadMe>|Dist::Zilla::Plugin::Manifest::Write::ReadMe>.

=head1 SYNOPSIS

    package Dist::Zilla::Plugin::Manifest::Write::FileSize;

    use Moose;
    use namespace::autoclean;
    use parent 'Dist::Zilla::Plugin::Manifest::Write';
    our $VERSION = '0.007';

    #   Overload any method or modify it with all the Moose power, e. g.:
    around _comment => sub {
        my ( $orig, $self, $file ) = @_;
        my $comment = $self->$orig( $file );
        if ( $file->name ne $self->manifest ) {
            $comment .= sprintf( ' (%d bytes)', length( $file->encoded_content ) );
        };
        return $comment;
    };

    __PACKAGE__->meta->make_immutable;
    1;

=head1 DESCRIPTION

C<Dist::Zilla::Plugin::Manifest::Write> class plays L<Dist::Zilla::Role::FileGatherer> role. To perform the role, the
class implements C<gather_files> method. Other methods are supporting helpers for this one.

This documentation is far from be complete, but the module is rather simple.

=head1 CLASS METHODS

=head2 BUILDARGS

Split `source_providers` and `metainfo_providers` options. It allows user to specify multiple
plugin names in one line in F<dist.ini> file, e. g.:

    [Manifest::Write]
        source_providers = GatherDir GatherDir::Template

=head1 INSTANCE ATTRIBUTES

=head2 manifest

String. Name of manifest file to write. Default value is C<MANIFEST>.

=head1 INSTANCE METHODS

=head2 _filename

TODO

=head2 _comment

TODO

=head2 gather_files

This is the main method of the class. It adds a file with name C<$self->manifest> to the
distribution. File content is specified with CodeRef to postpone actual file creation. Being
evaluated, the code iterates through all the files in distribution in alphabetical order, and
fulfills the manifest with filenames and comments.

=head2 mvp_multivalue_args

TODO

=head1 SEE ALSO

=over 4

=item L<Dist::Zilla>

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

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

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

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

=item L<Dist::Zilla::Plugin::Manifest::Write::Manual>

=item L<Dist::Zilla::Plugin::Manifest::Write::ReadMe>

=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-Write.

perl-Dist-Zilla-Plugin-Manifest-Write 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-Write 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-Write. If not, see <http://www.gnu.org/licenses/>.

=cut
