#   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
#   file: lib/Dist/Zilla/Role/Hooker.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-Hook.
#pod
#pod perl-Dist-Zilla-Plugin-Hook is free software: you can redistribute it and/or modify it under
#pod 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-Hook is distributed in the hope that it will be useful, but WITHOUT ANY
#pod WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
#pod 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-Hook. If not, see <http://www.gnu.org/licenses/>.
#pod
#pod =cut

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

#pod =for :this This is C<Dist::Zilla::Role::Hooker> role documentation. Read this if you are going
#pod to hack or extend C<Dist-Zilla-Plugin-Hook>, or use the role in your plugin.
#pod
#pod =for :that If you want to write C<Dist::Zilla> plugin directly in F<dist.ini>, read the L<manual|Dist::Zilla::Plugin::Hook::Manual>. General
#pod topics like getting source, building, installing, bug reporting and some others are covered in the
#pod L<readme|Dist::Zilla::Plugin::Hook::ReadMe>.
#pod
#pod =head1 DESCRIPTION
#pod
#pod C<Dist-Zilla-Plugin-Hook> is a set of plugins: C<Hook::Init>, C<Hook::BeforeBuild>, C<Hook::GatherFiles>,
#pod etc. All these plugins are just stubs, they contains almost no code. They just use services
#pod provided by the C<Hooker> role. The role is an engine for all C<Hook> plugins.
#pod
#pod =head1 SEE ALSO
#pod
#pod =for :list
#pod = L<Dist::Zilla>
#pod = L<Dist::Zilla::Role>
#pod = L<Dist::Zilla::Role::Plugin>
#pod = L<Dist::Zilla::Plugin::Hook::Manual>
#pod = L<Dist::Zilla::Plugin::Hook::ReadMe>
#pod
#pod =cut

package Dist::Zilla::Role::Hooker;

# TODO: Explicitly require Perl 5.14?
use Moose::Role;
use namespace::autoclean;

# ABSTRACT: Run Perl code written in your plugin's F<dist.ini> section
our $VERSION = '0.002'; # VERSION

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

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

#pod =attr code
#pod
#pod Perl code to execute, list of lines (without newline characters).
#pod
#pod ArrayRef[Str], read-only. Default value is empty array (i. e. no code).
#pod
#pod Note: C<init_arg> attribute property set to ".". In F<dist.ini> file the Perl code should be
#pod specified using this notation:
#pod
#pod     [Hook::Phase]
#pod         . = …Perl code…
#pod
#pod =cut

has code => (
    is          => 'ro',
    isa         => 'ArrayRef[Str]',
    auto_deref  => 1,
    init_arg    => '.',
    default     => sub { [] },
);

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

#pod =method hook
#pod
#pod     $ret = $self->hook( @args );
#pod     @ret = $self->hook( @args );
#pod     $self->hook( @args );
#pod
#pod This is the primary method of the role. The method executes Perl code specified in C<code>
#pod attribute with string C<eval>. The method passes arguments specified by the caller to the code, and
#pod passes the code return value back to the caller. Calling context (list, scalar, or void) is
#pod preserved. The method also hides all the lexical variables (except the variables documented below)
#pod from code. The method intercepts warnings generated in code and logs them, but warnings do not stop
#pod executing.
#pod
#pod Following lexical variables are exposed to the code intentionally:
#pod
#pod =for :list
#pod = C<$self>
#pod = C<$plugin>
#pod Reference to the plugin object executing the code (such as C<Hook::Init> or C<Hook::BeforeBuild>).
#pod = C<$zilla>
#pod = C<$dist>
#pod Reference to C<Dist::Zilla> object, the same as C<< $self->zilla >>.
#pod = C<$arg>
#pod The same as C<$args[ 0 ]>.
#pod = C<@_>
#pod C<hook> arguments, self-reference is already shifted!
#pod
#pod If code dies, the method logs error message and aborts C<Dist::Zilla>.
#pod
#pod =cut

sub hook {                  ## no critic ( RequireArgUnpacking )
    my $self = shift( @_ );
    if ( not $self->code ) {
        return;
    };
    my $zilla  = $self->zilla;      # `eval` sees these variables.
    my $plugin = $self;
    my $dist   = $zilla;
    my $arg    = $_[ 0 ];
    my $code   =                    # Declaration is not yet completed, `eval` will not see it.
        sub {
            #~ local $SIG{ __DIE__ };   # TODO: Should I cancel die handler, if any is set?
            local $SIG{ __WARN__ } = sub {
                my $msg = "$_[ 0 ]";
                chomp( $msg );
                $self->log( $msg );
            };
            eval(           ## no critic ( ProhibitStringyEval, RequireCheckingReturnValueOfEval )
                join(
                    "\n",
                    '#line 1 prologue',
                    $self->prologue,
                    '#line 1 ' . $self->plugin_name,        # It makes error repoting nicier.
                    $self->code
                )
            );
        };
    my $want = wantarray();
    my @ret;
    local $@ = $@;                  # Clobbering $@ was fixed in Perl 5.14.
    if ( $want ) {                  # Let us keep calling context.
        @ret = $code->( @_ );
    } elsif ( defined( $want ) ) {
        $ret[ 0 ] = $code->( @_ );
    } else {
        $code->( @_ );
    };
    if ( blessed( $@ ) or $@ ne '' ) {
        my $msg = "$@";
        chomp( $msg );
        $self->log_error( $msg );
        $self->abort();
    };
    return $want ? @ret : $ret[ 0 ];
};

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

