adaptation to Mojolicious switch

t/cgi.t

@@ -3,20 +3,56 @@
 use strict;
 use warnings;
 
+use feature qw(state);
+
 use English qw(-no_match_vars);
 use File::Temp;
+use HTML::Tidy5;
 use IPC::Run qw(run);
+use Test::HTML::Tidy5 qw();
 use Test::More;
+use Test::Mojo::WithRoles 'SubmitForm';
+
+plan(skip_all => 'live database required') unless
+    $ENV{TEST_DB_HOST} &&
+    $ENV{TEST_DB_NAME} &&
+    $ENV{TEST_DB_TYPE} &&
+    $ENV{TEST_DB_USERNAME} &&
+    $ENV{TEST_DB_PASSWORD};
 
 plan tests => 4;
 
-my $log = File::Temp->new(UNLINK => $ENV{TEST_DEBUG} ? 0 : 1);
-diag("log file: $log") if $ENV{TEST_DEBUG};
+sub named_subtest {
+    my ($name, $code, @args) = @_;
+
+    my $tb = Test::More->builder();
+    return $tb->subtest($name, $code, @args, $name);
+}
+
+sub setup {
+    my %args = @_;
 
-my $config = File::Temp->new(UNLINK => $ENV{TEST_DEBUG} ? 0 : 1);
-print {$config} <<EOF;
+    my $name = $args{name};
+    my $host = $args{host};
+    my $type = $args{type};
+    my $username = $args{username};
+    my $password = $args{password};
+
+    system("mysqladmin --host=$host --user=$username --password=$password --force drop $name >/dev/null");
+    system("mysqladmin --host=$host --user=$username --password=$password create $name >/dev/null") == 0
+        or die "can't run mysqladmin: $CHILD_ERROR\n";
+    system("mysql --host=$host --user=$username --password=$password $name < conf/manager.sql") == 0
+        or die "can't run mysql: $CHILD_ERROR\n";
+
+    my $temp_dir = File::Temp->newdir(CLEANUP => $ENV{TEST_DEBUG} ? 0 : 1);
+    diag("temp dir: $temp_dir") if $ENV{TEST_DEBUG};
+
+    my $log_file  = sprintf("%s/test.log", $temp_dir);
+    my $conf_file = sprintf("%s/test.conf", $temp_dir);
+
+    open(my $handle, '>', $conf_file);
+    print {$handle} <<EOF;
 [setup]
-templates_dir = templates
 templates_theme = edugain
 
 [federations]
@@ -28,7 +64,7 @@ support_email = support\@my.fqdn
 name = eduGAIN Access Check
 
 [logger]
-file = $log
+file = $log_file
 level = debug
 
 [mailer]
@@ -36,135 +72,127 @@ level = debug
 [idp]
 
 [database]
-type = mysql
-host = localhost
-name = account_manager
-username = user
-password = password
+host     = $host
+name     = $name
+type     = $type
+username = $username
+password = $password
 EOF
-$config->flush();
-diag("test configuration: $config") if $ENV{TEST_DEBUG};
-
-$ENV{ACCOUNTMANAGER_CONFIG} = $config;
-
-subtest "index page" => sub {
-
-    plan tests => 4;
-
-    local $ENV{REQUEST_METHOD} = 'GET';
-    local $ENV{QUERY_STRING}   = '';
-
-    my ($out, $err, $rc) = run_executable('access-check-manager.cgi');
-    like(
-        $out,
-        qr{^Content-Type: text/html; charset=utf8\r\n\r\n}m,
-        'HTTP headers'
-    );
-    like(
-        $out,
-        qr{<title>eduGAIN Access Check</title>},
-        'page title'
-    );
-    like(
-        $out,
-        qr{<a href="\?action=select_sp" class="button">Get started</a>},
-        'start button'
-    );
-    is($err, '', 'empty stderr');
-};
+    close($handle);
+
+    $ENV{MOJO_CONFIG} = $conf_file;
+    $ENV{ACCOUNTMANAGER_CONFIG} = $conf_file;
+
+    return $temp_dir;
+}
+
+sub get_test_object {
+    my %args = @_;
+
+    my $app = $args{app} || 'AccountManager::App';
+
+    my $t = Test::Mojo::WithRoles->new($app);
+    my $ua = $t->ua();
+    $ua->max_redirects(1);
+    $ua->on(start => sub {
+        my (undef, $tx) = @_;
+        $tx->req()->headers()->from_hash($args{user})
+            if $args{user} and !$tx->previous();
+        $tx->req()->headers()->accept_language($args{language})
+            if $args{language};
+    });
+
+    $t->app()->log()->info(sprintf('new test: %s', $args{test}))
+        if $args{test};
+
+    return $t;
+}
 
