Skip to content

Commit a8575c7

Browse files
committed
module for DBMS unit testing #1
1 parent fa48ff3 commit a8575c7

File tree

2 files changed

+612
-0
lines changed

2 files changed

+612
-0
lines changed

lib/CellBIS/SQL/Abstract/Test.pm

Lines changed: 380 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,380 @@
1+
package CellBIS::SQL::Abstract::Test;
2+
use Mojo::Base -base;
3+
4+
use Carp 'croak';
5+
use Mojo::Loader 'load_class';
6+
use Mojo::Util qw(dumper);
7+
use Mojo::Home;
8+
use CellBIS::SQL::Abstract;
9+
use CellBIS::SQL::Abstract::Test::Table;
10+
11+
has 'dsn';
12+
has 'via';
13+
has 'backend';
14+
has 'table';
15+
16+
# internal purpose
17+
has 'abstract';
18+
has 'dir';
19+
has home => sub {
20+
state $home = Mojo::Home->new;
21+
};
22+
has table_info => sub {
23+
state $table = CellBIS::SQL::Abstract::Test::Table->new;
24+
};
25+
26+
sub create_table {
27+
my $self = shift;
28+
29+
my $result = {result => 0, code => 400};
30+
my $dbtype = $self->via;
31+
my $table = $self->table;
32+
33+
my @table_info = $self->table_info->$table->$dbtype;
34+
my $q = $self->abstract->create_table(@table_info);
35+
if (my $dbh = $self->backend->db->query($q)) {
36+
$result->{result} = $dbh->rows;
37+
$result->{code} = 200;
38+
}
39+
return $result;
40+
}
41+
42+
sub create_table_with_fk {
43+
my $self = shift;
44+
45+
my ($result, $dbtype, $table_users, $table_roles, @table_info, $table, $q);
46+
$result = {result => 0, code => 400};
47+
$dbtype = $self->via;
48+
$table = $self->table;
49+
$table_users = $self->table_info->users;
50+
$table_roles = $self->table_info->roles;
51+
52+
# table construction
53+
@table_info = $self->table_info->$table->$dbtype;
54+
push @table_info,
55+
{
56+
fk => {
57+
name => 'users_roles_id',
58+
col_name => $table_users->id_roles,
59+
table_target => $table_roles->table_name,
60+
col_target => $table_roles->id,
61+
attr => {onupdate => 'cascade', ondelete => 'cascade'}
62+
}
63+
};
64+
$q = $self->abstract->create_table(@table_info);
65+
if (my $dbh = $self->backend->db->query($q)) {
66+
$result->{result} = $dbh->rows;
67+
$result->{code} = 200;
68+
}
69+
return $result;
70+
}
71+
72+
sub check_table {
73+
my $self = shift;
74+
75+
my ($result, $dbtype, $table_info, $table, @pre_q, $q);
76+
$result = {result => 0, code => 400};
77+
$dbtype = $self->via;
78+
$table = $self->table;
79+
$table_info = $self->table_info->$table;
80+
81+
@pre_q = (
82+
'sqlite_master',
83+
['name'],
84+
{
85+
where => 'type=\'table\' AND tbl_name=\''
86+
. $table_info->table_name . '\''
87+
}
88+
) if $dbtype eq 'sqlite';
89+
@pre_q = (
90+
'information_schema.tables', ['table_name'],
91+
{where => 'table_name=\'' . $table_info->table_name . '\''}
92+
) if $dbtype eq 'mariadb';
93+
@pre_q = (
94+
'information_schema.tables',
95+
['table_name'],
96+
{
97+
where =>
98+
'table_type=\'BASE TABLE\' AND table_schema=\'public\' AND table_name=\''
99+
. $table_info->table_name . '\''
100+
}
101+
) if $dbtype eq 'pg';
102+
103+
$q = $self->abstract->select(@pre_q);
104+
if (my $dbh = $self->backend->db->query($q)) {
105+
$result->{result} = $dbh->hash;
106+
$result->{code} = 200;
107+
}
108+
return $result;
109+
}
110+
111+
sub empty_table {
112+
my $self = shift;
113+
114+
my ($result, $dbtype, $table, $table_info);
115+
$dbtype = $self->via;
116+
$table = $self->table;
117+
$table_info = $self->table_info->$table;
118+
$result = {result => 0, code => 500};
119+
120+
if (my $dbh
121+
= $self->backend->db->query('DELETE FROM ' . $table_info->table_name))
122+
{
123+
$result->{result} = $dbh->rows;
124+
$result->{code} = 200;
125+
}
126+
return $result;
127+
}
128+
129+
sub drop_table {
130+
my $self = shift;
131+
132+
my ($result, $dbtype, $table, $table_info);
133+
$dbtype = $self->via;
134+
$table = $self->table;
135+
$table_info = $self->table_info->$table;
136+
$result = {result => 0, code => 500};
137+
138+
if (
139+
my $dbh = $self->backend->db->query(
140+
'DROP TABLE IF EXISTS ' . $table_info->table_name
141+
)
142+
)
143+
{
144+
$result->{result} = $dbh->rows;
145+
$result->{code} = 200;
146+
}
147+
return $result;
148+
}
149+
150+
sub create {
151+
my $self = shift;
152+
153+
my ($result, $dbtype, $table, $table_info);
154+
$dbtype = $self->via;
155+
$table = $self->table;
156+
$table_info = $self->table_info->$table;
157+
158+
# return if table is not exist.
159+
$result = {result => 0, code => 500};
160+
return $result unless $self->check_table->{result};
161+
162+
$result = {result => 0, code => 400};
163+
my $q = $self->abstract->insert();
164+
if (my $dbh = $self->backend->db->query($q)) {
165+
$result->{result} = $dbh->rows;
166+
$result->{code} = 200;
167+
}
168+
return $result;
169+
}
170+
171+
sub change_dbms {
172+
my ($self, $dbms) = @_;
173+
174+
$dbms //= 'sqlite';
175+
$self->{via} = $dbms;
176+
$self->abstract(CellBIS::SQL::Abstract->new(db_type => $self->via));
177+
my $backend = 'Mojo::mysql' if $self->via eq 'mariadb';
178+
$backend = 'Mojo::Pg' if $self->via eq 'pg';
179+
$backend = 'Mojo::SQLite' if $self->via eq 'sqlite';
180+
181+
# dsn attribute alert
182+
croak 'dsn attribute must be defined'
183+
if ($self->via ne 'sqlite' && $self->dsn =~ /^sqlite\:/);
184+
185+
# Only for SQLite
186+
if ($self->via eq 'sqlite') {
187+
$self->dir($self->home->child(qw(t db)));
188+
$self->dsn('sqlite:' . $self->dir . '/csa_test.db');
189+
}
190+
191+
my $load = load_class $backend;
192+
croak ref $load ? $load : qq{Backend "$backend" missing} if $load;
193+
$self->backend($backend->new($self->dsn));
194+
195+
return $self;
196+
}
197+
198+
sub new {
199+
my $self = shift->SUPER::new(@_);
200+
201+
my ($backend);
202+
$self->{via} //= 'sqlite';
203+
204+
$self->abstract(CellBIS::SQL::Abstract->new(db_type => $self->via));
205+
$backend = 'Mojo::mysql' if $self->via eq 'mariadb';
206+
$backend = 'Mojo::Pg' if $self->via eq 'pg';
207+
$backend = 'Mojo::SQLite' if $self->via eq 'sqlite';
208+
209+
# Only for SQLite
210+
if ($self->via eq 'sqlite') {
211+
$self->dir($self->home->child(qw(t db)));
212+
$self->dsn('sqlite:' . $self->dir . '/csa_test.db');
213+
}
214+
215+
# Load Class for backend database type
216+
my $load = load_class $backend;
217+
croak ref $load ? $load : qq{Backend "$backend" missing} if $load;
218+
$self->backend($backend->new($self->dsn));
219+
220+
return $self;
221+
}
222+
1;
223+
224+
=encoding utf8
225+
226+
=head1 NAME
227+
228+
CellBIS::SQL::Abstract::Test - A part of Unit Testing
229+
230+
=head1 SYNOPSIS
231+
232+
use CellBIS::SQL::Abstract::Test;
233+
234+
# Initialization for SQLite
235+
my $test = CellBIS::SQL::Abstract::Test->new(table => 'users');
236+
unless (-d $test->dir) { mkdir $test->dir }
237+
238+
$backend = $test->backend;
239+
$db = $backend->db;
240+
ok $db->ping, 'connected';
241+
242+
# Initialization for MariaDB
243+
my $test = CellBIS::SQL::Abstract::Test->new(
244+
table => 'users',
245+
via => 'mariadb',
246+
dsn => 'mariadb://myuser:mypass@localhost:3306/mydbtest'
247+
);
248+
$backend = $test->backend;
249+
$db = $backend->db;
250+
ok $db->ping, 'connected';
251+
252+
# Initialization for PostgreSQL
253+
my $test = CellBIS::SQL::Abstract::Test->new(
254+
table => 'users',
255+
via => 'pg',
256+
dsn => 'posgresql://myuser:mypass@localhost:5432/mydbtest'
257+
);
258+
$backend = $test->backend;
259+
$db = $backend->db;
260+
ok $db->ping, 'connected';
261+
262+
=head1 DESCRIPTION
263+
264+
This module is only a test instrument in SQLite, Mariadb, and PostgreSQL
265+
266+
=head1 ATTRIBUTES
267+
268+
L<CellBIS::SQL::Abstract::Test> implements the following attributes.
269+
270+
=head2 table
271+
272+
my $test = CellBIS::SQL::Abstract::Test->new(
273+
...
274+
table => 'users',
275+
...
276+
);
277+
278+
$test->table('users'); # to defined table
279+
$test->table; # to use get table
280+
281+
Information of table form L<CellBIS::SQL::Abstract::Test::Table>
282+
283+
=head2 via and dsn
284+
285+
# initialization for mariadb
286+
my $test = CellBIS::SQL::Abstract::Test->new(
287+
...
288+
via => 'mariadb',
289+
dsn => 'mariadb://myuser:mypass@localhost:3306/mydbtest',
290+
...
291+
);
292+
293+
# initialization for postgresql
294+
my $test = CellBIS::SQL::Abstract::Test->new(
295+
...
296+
via => 'pg',
297+
dsn => 'posgresql://myuser:mypass@localhost:3306/mydbtest',
298+
...
299+
);
300+
301+
# switch to mariadb
302+
$test->dsn('mariadb://myuser:mypass@localhost:3306/mydbtest');
303+
304+
# switch to postgresql
305+
$test->dsn('posgresql://myuser:mypass@localhost:5432/mydbtest');
306+
307+
C<dsn> attribute must be defined together with C<via> attribute when
308+
initializing mariadb or postgresql. However, when initializing using
309+
sqlite, you don't need to use the C<via> and C<dsn> (Data Source Name)
310+
attributes.
311+
312+
=head2 backend
313+
314+
$test->backend;
315+
$test->backend(Mojo::SQLite->new);
316+
$test->backend(Mojo::mysq->new);
317+
$test->backend(Mojo::Pg->new);
318+
319+
C<backend> attribute only for initializing L<Mojo::SQLite>, L<Mojo::mysql>,
320+
and L<Mojo::Pg>.
321+
322+
=head1 METHODS
323+
324+
L<CellBIS::SQL::Abstract::Test> implements the following new ones
325+
326+
=head2 change_dbms
327+
328+
This method for change dbms from one to the other. For example from
329+
sqlite to mariadb or from mariadb to sqlite and vice versa.
330+
331+
# switch to mariadb
332+
$test->dsn('mariadb://myuser:mypass@localhost:3306/mydbtest');
333+
$test->change_dbms('mariadb');
334+
335+
# switch to postgresql
336+
$test->dsn('postgresql://myuser:mypass@localhost:5432/mydbtest');
337+
$test->change_dbms('pg');
338+
339+
# switch back to sqlite
340+
$test->change_dbms('sqlite');
341+
unless (-d $test->dir) { mkdir $test->dir }
342+
343+
=head2 methods for tables query
344+
345+
The method here is to query tables, such as check, create, empty, and drop tables.
346+
347+
$test->check_table;
348+
$test->create_table;
349+
$test->create_table_with_fk;
350+
$test->empty_table;
351+
$test->drop_table;
352+
353+
# if use key hashref 'result'
354+
$test->check_table->{result};
355+
$test->create_table->{result};
356+
$test->create_table_with_fk->{result};
357+
$test->empty_table->{result};
358+
$test->drop_table->{result};
359+
360+
# if use key hashref 'code'
361+
$test->check_table->{code};
362+
$test->create_table->{code};
363+
$test->create_table_with_fk->{code};
364+
$test->empty_table->{code};
365+
$test->drop_table->{code};
366+
367+
The output of this method is a hashref and contains key C<result> and C<code>.
368+
369+
=head1 AUTHOR
370+
371+
Achmad Yusri Afandi, C<[email protected]>
372+
373+
=head1 COPYRIGHT AND LICENSE
374+
375+
Copyright (C) 2021 by Achmad Yusri Afandi
376+
377+
This program is free software, you can redistribute it and/or modify
378+
it under the terms of the Artistic License version 2.0.
379+
380+
=cut

0 commit comments

Comments
 (0)