The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use warnings;
use strict;
use utf8;
use open qw(:std :utf8);
use lib qw(lib ../lib);

use FindBin;
use lib "$FindBin::Bin/../lib";
use Test::More tests    => 20;
use Encode qw(decode encode decode_utf8);

my @elist;
my @mails;


BEGIN {
    # Подготовка объекта тестирования для работы с utf8
    my $builder = Test::More->builder;
    binmode $builder->output,         ":utf8";
    binmode $builder->failure_output, ":utf8";
    binmode $builder->todo_output,    ":utf8";

    use_ok 'Test::Mojo';
    require_ok 'Mojolicious';
    require_ok 'MIME::Lite';
    require_ok 'MIME::Words';
    require_ok 'Mojolicious::Plugin::MailException';
}


my $t = Test::Mojo->new('MpemTest');
$t  -> get_ok('/')
    -> status_is(200)
    -> content_is('Hello')
;


$t  -> get_ok('/crash')
    -> status_is(500)
    -> element_exists('div#showcase > pre')
    -> content_like(qr{<pre>превед, медвед})
    -> content_like(qr{
        <tr[^>]+class="important"[^>]*>
        \s*
        <td.*?/td>
        \s*
        <td[^>]+class="value"[^>]*>
        \s*
        <pre[^>]+class="prettyprint"[^>]*>
        \s*
        [^>]*
        die\s+marker
    }x
    )
;



is  scalar @elist, 1, 'one caugth exception';
my $e = shift @elist;



like $e->message, qr{превед, медвед}, 'text of message';
like $e->line->[1], qr{die "превед, медвед"}, 'line';

is scalar @mails, 1, 'one prepared mail';
my $m = shift @mails;


# note decode_utf8 $t->tx->res->to_string;
# note decode_utf8 $m->as_string;


$m->send if $ENV{SEND};
isa_ok $m => 'MIME::Lite';
$m = $m->as_string;
like $m, qr{^Stack}m, 'Stack';
like $m, qr{^Content-Disposition:\s*inline}m, 'Content-Disposition';


package MpemTest::Ctl;
use Mojo::Base 'Mojolicious::Controller';

sub hello {
     $_[0]->render_text('Hello');
}

sub crash {
    eval {
        die "медвед, превед";
    };
    die "превед, медвед"; ### die marker
}

package MpemTest;
use utf8;
use strict;
use warnings;

use Mojo::Base 'Mojolicious';


sub startup {
    my ($self) = @_;

    $self->secret('my secret phrase');
    $self->mode('development');

    $self->plugin('MailException',
        send => sub {
            my ($m, $e) = @_;
            push @elist => $e;
            push @mails => $m;
        },
        $ENV{FROM}  ? ( from => $ENV{FROM} ) : (),
        $ENV{TO}    ? ( to   => $ENV{TO} ) : (),
        subject => 'Случилось страшное (тест)!',
        headers => {},
    );
    for my $r ($self->routes) {
        $r  -> get('/')
            -> to('ctl#hello');

        $r  -> get('/crash')
            -> to('ctl#crash')
        ;

    }
}

1;