File Coverage

blib/lib/Qudo/Test.pm
Criterion Covered Total %
statement 54 118 45.7
branch 3 34 8.8
condition 0 11 0.0
subroutine 16 27 59.2
pod 0 16 0.0
total 73 206 35.4


line stmt bran cond sub pod time code
1             package Qudo::Test;
2 32     32   19594 use strict;
  32         54  
  32         1307  
3 32     32   250 use warnings;
  32         50  
  32         981  
4 32     32   36169 use lib qw(./lib ./t/lib);
  32         26892  
  32         167  
5 32     32   5494 use Carp qw(croak);
  32         67  
  32         2153  
6 32     32   12449 use Qudo;
  32         94  
  32         395  
7 32     32   31985 use YAML;
  32         436299  
  32         2482  
8 32     32   96691 use DBI;
  32         731807  
  32         2578  
9 32     32   34192 use Test::More;
  32         184  
  32         317  
10              
11             our @SUPPORT_DRIVER = qw/Skinny/;
12              
13             sub import {
14 32     32   337 my $caller = caller(0);
15              
16 32         612 strict->import;
17 32         475 warnings->import;
18              
19 32         79 for my $func (qw/run_tests run_tests_mysql run_tests_sqlite test_master teardown_dbs dsn_for/) {
20 32     32   11907 no strict 'refs'; ## no critic.
  32         65  
  32         57103  
21 192         347 *{$caller.'::'.$func} = \&$func;
  192         2008  
22             }
23             }
24              
25             sub run_tests {
26 12     12 0 171 my ($n, $code) = @_;
27              
28 12         114 plan tests => $n*3*scalar(@SUPPORT_DRIVER);
29              
30 12         6454 for my $driver (@SUPPORT_DRIVER) {
31 12         74 run_tests_mysql( $n, $driver, $code);
32 12         61 run_tests_innodb($n, $driver, $code);
33 12         62 run_tests_sqlite($n, $driver, $code);
34             }
35             }
36              
37             sub run_tests_innodb {
38 12     12 0 36 my ($n, $driver, $code) = @_;
39 12         49 run_tests_mysql($n, $driver, $code, 1);
40             }
41              
42             sub run_tests_mysql {
43 24     24 0 70 my ($n, $driver, $code, $innodb) = @_;
44              
45 24         212 SKIP: {
46 24         68 local $ENV{USE_MYSQL} = 1;
47 24         61 my $dbh = eval { mysql_dbh() }; ## no critic
  24         102  
48 24 50       35360 skip "MySQL not accessible as root on localhost", $n if $@;
49 0 0 0     0 skip "InnoDB not available on localhost's MySQL", $n if $innodb && ! has_innodb($dbh);
50 0         0 $code->($driver);
51             }
52             }
53              
54             sub run_tests_sqlite {
55 12     12 0 36 my ($n, $driver, $code) = @_;
56              
57 12     12   5185 SKIP: {
  0         0  
  0         0  
  12         1020  
58 12         28 my $rv = eval "use DBD::SQLite; 1"; ## no critic
59 12 50       89 $rv = 0 if $ENV{SKIP_SQLITE};
60 12 50       88 skip "SQLite not installed", $n if !$rv;
61 0         0 $code->($driver);
62             }
63             }
64              
65             my $test_dbs;
66             sub test_master {
67 0     0 0 0 my %opts = @_;
68 0   0     0 my $dbs = delete $opts{dbs} || ['default'];
69 0         0 my $init = delete $opts{init};
70 0 0       0 $init = 1 unless defined $init;
71              
72 0         0 $test_dbs = $dbs;
73              
74 0 0       0 if ($init) {
75 0         0 setup_dbs($dbs);
76             }
77              
78 0         0 my $params = +{
79             databases => [
80 0         0 map {{
81             dsn => dsn_for($_),
82             username => 'root',
83             password => '',
84             }} @$dbs
85             ],
86             %opts,
87             };
88              
89 0         0 return Qudo->new(%$params);
90             }
91              
92             sub setup_dbs {
93 0     0 0 0 my $dbs = shift;
94              
95 0         0 my $schema = load_schema();
96 0         0 teardown_dbs($dbs);
97              
98 0         0 for my $db (@$dbs) {
99 0 0       0 if ($ENV{USE_MYSQL}) {
100 0         0 create_mysql_db(mysql_dbname($db));
101             }
102              
103 0 0       0 my $dbh = DBI->connect(
104             dsn_for($db),
105             'root',
106             '',
107             { RaiseError => 1, PrintError => 0 }
108             ) or die "Couldn't connect: $!\n";
109              
110 0 0       0 for my $sql (@{ $ENV{USE_MYSQL} ? $schema->{mysql} : $schema->{SQLite} }) {
  0         0  
111 0         0 $sql =~ s!^\s*create\s+table\s+(\w+)!CREATE TABLE $1!i;
112 0 0       0 $sql .= " ENGINE=INNODB\n" if $ENV{USE_MYSQL};
113 0         0 $dbh->do($sql);
114             }
115              
116 0         0 $dbh->disconnect;
117             }
118             }
119              
120             my $schema_data;
121             sub load_schema {
122 0   0 0 0 0 $schema_data ||= YAML::Load(join "", );
123             }
124              
125             sub load_sql {
126 0     0 0 0 my($file) = @_;
127 0 0       0 open my $fh, '<', $file or die "Can't open $file: $!";
128 0         0 my $sql = do { local $/; <$fh> };
  0         0  
  0         0  
129 0         0 close $fh;
130 0         0 my @sql = split /;\s*/, $sql;
131 0         0 \@sql;
132             }
133              
134             sub mysql_dbh {
135 24 0   24 0 289 return DBI->connect(
136             "DBI:mysql:mysql",
137             "root",
138             "",
139             { RaiseError => 1 }
140             ) or die "Couldn't connect to database";
141             }
142              
143             sub dsn_for {
144 0     0 0   my $dbname = shift;
145 0 0         if ($ENV{USE_MYSQL}) {
146 0           return 'dbi:mysql:' . mysql_dbname($dbname);
147             } else {
148 0           return 'dbi:SQLite:dbname=' . db_filename($dbname);
149             }
150             }
151              
152             sub db_filename {
153 0     0 0   my $dbname = shift;
154 0           'test_qudo_' . $dbname . '.db';
155             }
156              
157             sub mysql_dbname {
158 0     0 0   my $dbname = shift;
159 0           'test_qudo_' . $dbname;
160             }
161              
162             sub create_mysql_db {
163 0     0 0   my $dbname = shift;
164 0           mysql_dbh()->do("CREATE DATABASE $dbname");
165             }
166              
167             sub drop_mysql_db {
168 0     0 0   my $dbname = shift;
169 0           mysql_dbh()->do("DROP DATABASE IF EXISTS $dbname");
170             }
171              
172             sub teardown_dbs {
173 0   0 0 0   my $dbs = shift || $test_dbs;
174              
175 0           for my $db (@$dbs) {
176 0 0         if ($ENV{USE_MYSQL}) {
177 0           drop_mysql_db(mysql_dbname($db));
178             } else {
179 0           my $file = db_filename($db);
180 0 0         return unless -e $file;
181 0 0         unlink $file or die "Can't teardown $db: $!";
182             }
183             }
184             }
185              
186             sub has_innodb {
187 0     0 0   my $dbh = shift;
188 0           my $tmpname = "test_to_see_if_innoavail";
189 0 0         $dbh->do("CREATE TABLE IF NOT EXISTS $tmpname (i int) ENGINE=INNODB")
190             or return 0;
191 0           my @row = $dbh->selectrow_array("SHOW CREATE TABLE $tmpname");
192 0           my $row = join(' ', @row);
193 0           my $has_it = ($row =~ /=InnoDB/i);
194 0           $dbh->do("DROP TABLE $tmpname");
195 0           return $has_it;
196             }
197              
198             1;
199              
200             __DATA__