package Dancer2::Plugin;
{
  $Dancer2::Plugin::VERSION = '0.02';
}

# ABSTRACT: Extending Dancer2's DSL with plugins


use Moo::Role;
use Carp 'croak';
use Dancer2::Core::DSL;


# singleton for storing all keywords,
# their code and the plugin they come from
my $_keywords = {};

sub register {
    my $plugin = caller;
    my $caller = caller(1);
    my ($keyword, $code, $options) = @_;
    $options ||= {is_global => 1};

    $keyword =~ /^[a-zA-Z_]+[a-zA-Z0-9_]*$/
      or croak "You can't use '$keyword', it is an invalid name"
      . " (it should match ^[a-zA-Z_]+[a-zA-Z0-9_]*$ )";

    if (grep { $_ eq $keyword }
        map { s/^(?:\$|%|&|@|\*)//; $_ }
        (map { $_->[0] } @{Dancer2::Core::DSL->dsl_keywords})
      )
    {
        croak "You can't use '$keyword', this is a reserved keyword";
    }

    while (my ($plugin, $keywords) = each %$_keywords) {
        if (grep { $_->[0] eq $keyword } @$keywords) {
            croak "You can't use $keyword, "
              . "this is a keyword reserved by $plugin";
        }
    }

    $_keywords->{$plugin} ||= [];
    push @{$_keywords->{$plugin}}, [$keyword, $code, $options->{is_global}];
}


sub register_plugin {
    my $plugin = caller;
    my $caller = caller(1);
    my %params = @_;

    # For backward compatibility, no params means "supports only Dancer2 1"
    $params{for_versions} = [1]
      if !defined $params{for_versions};

    my $supported_versions = $params{for_versions};
    croak "register_plugin must be called with an array ref"
      if ref $supported_versions ne ref([]);

    # if the caller has not a dsl, we cant register the plugin
    return if !$caller->can('dsl');

    my $dancer_major_version = $caller->dancer_app->api_version;
    my $plugin_version = eval "\$${plugin}::VERSION" || '??';

    # make sure the plugin is compatible with this version of Dancer2
    if ($ENV{DANCER_FORCE_PLUGIN_REGISTRATION}) {
        print STDERR "DANCER_FORCE_PLUGIN_REGISTRATION\n";
    }
    else {
        croak
          "$plugin $plugin_version does not support Dancer2 $dancer_major_version."
          if !grep { $_ eq $dancer_major_version } @$supported_versions;
    }

    # the plugin consumes the DSL role
    Moo::Role->apply_role_to_package($plugin, 'Dancer2::Core::Role::DSL');

    # bind all registered keywords to the plugin
    my $dsl = $caller->dsl;
    for my $k (@{$_keywords->{$plugin}}) {
        my ($keyword, $code, $is_global) = @{$k};
        {
            no strict 'refs';
            *{"${plugin}::${keyword}"} = $code;
        }
    }

# create the import method of the caller (the actual plugin) in order to make it
# imports all the DSL's keyword when it's used.
    my $import = sub {
        my $plugin = shift;

        # caller(1) because our import method is wrapped, see below
        my $caller = caller(1);

        for my $k (@{$_keywords->{$plugin}}) {
            my ($keyword, $code, $is_global) = @{$k};
            $caller->dsl->register($keyword, $is_global);
        }

        Moo::Role->apply_roles_to_object($caller->dsl, $plugin);
        $caller->dsl->export_symbols_to($caller);
        $caller->dsl->dancer_app->register_plugin($caller->dsl);
    };

    my $app_caller = caller();
    {
        no strict 'refs';
        no warnings 'redefine';
        my $original_import = *{"${app_caller}::import"}{CODE};
        $original_import ||= sub { };
        *{"${app_caller}::import"} = sub {
            $original_import->(@_);
            $import->(@_);
        };
    }

    # The plugin is ready now.
}


sub plugin_args {@_}


sub plugin_setting {
    my $plugin = caller;
    (my $plugin_name = $plugin) =~ s/Dancer2::Plugin:://;
    my $app = $plugin->dancer_app;
    return $app->config->{'plugins'}->{$plugin_name} ||= {};
}


sub register_hook {
    my $caller = caller;
    my $plugin = $caller;

    my (@hooks) = @_;

    my $current_hooks = [];
    if ($plugin->can('supported_hooks')) {
        $current_hooks = [$plugin->supported_hooks];
    }

    my $current_aliases = {};
    if ($plugin->can('hook_aliases')) {
        $current_aliases = $plugin->hook_aliases;
    }

    $plugin =~ s/^Dancer2::Plugin:://;
    $plugin =~ s/::/_/g;

    my $base_name = "plugin." . lc($plugin);
    for my $hook (@hooks) {
        my $hook_name = "${base_name}.$hook";

        push @{$current_hooks}, $hook_name;
        $current_aliases->{$hook} = $hook_name;
    }

    {
        no strict 'refs';
        no warnings 'redefine';
        *{"${caller}::supported_hooks"} = sub {@$current_hooks};
        *{"${caller}::hook_aliases"}    = sub {$current_aliases};
    }
}


sub execute_hook {
    my $position = shift;
    my $dsl      = _get_dsl();
    croak "No DSL object found" if !defined $dsl;
    $dsl->execute_hook($position, @_);
}

# private

sub import {
    my $class  = shift;
    my $plugin = caller;


    # First, export Dancer2::Plugins symbols
    my @export = qw(
      execute_hook
      register_hook
      register_plugin
      register
      plugin_setting
      plugin_args
    );

    for my $symbol (@export) {
        no strict 'refs';
        *{"${plugin}::${symbol}"} = *{"Dancer2::Plugin::${symbol}"};
    }

    my $dsl = _get_dsl();
    return if !defined $dsl;

 # Support for Dancer2 1 syntax for plugin.
 # Then, compile Dancer2's DSL keywords into self-contained keywords for the
 # plugin (actually, we call all the symbols by giving them $caller->dsl as
 # their first argument).
 # These modified versions of the DSL are then exported in the namespace of the
 # plugin.
    for my $symbol ($dsl->dsl_keywords_as_list) {

        # get the original symbol from the real DSL
        no strict 'refs';
        no warnings 'redefine';
        my $code = *{"Dancer2::Core::DSL::$symbol"}{CODE};

        # compile it with $caller->dsl
        my $compiled = sub { $code->($dsl, @_) };

        # bind the newly compiled symbol to the caller's namespace.
        *{"${plugin}::${symbol}"} = $compiled;
    }

    # Finally, make sure our caller becomes a Moo::Role
    # Perl 5.8.5+ mandatory for that trick
    @_ = ('Moo::Role');
    goto &Moo::Role::import;
}

sub _get_dsl {
    my $dsl;
    my $deep = 2;
    while (my $caller = caller($deep++)) {
        $dsl = $caller->dsl if $caller->can('dsl');
        last if defined $dsl && length(ref($dsl));
    }

    return $dsl;
}

1;


__END__
=pod

=head1 NAME

Dancer2::Plugin - Extending Dancer2's DSL with plugins

=head1 VERSION

version 0.02

=head1 DESCRIPTION

You can extend Dancer2 by writing your own Plugin.

A plugin is a module that exports a bunch of symbols to the current namespace
(the caller will see all the symbols defined via C<register>).

Note that you have to C<use> the plugin wherever you want to use its symbols.
For instance, if you have Webapp::App1 and Webapp::App2, both loaded from your
main application, they both need to C<use FooPlugin> if they want to use the
symbols exported by C<FooPlugin>.

=head1 METHODS

=head2 register

Allows the plugin to define a keyword that will be exported to the caller's
namespace.

The first argument is the symbol name, the second one the coderef to execute
when the symbol is called.

The coderef receives as its first argument the Dancer2::Core::DSL object. Any
Dancer2 keyword wrapped by the plugin should be called with the $dsl object like
the following:

    sub {
        my $dsl = shift;
        my @args = @_;

        $dsl->some_dancer_thing;
        ...
    };

As an optional third argument, it's possible to give a hash ref to C<register>
in order to set some options.

The option C<is_global> (boolean) is used to declare a global/non keyword (by
default all keywords are global). A non global keyword must be called from
within a route handler (eg: C<session> or C<param>) whereas a global one can be called
frome everywhere (eg: C<dancer_version> or C<setting>).

    register my_symbol_to_export => sub {
        # ... some code
    }, { is_global => 1} ;

=head2 register_plugin

A Dancer2 plugin must end with this statement. This lets the plugin register all
the symbols defined with C<register> as exported symbols.

Since version 2, Dancer2 requires any plugin to declare explicitly which version
of the core it supports. This is done for safer upgrade of major versions and
allow Dancer2 2 to detect legacy plugins that have not been ported to the new
core. To do so, the plugin must list the major versions of the core it supports
in an arrayref, like the following:

    # For instance, if the plugin works with Dancer2 1 and 2:
    register_plugin for_versions => [ 1, 2 ];

    # Or if it only works for 2:
    register_plugin for_versions => [ 2 ];

If the C<for_versions> option is omitted, it dfaults to C<[ 1 ]> meaning the
plugin was written for Dancer2 1 and has not been ported to Dancer2 2. This is a
rather violent convention but will help a lot the migration of the ecosystem.

=head2 plugin_args

Simple method to retrieve the parameters or arguments passed to a
plugin-defined keyword. Although not relevant for Dancer2 1 only, or
Dancer2 2 only, plugins, it is useful for universal plugins.

  register foo => sub {
     my ($self, @args) = plugin_args(@_);
     ...
  }

Note that Dancer2 1 will return undef as the object reference.

=head2 plugin_setting

If C<plugin_setting> is called inside a plugin, the appropriate configuration
will be returned. The C<plugin_name> should be the name of the package, or,
if the plugin name is under the B<Dancer2::Plugin::> namespace (which is
recommended), the remaining part of the plugin name.

Configuration for plugin should be structured like this in the config.yml of
the application:

  plugins:
    plugin_name:
      key: value

Enclose the remaining part in quotes if it contains ::, e.g.
for B<Dancer2::Plugin::Foo::Bar>, use:

  plugins:
    "Foo::Bar":
      key: value

=head2 register_hook

Allows a plugin to delcare a list of supported hooks. Any hook declared like so
can be executed by the plugin with C<execute_hook>.

    register_hook 'foo';
    register_hook 'foo', 'bar', 'baz';

=head2 execute_hook

Allows a plugin to execute the hooks attached at the given position

    execute_hook 'some_hook';

Arguments can be passed which will be received by handlers attached to that
hook:

    execute_hook 'some_hook', $some_args, ... ;

The hook must have been registered by the plugin first, with C<register_hook>.

=head1 EXAMPLE PLUGIN

The following code is a dummy plugin that provides a keyword 'block_links_from'.

  package Dancer2::Plugin::LinkBlocker;
  use Dancer2::Plugin;

  register block_links_from => sub {
    my $dsl = shift;

    my $conf = plugin_setting();
    my $re = join ('|', @{$conf->{hosts}});
    $dsl->before( sub {
        if ($dsl->request->referer && $dsl->request->referer =~ /$re/) {
            $dsl->status(403) || $conf->{http_code};
        }
    });
  };

  register_plugin for_versions => [ 2 ] ;

  1;

And in your application:

    package My::Webapp;

    use Dancer2;
    use Dancer2::Plugin::LinkBlocker;

    block_links_from; # this is exported by the plugin

=head1 AUTHOR

Dancer Core Developers

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Alexis Sukrieh.

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