use strict;
use warnings;
use Test::More;
use Test::Exception;
use Config;
use Data::Dumper;
use lib '.';
use t::test_server;
&setup;
plan tests => 20;
&test_01_basic; #8.
&test_02_info; #1.
&test_03_form; #9.
&teardown; #1.
# -----------------------------------------------------------------------------
# shortcut.
#
sub check_requires() { &t::test_server::check_requires; }
sub start_server() { &t::test_server::start_server; }
sub request_get(@) { &t::test_server::request_get; }
sub rget($)
{
request_get(
script => shift,
db => 'DB',
session => 'Session',
);
}
# -----------------------------------------------------------------------------
# setup.
#
sub setup
{
my $failmsg = check_requires();
if( $failmsg )
{
plan skip_all => $failmsg;
}
eval{ require DBD::SQLite; };
$@ and plan skip_all => "no DBD::SQLite";
diag "DBD::SQLite ".DBD::SQLite->VERSION;
&start_server;
# ini.
my ($name) = getpwuid($<);
my $ini = {
DB => {
type => 'sqlite',
defaultset => 'SET_Default',
SET_Default => 'DBRW1',
},
DBRW1 => {
host => $ENV{TEST_DBHOST} || 'localhost',
dbname => $ENV{TEST_DBNAME} || 'test.session.sqlite',
user => $ENV{TEST_DBUSER} || $name,
password => $ENV{TEST_DBPASS},
},
Session => {
mode => 'http',
dbgroup => 'DB',
dbset => 'SET_Default',
sessiontable => 'TripletaiL_Session_Test',
csrfkey => 'TripletaiL_Key',
},
};
t::test_server::add_cleanup(sub{
unlink('test.session.sqlite');
});
# check db connection.
my $ver = eval
{
request_get(
ini => $ini,
db => 'DB',
session => 'Session',
script => q{ $TL->getDB()->selectRowArray('SELECT sqlite_version()'); },
);
};
if( $@ )
{
if( $@ =~ m{(DBI connect.+?)(
$_;
}
# other error?
plan skip_all => "request failure: $@";
}
$ver &&= $ver->[0];
diag("SQLite $ver");
}
# -----------------------------------------------------------------------------
# basic.
#
sub test_01_basic
{
ok( rget q{ $TL->getSession; }, '[basic] getsession');
ok( rget q{
my $s = $TL->getSession;
not $s->isHttps;
} => '[basic] not isHttps');
# セッションキーの取得.
ok( rget q{
my $s = $TL->getSession;
my $first = $s->get;
my $next = $s->get;
$first eq $next;
} => '[basic] session-id is persistent');
ok( rget q{
my $s = $TL->getSession;
my $old = $s->get;
my $new = $s->renew;
$old ne $new;
} => '[basic] renew session-id');
ok( rget q{
my $s = $TL->getSession;
my $old = $s->get;
$s->discard;
my $new = $s->get;
$old ne $new;
} => '[basic] discard session-id');
ok( rget q{
my $s = $TL->getSession;
not defined $s->getValue;
}, '[basic] session value is initialized by undef');
is( rget q{
my $s = $TL->getSession;
$s->setValue('666');
$s->getValue;
}, '666', '[basic] set and get value');
is( rget q{
my $s = $TL->getSession;
$s->getValue;
}, '666', '[basic] session value is persistent');
}
# -----------------------------------------------------------------------------
# info.
#
sub test_02_info
{
ok( rget q{
my $s = $TL->getSession;
[$s->getSessionInfo];
} => '[info] getSessionInfo');
}
# -----------------------------------------------------------------------------
# form.
#
sub test_03_form
{
ok( rget q{
my $t = $TL->newTemplate->setTemplate(q{