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