Fix building on perls with no . in @INC
[dbsrgits/DBIx-Class.git] / t / lib / DBICTest / SQLTracerObj.pm
1 package # moar hide
2   DBICTest::SQLTracerObj;
3
4 use strict;
5 use warnings;
6
7 use base 'DBIx::Class::Storage::Statistics';
8
9 sub query_start {
10   my ($self, $sql, $bind) = @_;
11
12   my $op = ($sql =~ /^\s*(\S+)/)[0];
13
14   $sql =~ s/^ \s* \Q$op\E \s+ \[ .+? \]/$op/x
15     if $ENV{DBICTEST_VIA_REPLICATED};
16
17   push @{$self->{sqlbinds}}, [ $op, [ $sql, @{ $bind || [] } ] ];
18 }
19
20 # who the hell came up with this API >:(
21 for my $txn (qw(begin rollback commit)) {
22   no strict 'refs';
23   *{"txn_$txn"} = sub { push @{$_[0]{sqlbinds}}, [ uc $txn => [ uc $txn ] ] };
24 }
25
26 sub svp_begin { push @{$_[0]{sqlbinds}}, [ SAVEPOINT => [ "SAVEPOINT $_[1]" ] ] }
27 sub svp_release { push @{$_[0]{sqlbinds}}, [ RELEASE_SAVEPOINT => [ "RELEASE $_[1]" ] ] }
28 sub svp_rollback { push @{$_[0]{sqlbinds}}, [ ROLLBACK_TO_SAVEPOINT => [ "ROLLBACK TO $_[1]" ] ] }
29
30 1;