view release on metacpan or  search on metacpan

t/server_session_sqlite.t  view on Meta::CPAN

# -*- perl -*-
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.+?)(<br|\n|$)})
		{
			# DBI connect error.
			$_ = $1;
			s/&#39;/'/g;
			plan skip_all => $_;
		}
		# 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;