Commit | Line | Data |
ee356d00 |
1 | package DBIx::Class::Storage::DBI::Replicated::WithDSN; |
2 | |
0bbe6676 |
3 | use Try::Tiny qw(try); |
4 | use Scalar::Util (); |
5 | use Role::Tiny; |
ee356d00 |
6 | requires qw/_query_start/; |
7 | |
ee356d00 |
8 | =head1 NAME |
9 | |
10 | DBIx::Class::Storage::DBI::Replicated::WithDSN - A DBI Storage Role with DSN |
11 | information in trace output |
12 | |
13 | =head1 SYNOPSIS |
14 | |
15 | This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>. |
d4daee7b |
16 | |
ee356d00 |
17 | =head1 DESCRIPTION |
18 | |
19 | This role adds C<DSN: > info to storage debugging output. |
20 | |
21 | =head1 METHODS |
22 | |
23 | This class defines the following methods. |
24 | |
25 | =head2 around: _query_start |
26 | |
27 | Add C<DSN: > to debugging output. |
28 | |
29 | =cut |
30 | |
31 | around '_query_start' => sub { |
32 | my ($method, $self, $sql, @bind) = @_; |
0bd8e058 |
33 | |
9780718f |
34 | my $dsn = (try { $self->dsn }) || $self->_dbi_connect_info->[0]; |
0bd8e058 |
35 | |
cda869a8 |
36 | my($op, $rest) = (($sql=~m/^(\w+)(.+)$/),'NOP', 'NO SQL'); |
1fa4a3e2 |
37 | my $storage_type = $self->can('active') ? 'REPLICANT' : 'MASTER'; |
38 | |
0bd8e058 |
39 | my $query = do { |
0bbe6676 |
40 | if ((Scalar::Util::reftype($dsn)||'') ne 'CODE') { |
0bd8e058 |
41 | "$op [DSN_$storage_type=$dsn]$rest"; |
42 | } |
9780718f |
43 | elsif (my $id = try { $self->id }) { |
ede99b9f |
44 | "$op [$storage_type=$id]$rest"; |
45 | } |
0bd8e058 |
46 | else { |
47 | "$op [$storage_type]$rest"; |
48 | } |
49 | }; |
50 | |
51 | $self->$method($query, @bind); |
ee356d00 |
52 | }; |
53 | |
54 | =head1 ALSO SEE |
55 | |
56 | L<DBIx::Class::Storage::DBI> |
57 | |
58 | =head1 AUTHOR |
59 | |
0bbe6676 |
60 | John Napiorkowski <jjnapiork@cpan.org> |
ee356d00 |
61 | |
62 | =head1 LICENSE |
63 | |
64 | You may distribute this code under the same terms as Perl itself. |
65 | |
66 | =cut |
67 | |
68 | 1; |