#!/usr/bin/perl
use
5.006;
our
%returns
;
my
$dbfile
=
't/50-files/db'
;
unlink
$dbfile
;
use_ok(
'DBI'
);
my
$dbh
=
DBI->
connect
(
"dbi:SQLite:dbname=$dbfile"
,
'none'
,
'none'
,
{
AutoCommit
=> 1 } );
ok(
defined
(
$dbh
),
'Create environment: create database'
);
ok(
$dbh
->
do
(
'CREATE TABLE footab(id INTEGER NOT NULL PRIMARY KEY,bartext VARCHAR(32) NULL)'
),
'Create environment: create table'
);
ok(
$dbh
->
do
(
'INSERT INTO footab(id,bartext) VALUES(1,"123456789xx01234567890")'
),
'Create environment: add data row 1'
);
ok(
$dbh
->
do
(
'INSERT INTO footab(id,bartext) VALUES(2,"1x3x5x7x9xxx1x3x5x7x9x")'
),
'Create environment: add data row 2'
);
ok(
$dbh
->
do
(
'INSERT INTO footab(id,bartext) VALUES(5,"9,8,7,6,5,4,3,2,1,0")'
),
'Create environment: add data row 3'
);
ok(
$dbh
->disconnect,
'Create environment: finish database'
);
use_ok(
'YAWF'
);
use_ok(
'YAWF::Request'
);
$ENV
{REQUEST_METHOD} =
'GET'
;
$ENV
{QUERY_STRING} =
'perl=5&yawf=true'
;
my
$request
= YAWF::Request->new(
domain
=>
'test.foo.bar'
,
uri
=>
'/home.page.html'
,
args_GET
=>
$ENV
{QUERY_STRING},
method
=>
$ENV
{REQUEST_METHOD},
documentroot
=>
't/50-files'
,
error
=>
sub
{
$main::returns
{error} .=
join
(
''
,
@_
) .
"\n"
;
return
1;
},
send_header
=>
sub
{
$main::returns
{header} ||= [];
push
@{
$main::returns
{header} },
join
(
''
,
@_
);
return
1;
},
send_status
=>
sub
{
$main::returns
{status} .=
join
(
''
,
@_
);
return
1;
},
send_body
=>
sub
{
$main::returns
{body} .=
join
(
''
,
@_
);
return
1;
},
);
ok(
defined
(
$request
),
'Create request'
);
is(
ref
(
$request
),
'YAWF::Request'
,
'Request type'
);
is(
$request
->domain,
'test.foo.bar'
,
'Domain'
);
is(
$request
->uri,
'/home.page.html'
,
'Domain'
);
is(
$request
->method,
'GET'
,
'Method'
);
is(
$request
->documentroot,
't/50-files'
,
'Document root'
);
is(
$returns
{error},
undef
,
'Check error'
);
is(
$request
->yawf, YAWF->SINGLETON,
'YAWF Singleton'
);
is( YAWF->SINGLETON, YAWF->SINGLETON->request->yawf,
'YAWF in request'
);
is( YAWF->SINGLETON, YAWF->SINGLETON->reply->yawf,
'YAWF in reply'
);
is(
YAWF->SINGLETON,
YAWF->SINGLETON->reply->data->{yawf},
'YAWF in reply data'
);
my
$config
=
$request
->yawf->config;
is(
ref
(
$config
),
'YAWF::Config'
,
'Config object'
);
is(
$config
->domain,
'www.foo.bar'
,
'config domain'
);
is(
$config
->handlerprefix,
'Test50'
,
'config handler prefix'
);
is(
$config
->template_dir,
't/50-files/templates'
,
'config template dir'
);
ok(
defined
(
$config
->database ),
'config database'
);
is(
$config
->database->{dbi},
'dbi:SQLite:dbname=t/50-files/db'
,
'config database dbi'
);
is(
$config
->database->{database},
$dbfile
,
'config database name'
);
is(
$config
->database->{username},
'none'
,
'config database username'
);
is(
$config
->database->{password},
'none'
,
'config database password'
);
is(
$config
->database->{class},
'Test50::DB'
,
'config database base class'
);
is( YAWF->SINGLETON->reply->data->{yawf}->config->domain,
'www.foo.bar'
,
'domain reply data'
);
is(
$request
->run, 200,
'Process the request'
);
my
$expected_body
=
<<_EOT_;
(testdata=1)
(domain=www.foo.bar)
(footab=1:123456789xx01234567890)
(foolist[1]=123456789xx01234567890)
(foolist[2]=1x3x5x7x9xxx1x3x5x7x9x)
(foolist[5]=9,8,7,6,5,4,3,2,1,0)
_EOT_
is(
$returns
{error},
undef
,
'errors'
);
is(
$returns
{body},
$expected_body
,
'body'
);