以下の 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__