-subtest "SP selection page" => sub {
-
-    plan(skip_all => 'live database required') unless
-        $ENV{TEST_DB_HOST} &&
-        $ENV{TEST_DB_NAME} &&
-        $ENV{TEST_DB_DRIVER} &&
-        $ENV{TEST_DB_USERNAME} &&
-        $ENV{TEST_DB_PASSWORD};
-
-    plan tests => 4;
-
-    local $ENV{REQUEST_METHOD} = 'GET';
-    local $ENV{QUERY_STRING}   = 'action=select_sp';
-
-    my ($out, $err, $rc) = run_executable('access-check-manager.cgi');
-    like(
-        $out,
-        qr{^Content-Type: text/html; charset=utf8\r\n\r\n}m,
-        'HTTP headers'
-    );
-    like(
-        $out,
-        qr{<title>eduGAIN Access Check</title>},
-        'page title'
-    );
-    like(
-        $out,
-        qr{<select id="edugain" name="edugain">},
-        'page content contains SP list'
-    );
-    is($err, '', 'empty stderr');
+sub html_ok {
+    my ($res) = @_;
+
+    state $tidy =  HTML::Tidy5->new({
+        'drop-empty-elements' => 0
+    });
+    $tidy->ignore(type => TIDY_INFO);
+    $tidy->ignore(text => qr/<img> lacks "alt" attribute/);
+    # https://github.com/htacg/tidy-html5/issues/611
+    $tidy->ignore(text => qr/inserting implicit <table>/);
+    $tidy->ignore(text => qr/\S+ isn't allowed in <table> elements/);
+    $tidy->ignore(text => qr/missing \S+/);
+    $tidy->ignore(text => qr/discarding unexpected \S+/);
+    local $ENV{LANG} = 'C';
+    Test::HTML::Tidy5::html_tidy_ok($tidy, $res->text(), "HTML content OK");
+}
+
+sub diag_file {
+    my ($res, $dir) = @_;
+
+    return if !$ENV{TEST_DEBUG};
+
+    state $count = 1;
+    my $file = sprintf("%s/test_%i.html", $dir, $count);
+    diag("content saved as $file");
+
+    open (my $handle, '>', $file) or die($ERRNO);
+    print $handle $res->text();
+    close $handle;
+
+    $count++;
+}
+
+my $test_dir = setup(
+    host     => $ENV{TEST_DB_HOST},
+    name     => $ENV{TEST_DB_NAME}, 
+    type     => $ENV{TEST_DB_TYPE},
+    username => $ENV{TEST_DB_USERNAME},
+    password => $ENV{TEST_DB_PASSWORD}
+);
+
+named_subtest "index page" => sub {
+    my $t = get_test_object(test => $_[0]);
+
+    $t->get_ok('/')
+      ->status_is(200)
+      ->text_is('html head title' => 'eduGAIN Access Check')
+      ->element_exists('a[href=/step1]', 'get started button');
+
+    my $res = $t->tx()->res();
+    html_ok($res) or diag_file($res, $test_dir);
 };
 
-subtest "email selection page, missing entityid parameter" => sub {
-
-    plan tests => 4;
-
-    local $ENV{REQUEST_METHOD} = 'GET';
-    local $ENV{QUERY_STRING}   = 'action=select_email&federation=edugain';
-
-    my ($out, $err, $rc) = run_executable('access-check-manager.cgi');
-    like(
-        $out,
-        qr{^Content-Type: text/html; charset=utf8\r\n\r\n}m,
-        'HTTP headers'
-    );
-    like(
-        $out,
-        qr{<title>eduGAIN Access Check</title>},
-        'page title'
-    );
-    like(
-        $out,
-        qr{Error:[\n\s]+missing parameter 'entityid'},
-        'page content contains expected error message'
-    );
-    is($err, '', 'empty stderr');
+named_subtest "SP selection page" => sub {
+    my $t = get_test_object(test => $_[0]);
+
+    $t->get_ok('/step1')
+      ->status_is(200)
+      ->text_is('html head title' => 'eduGAIN Access Check', 'expected title')
+      ->element_exists('select[id=edugain][name=edugain]', 'SP list');
+
+    my $res = $t->tx()->res();
+    html_ok($res) or diag_file($res, $test_dir);
 };
 
-subtest "email selection page, invalid entityid parameter" => sub {
-
-    plan tests => 4;
-
-    local $ENV{REQUEST_METHOD} = 'GET';
-    local $ENV{QUERY_STRING}   = 'action=select_email&federation=edugain&entityid=foo';
-
-    my ($out, $err, $rc) = run_executable('access-check-manager.cgi');
-    like(
-        $out,
-        qr{^Content-Type: text/html; charset=utf8\r\n\r\n}m,
-        'HTTP headers'
-    );
-    like(
-        $out,
-        qr{<title>eduGAIN Access Check</title>},
-        'page title'
-    );
-    like(
-        $out,
-        qr{Error:[\n\s]+format_entityid},
-        'page content contains expected error message'
-    );
-    is($err, '', 'empty stderr');
+named_subtest "email selection page, missing entityid parameter" => sub {
+    my $t = get_test_object(test => $_[0]);
+
+    $t->get_ok('/step2' => form => {federation => 'edugain'})
+      ->status_is(200)
+      ->text_is('html head title' => 'eduGAIN Access Check', 'expected title')
+      ->content_like(qr/Error:[\n\s]+missing parameter 'entityid'/, 'expected error message');
+
+    my $res = $t->tx()->res();
+    html_ok($res) or diag_file($res, $test_dir);
 };
 
-sub run_executable {
-    my ($executable, $args) = @_;
+named_subtest "email selection page, invalid entityid parameter" => sub {
+    my $t = get_test_object(test => $_[0]);
 
-    my @args = $args ? split(/\s+/, $args) : ();
-    run(
-        [ $EXECUTABLE_NAME, '-T', '-I', 'lib', '-I', 't', 'bin/' . $executable, @args ],
-        \my ($in, $out, $err)
-    );
-    return ($out, $err, $CHILD_ERROR >> 8);
-}
+    $t->get_ok('/step2' => form => {federation => 'edugain', entityid => 'foo'})
+      ->status_is(200)
+      ->text_is('html head title' => 'eduGAIN Access Check', 'expected title')
+      ->content_like(qr/Error:[\n\s]+format_entityid/, 'expected error message');
+
+    my $res = $t->tx()->res();
+    html_ok($res) or diag_file($res, $test_dir);
+};