# Copyrights 2007-2015 by [Mark Overmeer].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
package Dancer2::Plugin::LogReport;
use vars '$VERSION';
$VERSION = '1.07';


use warnings;
use strict;

use Dancer2::Plugin;
use Log::Report  'log-report', syntax => 'REPORT';

use Scalar::Util qw/blessed/;

my $_dsl;        # XXX How to avoid the global?   Dancer2::Core::DSL
my $_settings;


# "use" import
sub import
{   my $class = shift;
    Log::Report->import('+2', @_, syntax => 'LONG');
}

# Dancer2 import
on_plugin_import
{   my $dsl      = $_dsl      = shift;  # capture global singleton
    my $settings = $_settings = plugin_setting;

    # Need init_error for exceptions and other errors
    $dsl->hook(init_error => sub {
        my $error = shift;
        # Catch other exceptions. This hook is called for all errors
        # not just exceptions (including for example 404s), so check first.
        # If it's an exception then panic it to get Log::Report
        # to handle it nicely. If it's another error such as a 404
        # then exception will not be set.
        report 'PANIC' => $error->{exception}
            if $error->{exception};
    });

    if($settings->{handle_http_errors})
    {   # Need after_error for HTTP errors (eg 404) so as to
        # be able to change the forwarding location
        $dsl->hook(after_error => sub {
            use Data::Dumper; say STDERR Dumper \@_;
            my $error = shift;
            my $msg = $error->status . ": "
              . Dancer2::Core::HTTP->status_message($error->status);

            # XXX How to write messages to the session? request() is not
            # in the DSL at this point. At least log it.
            report 'TRACE' => $msg;
            _forward_home( $error, danger => $msg ); # $error is the request
        });
    }

    # This is so that all messages go into the session, to be displayed
    # on the web page (if required)
    dispatcher CALLBACK => 'error_handler'
      , callback => \&_error_handler
      , mode     => 'DEBUG';
};    # ";" required!


sub process($$)
{   my ($dsl, $coderef) = @_;
    try { $coderef->() };

    # Return true on success
    if (my $exception = $@->wasFatal)
    {   $exception->throw(is_fatal => 0);
        return 0;
    }
    $@->reportAll;
    1;
}

register process => \&process;

sub _message_add($$)
{   my ($type, $text) = @_;
    $text && $type or return;
    unless ($_dsl->app->request)
    {   # This happens for HTTP errors
        # XXX the session is not available in the DSL
        report 'ASSERT' => "Unable to write message to session: unable to write cookie";
        return;
    }
    my $messages_variable = $_settings->{messages_key} || 'messages';
    my $session           = $_dsl->app->session;
    my $msgs              = $session->read($messages_variable);
    push @$msgs, { text => $text, type => $type };
    $session->write($messages_variable => $msgs);
}

#------

sub _forward_home($$$)
{   my $dsl = shift;
    _message_add(shift, shift);
    my $page = $_settings->{forward_url} || '/';
    $dsl->redirect($page);
}

sub _error_handler($$$$)
{   my ($disp, $options, $reason, $message) = @_;

    my $fatal_handler = sub {
        _forward_home( $_dsl, danger => $_[0] )
            unless $_dsl->request->uri eq '/' && $_dsl->request->is_get;
    };

    my %handler =
      ( # Default do nothing for the moment (TRACE|ASSERT|INFO)
        default => sub {}

        # Notice that something has happened. Not an error.
      , NOTICE  => sub {_message_add info => $_[0]}

        # Non-fatal problem. Show warning.
      , WARNING => sub {_message_add warning => $_[0]}

        # Non-fatal problem. Show warning.
      , MISTAKE => sub {_message_add warning => $_[0]}

        # A user-created error condition that is not recoverable.
        # This could have already been caught by the process
        # subroutine, in which case we should continue running
        # of the program. In all other cases, we should bail
        # out. With the former, the exception will have been
        # re-thrown as a non-fatal exception, so check that.
      , ERROR   => sub {
            return _message_add( danger => $_[0] )
                if exists $options->{is_fatal} && !$options->{is_fatal};

            return  _forward_home( $_dsl, danger => $_[0] )
                if $_dsl->request->uri ne '/' || !$_dsl->request->is_get;

            return;
       }

        # 'FAULT', 'ALERT', 'FAILURE', 'PANIC'
        # All these are fatal errors. Display error to user, but
        # forward home so that we can reload. However, don't if
        # it's a GET request to the home, as it will cause a recursive
        # loop. In this case, do nothing, and let dancer handle it.
      , FAULT   => $fatal_handler
      , ALERT   => $fatal_handler
      , FAILURE => $fatal_handler
      , PANIC   => $fatal_handler
      );

    my $call = $handler{$reason} || $handler{default};
    $call->("$message");
}

sub _report($@) {
    my ($reason, $dsl) = (shift, shift);

    my $msg = (blessed($_[0]) && $_[0]->isa('Log::Report::Message'))
       ? $_[0] : Dancer2::Core::Role::Logger::_serialize(@_);

    report uc($reason) => $msg;
}

register trace   => sub { _report(TRACE => @_) };
register assert  => sub { _report(ASSERT => @_) };
register notice  => sub { _report(NOTICE => @_) };
register mistake => sub { _report(MISTAKE => @_) };
register panic   => sub { _report(PANIC => @_) };
register alert   => sub { _report(ALERT => @_) };

register_plugin for_versions => ['2'];

#----------

1;