Added startup checks to warn loudly if we appear to be running on RedHat systems...
[dbsrgits/DBIx-Class.git] / t / 31stats.t
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' )
11         : ( tests => 12 );
12 }
13
14 use lib qw(t/lib);
15
16 use_ok('DBICTest');
17 my $schema = DBICTest->init_schema();
18
19 my $cbworks = 0;
20
21 $schema->storage->debugcb(sub { $cbworks = 1; });
22 $schema->storage->debug(0);
23 my $rs = $schema->resultset('CD')->search({});
24 $rs->count();
25 ok(!$cbworks, 'Callback not called with debug disabled');
26
27 $schema->storage->debug(1);
28
29 $rs->count();
30 ok($cbworks, 'Debug callback worked.');
31
32 my $prof = new DBIx::Test::Profiler();
33 $schema->storage->debugobj($prof);
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
45 $schema->txn_begin();
46 ok($prof->{'txn_begin'}, 'txn_begin called');
47
48 $rs = $schema->resultset('CD')->search({});
49 $rs->count();
50 ok($prof->{'query_start'}, 'query_start called');
51 ok($prof->{'query_end'}, 'query_end called');
52
53 $schema->txn_commit();
54 ok($prof->{'txn_commit'}, 'txn_commit called');
55
56 $prof->reset();
57
58 # Test a rollback
59 $schema->txn_begin();
60 $rs = $schema->resultset('CD')->search({});
61 $rs->count();
62 $schema->txn_rollback();
63 ok($prof->{'txn_rollback'}, 'txn_rollback called');
64
65 $schema->storage->debug(0);
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;