1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
# $Id$
use strict;
use lib 't/lib';
use lib 't/lib/both';
use Test::More;
use Test::Exception;
use DodTestUtil;
BEGIN {
DodTestUtil->check_driver;
unless (eval { require Cache::Memory }) {
plan skip_all => 'Tests require Cache::Memory';
}
}
plan tests => 22;
use Recipe;
use Ingredient;
setup_dbs({
global => [ qw( recipes ) ],
cluster1 => [ qw( ingredients ) ],
cluster2 => [ qw( ingredients ) ],
});
$Data::ObjectDriver::PROFILE = 1;
my $recipe = Recipe->new;
$recipe->title('Cake');
$recipe->save;
## test profiling in exception handling blocks: i.e w/ $@ defined
## see https://github.com/aklaswad/data-objectdriver/commit/39ea4f0c90342f1d196670aac2bc04b9d60acfe3
{
## Can get instance of D::OD::Profiler via profiler()
ok( my $profiler = Data::ObjectDriver->profiler );
## But when some error was already set to $@, Can't get instance...
$@ = "beep";
ok( my $one_more_profiler = Data::ObjectDriver->profiler,
"get profiler after exception",
);
}
## disable caching because it makes the test more complicate
## to understand. Indeed inflate and deflate generates additional
## queries difficult to account for
use Data::ObjectDriver::Driver::Cache::Cache;
Data::ObjectDriver::Driver::Cache::Cache->Disabled(1);
my $profiler = Data::ObjectDriver->profiler;
my $stats = $profiler->statistics;
is $stats->{'DBI:total_queries'}, 1;
is $stats->{'DBI:query_insert'}, 1;
my $log = $profiler->query_log;
isa_ok $log, 'ARRAY';
is scalar(@$log), 1;
like $log->[0], qr/^\s*INSERT INTO recipe/;
my $frequent = $profiler->query_frequency;
isa_ok $frequent, 'HASH';
my $sql = (keys %$frequent)[0];
like $sql, qr/^\s*INSERT INTO recipe/;
is $frequent->{$sql}, 1;
Data::ObjectDriver->profiler->reset;
$stats = $profiler->statistics;
is scalar(keys %$stats), 0;
$recipe = Recipe->lookup($recipe->recipe_id);
$stats = $profiler->statistics;
is $stats->{'DBI:total_queries'}, 1;
is $stats->{'DBI:query_select'}, 1;
$recipe->title('Brownies');
$recipe->save;
$stats = $profiler->statistics;
is $stats->{'DBI:total_queries'}, 3;
is $stats->{'DBI:query_select'}, 2;
is $stats->{'DBI:query_update'}, 1;
$recipe->title('Flan');
$recipe->save;
$frequent = $profiler->query_frequency;
is $frequent->{"SELECT 1 FROM recipes WHERE (recipes.recipe_id = ?)"}, 2;
is $profiler->total_queries, 5;
# testing $Data::ObjectDriver::RESTRICT_IO
$recipe = Recipe->new;
$recipe->title('Cookies');
$recipe->save;
# this didn't die, great!
{
local $Data::ObjectDriver::RESTRICT_IO = 1;
dies_ok {
$recipe = Recipe->lookup($recipe->recipe_id);
} 'I/O attempt intercepted in restricted mode';
}
lives_ok {
$recipe = Recipe->lookup($recipe->recipe_id);
} 'I/O succeeded with restriced mode disabled';
SKIP: {
my $simpletable = eval { require Text::SimpleTable };
skip "Text::SimpleTable not installed", 2 unless $simpletable;
like $profiler->report_query_frequency, qr/FROM recipes/;
like $profiler->report_queries_by_type, qr/SELECT/;
};
END {
disconnect_all(qw( Recipe Ingredient ));
teardown_dbs(qw( global cluster1 cluster2 ));
}
|