#pod =method prologue
#pod
#pod     my @code = $self->prologue;
#pod
#pod The methods returns prologue code.
#pod
#pod Prologue code is extracted from C<Dist::Zilla> plugin named C<prologue>.
#pod
#pod =cut

sub prologue {
    my ( $self ) = @_;
    my $zilla = $self->zilla;
    my $prologue = $zilla->plugin_named( 'prologue' );
    if ( $prologue and $prologue->meta->does_role( 'Dist::Zilla::Role::Hooker' ) ) {
        return $prologue->code;
    };
    return ();
};

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

#pod =method mvp_multivalue_args
#pod
#pod The method tells C<Dist::Zilla> that dot (C<.>) is a multi-value option.
#pod
#pod =cut

around mvp_multivalue_args => sub {
    my ( $orig, $self ) = @_;
    return ( $self->$orig(), qw{ . } );
};

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

around mvp_aliases => sub {
    my ( $orig, $self ) = @_;
    my $aliases = $self->$orig();
    $aliases->{ hook } = '.';
    return $aliases;
};

1;

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

# doc/what.pod #

#pod =encoding UTF-8
#pod
#pod =head1 WHAT?
#pod
#pod C<Dist-Zilla-Plugin-Hook> (or just C<Hook>) is a set of C<Dist-Zilla> plugins. Every plugin executes Perl
#pod code inlined into F<dist.ini> at particular stage of build process.
#pod
#pod =cut

# end of file #


# end of file #

__END__

=pod

=encoding UTF-8

=head1 NAME

Dist::Zilla::Role::Hooker - Run Perl code written in your plugin's F<dist.ini> section

=head1 VERSION

Version 0.002, released on 2015-07-23 22:08 UTC.

=head1 WHAT?

C<Dist-Zilla-Plugin-Hook> (or just C<Hook>) is a set of C<Dist-Zilla> plugins. Every plugin executes Perl
code inlined into F<dist.ini> at particular stage of build process.

This is C<Dist::Zilla::Role::Hooker> role documentation. Read this if you are going
to hack or extend C<Dist-Zilla-Plugin-Hook>, or use the role in your plugin.

If you want to write C<Dist::Zilla> plugin directly in F<dist.ini>, read the L<manual|Dist::Zilla::Plugin::Hook::Manual>. General
topics like getting source, building, installing, bug reporting and some others are covered in the
L<readme|Dist::Zilla::Plugin::Hook::ReadMe>.

=head1 DESCRIPTION

C<Dist-Zilla-Plugin-Hook> is a set of plugins: C<Hook::Init>, C<Hook::BeforeBuild>, C<Hook::GatherFiles>,
etc. All these plugins are just stubs, they contains almost no code. They just use services
provided by the C<Hooker> role. The role is an engine for all C<Hook> plugins.

=head1 OBJECT ATTRIBUTES

=head2 code

Perl code to execute, list of lines (without newline characters).

ArrayRef[Str], read-only. Default value is empty array (i. e. no code).

Note: C<init_arg> attribute property set to ".". In F<dist.ini> file the Perl code should be
specified using this notation:

    [Hook::Phase]
        . = …Perl code…

=head1 OBJECT METHODS

=head2 hook

    $ret = $self->hook( @args );
    @ret = $self->hook( @args );
    $self->hook( @args );

This is the primary method of the role. The method executes Perl code specified in C<code>
attribute with string C<eval>. The method passes arguments specified by the caller to the code, and
passes the code return value back to the caller. Calling context (list, scalar, or void) is
preserved. The method also hides all the lexical variables (except the variables documented below)
from code. The method intercepts warnings generated in code and logs them, but warnings do not stop
executing.

Following lexical variables are exposed to the code intentionally:

=over 4

=item C<$self>

=item C<$plugin>

Reference to the plugin object executing the code (such as C<Hook::Init> or C<Hook::BeforeBuild>).

=item C<$zilla>

=item C<$dist>

Reference to C<Dist::Zilla> object, the same as C<< $self->zilla >>.

=item C<$arg>

The same as C<$args[ 0 ]>.

=item C<@_>

C<hook> arguments, self-reference is already shifted!

=back

If code dies, the method logs error message and aborts C<Dist::Zilla>.

=head2 prologue

    my @code = $self->prologue;

The methods returns prologue code.

Prologue code is extracted from C<Dist::Zilla> plugin named C<prologue>.

=head2 mvp_multivalue_args

The method tells C<Dist::Zilla> that dot (C<.>) is a multi-value option.

=head1 SEE ALSO

=over 4

=item L<Dist::Zilla>

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

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

=item L<Dist::Zilla::Plugin::Hook::Manual>

=item L<Dist::Zilla::Plugin::Hook::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-Hook.

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

=cut
