#!/usr/bin/perl -w
my
$file
= File::Spec->catfile(getcwd(),
'testmodel.db'
);
my
$model
= WWW::Suffit::AuthDB::Model->new(
qq{sqlite://$file?RaiseError=0&PrintError=0&sqlite_unicode=1}
);
ok(!
$model
->error,
"Create model instance"
) or diag(
$model
->error);
$model
->
connect
->initialize;
ok(!
$model
->error,
"Initialize schema"
) or diag
$model
->error;
ok(
$model
->is_initialized,
"Schema is initialized"
);
unless
(
$model
->ping) {
fail
sprintf
(
qq{Can't connect to database "%s"}
,
$model
->dsn);
diag
$model
->error;
goto
DONE;
}
subtest
'Meta CRUD'
=>
sub
{
{
my
%data
=
$model
->meta_get(
"schema.version"
);
ok(!
$model
->error,
"Get `schema.version` from meta"
) or diag
$model
->error;
ok(
$data
{value},
"Key `schema.version` is true"
);
}
{
ok(
$model
->meta_set(
key
=>
"foo"
,
value
=>
"test"
,
),
"Add the foo key to meta"
) or diag(
$model
->error);
}
{
ok(
$model
->meta_set(
key
=>
"bar"
,
value
=>
"123"
,
),
"Add the bar key to meta"
) or diag(
$model
->error);
}
{
ok(
$model
->meta_set(
key
=>
"foo"
,
value
=>
"test2"
,
),
"Update the foo key in meta"
) or diag(
$model
->error);
}
{
my
%data
=
$model
->meta_get(
"foo"
);
ok(!
$model
->error,
"Get foo from meta"
) or diag
$model
->error;
is(
$data
{value},
"test2"
,
"Get the `foo` key from meta"
);
}
{
my
@data
=
$model
->meta_get;
ok(!
$model
->error,
"Get whole meta data"
) or diag
$model
->error;
ok(
scalar
(
@data
),
"Data found"
);
}
{
ok(
$model
->meta_del(
"foo"
),
"Delete the `foo` key from meta"
) or diag
$model
->error;
}
};
subtest
'Stat CRUD'
=>
sub
{
{
ok(
$model
->stat_set(
address
=>
'127.0.0.1'
,
username
=>
'bob'
,
dismiss
=> 1,
updated
=>
time
,
),
"Add stat info"
) or diag(
$model
->error);
}
{
ok(
$model
->stat_set(
address
=>
'127.0.0.1'
,
username
=>
'bob'
,
dismiss
=> 2,
updated
=>
time
,
),
"Set stat info"
) or diag(
$model
->error);
}
{
my
%data
=
$model
->stat_get(
'127.0.0.1'
,
'bob'
);
ok(!
$model
->error,
"Get stat info"
) or diag
$model
->error;
is(
$data
{dismiss},
"2"
,
"Get the `dismiss` attribute from `stat` data"
);
}
};
subtest
'User CRUD'
=>
sub
{
{
ok(
$model
->user_add(
username
=>
"admin"
,
name
=>
"Administrator"
,
email
=>
'root@localhost'
,
password
=>
"8c6976e5b5410415bde908bd4dee15dfb167a9c873fc4bb8a81f6f2ab448a918"
,
algorithm
=>
"SHA256"
,
role
=>
"System administrator"
,
flags
=> 0,
created
=>
time
(),
not_before
=>
time
(),
not_after
=>
undef
,
public_key
=>
""
,
private_key
=>
""
,
attributes
=>
qq/{"disabled": 0}/
,
comment
=>
"This user added by default"
,
),
"Add new user"
) or diag
$model
->error;
}
{
my
%data
=
$model
->user_get(
"admin"
);
ok(!
$model
->error,
"Get user's data"
) or diag
$model
->error;
}
{
ok(
$model
->user_set(
username
=>
"admin"
,
name
=>
"Administrator"
,
email
=>
'root@localhost'
,
password
=>
"8c6976e5b5410415bde908bd4dee15dfb167a9c873fc4bb8a81f6f2ab448a918"
,
algorithm
=>
"SHA256"
,
role
=>
"System administrator"
,
flags
=> 0,
not_before
=>
time
(),
not_after
=>
undef
,
public_key
=>
""
,
private_key
=>
""
,
attributes
=>
qq/{"disabled": 0}/
,
comment
=>
"This user was modified"
,
),
"Set user's data"
) or diag
$model
->error;
}
{
my
@all
=
$model
->user_getall();
ok(
scalar
(
@all
),
"Get all users"
) or diag
$model
->error;
}
};
subtest
'Group CRUD'
=>
sub
{
{
ok(
$model
->group_add(
groupname
=>
"wheel"
,
description
=>
"This group added by default"
,
),
"Add new group"
) or diag
$model
->error;
}
{
my
%data
=
$model
->group_get(
"wheel"
);
ok(!
$model
->error,
"Get group's data"
) or diag
$model
->error;
}
{
ok(
$model
->group_set(
groupname
=>
"wheel"
,
description
=>
"This group was modified"
,
),
"Set group's data"
) or diag
$model
->error;
}
{
my
@all
=
$model
->group_getall();
ok(
scalar
(
@all
),
"Get all groups"
) or diag
$model
->error;
}
{
ok(
$model
->grpusr_add(
groupname
=>
"wheel"
,
username
=>
"root"
,
),
"Add the user to the group"
) or diag(
$model
->error);
}
{
my
@data
=
$model
->grpusr_get(
groupname
=>
"wheel"
);
ok(!
$model
->error,
"Get members of group"
) or diag
$model
->error;
}
};
subtest
'Realm CRUD'
=>
sub
{
{
ok(
$model
->realm_add(
realmname
=>
"root"
,
method
=>
"GET"
,
realm
=>
"/"
,
description
=>
"Index page"
,
),
"Add new realm"
) or diag
$model
->error;
}
{
my
%data
=
$model
->realm_get(
"root"
);
ok(!
$model
->error,
"Get realm's data"
) or diag
$model
->error;
}
{
ok(
$model
->realm_set(
realmname
=>
"root"
,
method
=>
"GET"
,
realm
=>
"/"
,
description
=>
"Index page (was modified)"
,
),
"Set realm's data"
) or diag
$model
->error;
}
{
my
@all
=
$model
->realm_getall();
ok(
scalar
(
@all
),
"Get all realms"
) or diag
$model
->error;
}
{
ok(
$model
->realm_requirement_add(
realmname
=>
"root"
,
provider
=>
"user"
,
entity
=>
"admin"
,
),
"Add new requirement"
) or diag
$model
->error;
}
{
my
@data
=
$model
->realm_requirements(
"root"
);
ok(!
$model
->error,
"Get requirement's data"
) or diag
$model
->error;
}
};
subtest
'Delete entities'
=>
sub
{
{
ok(
$model
->realm_del(
"root"
),
"Delete realm"
) or diag
$model
->error;
}
{
ok(
$model
->realm_requirement_del(
"root"
),
"Delete all requirements"
) or diag
$model
->error;
}
{
ok(
$model
->grpusr_del(
groupname
=>
"wheel"
),
"Delete all members of group"
) or diag
$model
->error;
}
{
ok(
$model
->group_del(
"wheel"
),
"Delete group"
) or diag
$model
->error;
}
{
ok(
$model
->user_del(
"admin"
),
"Delete user"
) or diag
$model
->error;
}
};
undef
$model
;
DONE: done_testing;