# Dist/Zilla/Plugin/Manifes/Write.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-Write.
#pod
#pod perl-Dist-Zilla-Plugin-Manifest-Write is free software: you can redistribute it and/or modify
#pod it under the terms of the GNU General Public License as published by the Free Software
#pod Foundation, either version 3 of the License, or (at your option) any later version.
#pod
#pod perl-Dist-Zilla-Plugin-Manifest-Write 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-Write. If not, see <http://www.gnu.org/licenses/>.
#pod
#pod =cut

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



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

#pod =head1 SYNOPSIS
#pod
#pod Err… TODO
#pod
#pod =cut

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

#pod =head1 WHAT?
#pod
#pod This is C<Dist-Zilla-Plugin-Manifest-Write> I<implementation documentation>. Read this if you are going to hack or
#pod extend (e. g. by subclassing) C<Dist-Zilla-Plugin-Manifest-Write>.
#pod
#pod If you are going to I<use> C<Manifest::Write> plugin, read the L<Manual|Dist::Zilla::Plugin::Manifest::Write::Manual>.
#pod General topics, like purpose, getting source, building, installing, bug reporting and others are
#pod covered in the L<ReadMe|Dist::Zilla::Plugin::Manifest::Write::ReadMe>.
#pod
#pod =cut

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

#pod =head1 DESCRIPTION
#pod
#pod TODO
#pod
#pod =cut

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

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

# PODNAME: Dist::Zilla::Plugin::Manifest::Write
# ABSTRACT: Have annotated MANIFEST in your distribution

use namespace::autoclean;

BEGIN {
    our $VERSION = '0.002'; # VERSION
};

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

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

sub mvp_multivalue_args { qw{ source_provider metainfo_provider } };

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

#pod =attr manifest
#pod
#pod String. Name of manifest file to write. Default value is C<MANIFEST>.
#pod
#pod =cut

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_provider',
);

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

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 }, $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 );
};

__PACKAGE__->meta->make_immutable;

1;

# 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.002.

=head1 WHAT?

This is C<Dist-Zilla-Plugin-Manifest-Write> I<implementation documentation>. Read this if you are going to hack or
extend (e. g. by subclassing) C<Dist-Zilla-Plugin-Manifest-Write>.

If you are going to I<use> C<Manifest::Write> plugin, read the L<Manual|Dist::Zilla::Plugin::Manifest::Write::Manual>.
General topics, like purpose, getting source, building, installing, bug reporting and others are
covered in the L<ReadMe|Dist::Zilla::Plugin::Manifest::Write::ReadMe>.

=head1 SYNOPSIS

Err… TODO

=head1 DESCRIPTION

TODO

=head1 ATTRIBUTES

=head2 manifest

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

=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
