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

use strict;
use warnings;

use Test::More import => ["!pass"];

plan skip_all => "Test::TCP required" unless eval {
    require Test::TCP; Test::TCP->import; 1;
};

plan skip_all => "LWP required" unless eval {
    require LWP;
};

test_tcp(
    client => sub {
        my $port = shift;

        require LWP::UserAgent;
        require HTTP::Cookies;

        my $ua = LWP::UserAgent->new;
        my $jar = HTTP::Cookies->new;
        $ua->cookie_jar( $jar );

        my $res = $ua->get("http://127.0.0.1:$port/");
        is $res->content, "login page";

    },
    server => sub {
        my $port = shift;

        use Dancer ':tests', ':syntax';

        set port                => $port;
        set appdir              => '';          # quiet warnings not having an appdir
        set access_log          => 0;           # quiet startup banner

        set session_cookie_key  => "John has a long mustache";
        set session             => "cookie";

        hook before => sub { 
            if ( !session('uid') 
                && request->path_info !~ m{^/login} 
            ) {
                return redirect '/login/';
            }
        };

        get '/logout/?' => sub {
            session 'uid'     => undef;
            session->destroy;
            return redirect '/';
        };

        any '/login/?' => sub {
            return redirect '/' if session('uid');

            return 'ok' if session('login');
            session 'login' => undef;
            return 'login page';
        };

        dance;
    }
);

done_testing;