Commit | Line | Data |
0d5df7d6 |
1 | package DBIx::Class::Storage::Debug::PrettyPrint; |
1dc93d17 |
2 | |
84c65032 |
3 | use strict; |
4 | use warnings; |
5 | |
1dc93d17 |
6 | use base 'DBIx::Class::Storage::Statistics'; |
7 | |
8 | use SQL::Abstract::Tree; |
9 | |
10 | __PACKAGE__->mk_group_accessors( simple => '_sqlat' ); |
a2b743ce |
11 | __PACKAGE__->mk_group_accessors( simple => '_clear_line_str' ); |
12 | __PACKAGE__->mk_group_accessors( simple => '_executing_str' ); |
13 | __PACKAGE__->mk_group_accessors( simple => '_show_progress' ); |
b25246f0 |
14 | __PACKAGE__->mk_group_accessors( simple => '_last_sql' ); |
66c2fcc3 |
15 | __PACKAGE__->mk_group_accessors( simple => 'squash_repeats' ); |
1dc93d17 |
16 | |
17 | sub new { |
0d5df7d6 |
18 | my $class = shift; |
416cdb2e |
19 | my $args = shift; |
1dc93d17 |
20 | |
416cdb2e |
21 | my $clear_line = $args->{clear_line} || "\r\e[J"; |
7c2d702e |
22 | my $executing = $args->{executing} || ( |
23 | eval { require Term::ANSIColor } ? do { |
24 | my $c = \&Term::ANSIColor::color; |
25 | $c->('blink white on_black') . 'EXECUTING...' . $c->('reset'); |
26 | } : 'EXECUTING...' |
27 | ); |
17c25d88 |
28 | my $show_progress = $args->{show_progress}; |
416cdb2e |
29 | |
66c2fcc3 |
30 | my $squash_repeats = $args->{squash_repeats}; |
416cdb2e |
31 | my $sqlat = SQL::Abstract::Tree->new($args); |
0d5df7d6 |
32 | my $self = $class->next::method(@_); |
a2b743ce |
33 | $self->_clear_line_str($clear_line); |
34 | $self->_executing_str($executing); |
35 | $self->_show_progress($show_progress); |
1dc93d17 |
36 | |
66c2fcc3 |
37 | $self->squash_repeats($squash_repeats); |
b25246f0 |
38 | |
0d5df7d6 |
39 | $self->_sqlat($sqlat); |
b25246f0 |
40 | $self->_last_sql(''); |
1dc93d17 |
41 | |
0d5df7d6 |
42 | return $self |
1dc93d17 |
43 | } |
44 | |
31756ef2 |
45 | sub print { |
1dc93d17 |
46 | my $self = shift; |
47 | my $string = shift; |
25d4d820 |
48 | my $bindargs = shift || []; |
84c65032 |
49 | |
416cdb2e |
50 | my ($lw, $lr); |
51 | ($lw, $string, $lr) = $string =~ /^(\s*)(.+?)(\s*)$/s; |
52 | |
f038abc7 |
53 | local $self->_sqlat->{fill_in_placeholders} = 0 if defined $bindargs |
54 | && defined $bindargs->[0] && $bindargs->[0] eq q('__BULK_INSERT__'); |
fab0bed9 |
55 | |
84c65032 |
56 | my $use_placeholders = !!$self->_sqlat->fill_in_placeholders; |
57 | |
58 | # DBIC pre-quotes bindargs |
ec02b310 |
59 | $bindargs = [map { s/^'//; s/'$//; $_ } @{$bindargs}] if $use_placeholders; |
84c65032 |
60 | |
b25246f0 |
61 | my $sqlat = $self->_sqlat; |
62 | my $formatted; |
66c2fcc3 |
63 | if ($self->squash_repeats && $self->_last_sql eq $string) { |
b25246f0 |
64 | my ( $l, $r ) = @{ $sqlat->placeholder_surround }; |
fda8a675 |
65 | $formatted = '... : ' . join(', ', map "$l$_$r", @$bindargs) |
b25246f0 |
66 | } else { |
67 | $self->_last_sql($string); |
fda8a675 |
68 | $formatted = $sqlat->format($string, $bindargs); |
69 | $formatted = "$formatted : " . join ', ', @{$bindargs} |
b25246f0 |
70 | unless $use_placeholders; |
71 | } |
1dc93d17 |
72 | |
416cdb2e |
73 | $self->next::method("$lw$formatted$lr", @_); |
1dc93d17 |
74 | } |
75 | |
84c65032 |
76 | sub query_start { |
77 | my ($self, $string, @bind) = @_; |
78 | |
79 | if(defined $self->callback) { |
80 | $string =~ m/^(\w+)/; |
81 | $self->callback->($1, "$string: ".join(', ', @bind)."\n"); |
82 | return; |
83 | } |
84 | |
416cdb2e |
85 | $string =~ s/\s+$//; |
86 | |
87 | $self->print("$string\n", \@bind); |
88 | |
a2b743ce |
89 | $self->debugfh->print($self->_executing_str) if $self->_show_progress |
416cdb2e |
90 | } |
91 | |
92 | sub query_end { |
a2b743ce |
93 | $_[0]->debugfh->print($_[0]->_clear_line_str) if $_[0]->_show_progress |
84c65032 |
94 | } |
95 | |
1dc93d17 |
96 | 1; |
6b1bf9f8 |
97 | |
98 | =pod |
99 | |
b912ee1e |
100 | =head1 NAME |
101 | |
102 | DBIx::Class::Storage::Debug::PrettyPrint - Pretty Printing DebugObj |
103 | |
6b1bf9f8 |
104 | =head1 SYNOPSIS |
105 | |
2924f8b3 |
106 | DBIC_TRACE_PROFILE=~/dbic.json perl -Ilib ./foo.pl |
6b1bf9f8 |
107 | |
2924f8b3 |
108 | Where dbic.json contains: |
6b1bf9f8 |
109 | |
2924f8b3 |
110 | { |
111 | "profile":"console", |
112 | "show_progress":1, |
113 | "squash_repeats":1 |
114 | } |
115 | |
116 | =head1 METHODS |
6b1bf9f8 |
117 | |
2924f8b3 |
118 | =head2 new |
6b1bf9f8 |
119 | |
0d5df7d6 |
120 | my $pp = DBIx::Class::Storage::Debug::PrettyPrint->new({ |
2924f8b3 |
121 | show_progress => 1, # tries it's best to make it clear that a SQL |
122 | # statement is still running |
123 | executing => '...', # the string that is added to the end of SQL |
124 | # if show_progress is on. You probably don't |
125 | # need to set this |
126 | clear_line => '\r^[[J', # the string used to erase the string added |
127 | # to SQL if show_progress is on. Again, the |
128 | # default is probably good enough. |
129 | |
130 | squash_repeats => 1, # set to true to make repeated SQL queries |
131 | # be ellided and only show the new bind params |
132 | # any other args are passed through directly to SQL::Abstract::Tree |
0d5df7d6 |
133 | }); |
6b1bf9f8 |
134 | |
6b1bf9f8 |
135 | |