Amon2 for perl のControllerに対するTest::Moreによるunit test

以下の get_dummy_context() 内に記載しているようにAmon2クラスに対して、plug-inを書くとOK

use strict;
use utf8;
use t::Util;
use CGI;
use Date::Calc;
use JSON;
use Plack::Session;
use Plack::Test;
use Plack::Util;
use Test::More;
use Data::Dumper;

Ean->bootstrap;
use_ok('Ean::Controller::MemberEdit');
use_ok('Ean::ObjModel::Member');

my $SMART_ID = 'mae';
my $CGI;
my $SESSION;
my $REQUEST;


subtest 'confirm' => sub {

    my $class = 'Ean::Controller::MemberEdit';

    my $c = get_dummy_context();
    $c->session->set( navi_id => $SMART_ID );

    $c->req->param( 'navi_email_send', 1 );
    $c->req->param( 'ean_email1',      'ndds-test@example.com' );
    $c->req->param( 'ean_email1_conf', 'ndds-test@example.com' );
    $c->req->param( 'ean_email1_send', 1 );
    my $ret_data = $class->confirm($c);
    #JSONで返す型(int)もcheck
    like($ret_data, qr/"ean_email2_send":1/o);
    like($ret_data, qr/"show_bems_area_1":1/o);
    like($ret_data, qr/"show_bems_area_2":1/o);
    like($ret_data, qr/"navi_email_send":1/o);
    like($ret_data, qr/"ean_email1":"ndds-test\@example.com"/o);
    like($ret_data, qr/"ean_email1_conf":"ndds-test\@example.com"/o);
    like($ret_data, qr/"ean_email1_send":1/o);
    like($ret_data, qr/"ean_email2":"ndds-test2\@example.com"/o);
    like($ret_data, qr/"ean_email2_conf":"ndds-test2\@example.com"/o);

};


sub date_str {
    my ($day_diff) = @_;
    my @date = Date::Calc::Add_Delta_Days(Date::Calc::Today, $day_diff||0);
    return sprintf("%04d-%02d-%02d", @date);
}

sub now_str {
    my ($day_diff) = @_;
    my @datetime =
        Date::Calc::Add_Delta_YMDHMS(Date::Calc::Today_and_Now,
                                     0,0,$day_diff||0, 0,0,0);
    return sprintf("%04d-%02d-%02d %02d:%02d:%02d", @datetime);
}


sub get_dummy_context {
    no strict 'refs';
    no warnings 'redefine';

    *{"Ean\::session"} =
        sub {
            return $SESSION if $SESSION;

            my $dummy_env = {'psgix.session'=>{},
                             'psgix.session.options'=>{}};
            $SESSION = Plack::Session->new( $dummy_env );
            return $SESSION;
        };
    *{"Ean\::req"} =
        sub {
            return $CGI if $CGI;

            $CGI = CGI->new();
            return $CGI;
        };

    *{"Ean\::render_json"} =
        sub {
            my ($self,$perl_obj) = @_;
            return JSON::to_json($perl_obj);
        };

    *{"Ean\::request"} =
        sub {
            return $REQUEST if $REQUEST;

            $REQUEST = DummyRequest->new();
            return $REQUEST;
        };
    
    my $c = Ean->bootstrap;
    return $c;
}


done_testing;


package DummyRequest;

sub new {
    my ($class) = @_;
    my $self = {};
    $self =  bless $self, $class;
    return $self;
}

sub cookies { return {}; }
sub env { return {}; }

__DATA__