Commit | Line | Data |
4c248161 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use Test::More; |
6 | |
a2287768 |
7 | plan tests => 12; |
4c248161 |
8 | |
9 | use lib qw(t/lib); |
10 | |
11 | use_ok('DBICTest'); |
c216324a |
12 | my $schema = DBICTest->init_schema(); |
4c248161 |
13 | |
14 | my $cbworks = 0; |
15 | |
c216324a |
16 | $schema->storage->debugcb(sub { $cbworks = 1; }); |
17 | $schema->storage->debug(0); |
18 | my $rs = $schema->resultset('CD')->search({}); |
4c248161 |
19 | $rs->count(); |
20 | ok(!$cbworks, 'Callback not called with debug disabled'); |
21 | |
c216324a |
22 | $schema->storage->debug(1); |
4c248161 |
23 | |
24 | $rs->count(); |
25 | ok($cbworks, 'Debug callback worked.'); |
26 | |
27 | my $prof = new DBIx::Test::Profiler(); |
c216324a |
28 | $schema->storage->debugobj($prof); |
4c248161 |
29 | |
30 | # Test non-transaction calls. |
31 | $rs->count(); |
32 | ok($prof->{'query_start'}, 'query_start called'); |
33 | ok($prof->{'query_end'}, 'query_end called'); |
34 | ok(!$prof->{'txn_begin'}, 'txn_begin not called'); |
35 | ok(!$prof->{'txn_commit'}, 'txn_commit not called'); |
36 | |
37 | $prof->reset(); |
38 | |
39 | # Test transaction calls |
c216324a |
40 | $schema->txn_begin(); |
4c248161 |
41 | ok($prof->{'txn_begin'}, 'txn_begin called'); |
42 | |
c216324a |
43 | $rs = $schema->resultset('CD')->search({}); |
4c248161 |
44 | $rs->count(); |
45 | ok($prof->{'query_start'}, 'query_start called'); |
46 | ok($prof->{'query_end'}, 'query_end called'); |
47 | |
c216324a |
48 | $schema->txn_commit(); |
4c248161 |
49 | ok($prof->{'txn_commit'}, 'txn_commit called'); |
50 | |
51 | $prof->reset(); |
52 | |
53 | # Test a rollback |
c216324a |
54 | $schema->txn_begin(); |
55 | $rs = $schema->resultset('CD')->search({}); |
4c248161 |
56 | $rs->count(); |
c216324a |
57 | $schema->txn_rollback(); |
4c248161 |
58 | ok($prof->{'txn_rollback'}, 'txn_rollback called'); |
59 | |
c216324a |
60 | $schema->storage->debug(0); |
4c248161 |
61 | |
62 | package DBIx::Test::Profiler; |
63 | use strict; |
64 | |
65 | sub new { |
66 | my $self = bless({}); |
67 | } |
68 | |
69 | sub query_start { |
70 | my $self = shift(); |
71 | $self->{'query_start'} = 1; |
72 | } |
73 | |
74 | sub query_end { |
75 | my $self = shift(); |
76 | $self->{'query_end'} = 1; |
77 | } |
78 | |
79 | sub txn_begin { |
80 | my $self = shift(); |
81 | $self->{'txn_begin'} = 1; |
82 | } |
83 | |
84 | sub txn_rollback { |
85 | my $self = shift(); |
86 | $self->{'txn_rollback'} = 1; |
87 | } |
88 | |
89 | sub txn_commit { |
90 | my $self = shift(); |
91 | $self->{'txn_commit'} = 1; |
92 | } |
93 | |
94 | sub reset { |
95 | my $self = shift(); |
96 | |
97 | $self->{'query_start'} = 0; |
98 | $self->{'query_end'} = 0; |
99 | $self->{'txn_begin'} = 0; |
100 | $self->{'txn_rollback'} = 0; |
101 | $self->{'txn_end'} = 0; |
102 | } |
103 | |
104 | 1; |