CGI Plack Test

00_root.t

use strict;
use warnings;
use Test::More;
use Plack::Test;
use HTTP::Request::Common;

use Plack::Loader;
use Plack::Util ();

my $app = Plack::Util::load_psgi('app.psgi');
test_psgi $app, sub {
    my $cb = shift;

    my $res;

    $res = $cb->(GET "/index.cgi");
    is $res->code, '200';

    $res = $cb->(GET "/hello.cgi?name=memememomo");
    is $res->content, "Hello, memememomo";

    $res = $cb->(POST '/post.cgi', { name => 'memememomo' });
    is $res->content, "Hello, memememomo";

    $res = $cb->(GET '/redirect.cgi');
    is $res->code, '301';
};                                                                                                           

done_testing();

01_mech.t

use strict;
use warnings;
use Plack::Test;
use Plack::Util;
use Test::More;
use Test::Requires 'Test::WWW::Mechanize::PSGI';

my $app = Plack::Util::load_psgi 'app.psgi';

my $mech = Test::WWW::Mechanize::PSGI->new(app => $app);
$mech->get_ok('/index.cgi');

$mech->get_ok('/hello.cgi?name=memememomo');
$mech->content_like(qr/Hello, memememomo/);

$mech->post_ok('/post.cgi', { name => 'memememomo' });
$mech->content_like(qr/Hello, memememomo/);
                                                                                                             
$mech->get_ok('/redirect.cgi');

done_testing;

app.psgi

#!/usr/bin/perl                                                                                              

use strict;
use warnings;
use File::Basename;

use Plack::Builder;
use Plack::App::CGIBin;

my $basedir = dirname(__FILE__);

builder {
    mount "/" =>
        Plack::App::CGIBin->new( root => $basedir, exec_cb => sub { 1 } )->to_app;
};

hello.cgi

#!/usr/bin/perl                                                                                              
use strict;
use warnings;
use CGI;

my $q = CGI->new;
my $name = $q->param('name');
$q->header(-type => 'text/plain');
print "Hello, $name";

index.cgi

#!/usr/bin/perl                                                                                              
use strict;
use warnings;
use CGI;

my $q = CGI->new;
$q->header(-type => 'text/plain');
print "ok";

post.cgi

#!/usr/bin/perl                                                                                                   

use strict;
use warnings;
use CGI;

my $q = CGI->new;
my $name = $q->param('name');

print $q->header(-type => 'text/plain');
print "Hello, $name";

redirect.cgi

#!/usr/bin/perl
use strict;
use warnings;
use CGI;

my $q = CGI->new;
print $q->redirect(
      -status => 301,
      -uri => '/index.cgi'                                                                                        
);