1 package DBIx::Class::Storage::Debug::PrettyPrint;
6 use base 'DBIx::Class::Storage::Statistics';
8 use SQL::Abstract::Tree;
10 __PACKAGE__->mk_group_accessors( simple => '_sqlat' );
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' );
14 __PACKAGE__->mk_group_accessors( simple => '_last_sql' );
15 __PACKAGE__->mk_group_accessors( simple => 'squash_repeats' );
21 my $clear_line = $args->{clear_line} || "\r
\e[J";
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');
28 my $show_progress = $args->{show_progress};
30 my $squash_repeats = $args->{squash_repeats};
31 my $sqlat = SQL::Abstract::Tree->new($args);
32 my $self = $class->next::method(@_);
33 $self->_clear_line_str($clear_line);
34 $self->_executing_str($executing);
35 $self->_show_progress($show_progress);
37 $self->squash_repeats($squash_repeats);
39 $self->_sqlat($sqlat);
48 my $bindargs = shift || [];
51 ($lw, $string, $lr) = $string =~ /^(\s*)(.+?)(\s*)$/s;
53 local $self->_sqlat->{fill_in_placeholders} = 0 if defined $bindargs
54 && defined $bindargs->[0] && $bindargs->[0] eq q('__BULK_INSERT__');
56 my $use_placeholders = !!$self->_sqlat->fill_in_placeholders;
58 # DBIC pre-quotes bindargs
59 $bindargs = [map { s/^'//; s/'$//; $_ } @{$bindargs}] if $use_placeholders;
61 my $sqlat = $self->_sqlat;
63 if ($self->squash_repeats && $self->_last_sql eq $string) {
64 my ( $l, $r ) = @{ $sqlat->placeholder_surround };
65 $formatted = '... : ' . join(', ', map "$l$_$r", @$bindargs)
67 $self->_last_sql($string);
68 $formatted = $sqlat->format($string, $bindargs);
69 $formatted = "$formatted : " . join ', ', @{$bindargs}
70 unless $use_placeholders;
73 $self->next::method("$lw$formatted$lr", @_);
77 my ($self, $string, @bind) = @_;
79 if(defined $self->callback) {
81 $self->callback->($1, "$string: ".join(', ', @bind)."\n");
87 $self->print("$string\n", \@bind);
89 $self->debugfh->print($self->_executing_str) if $self->_show_progress
93 $_[0]->debugfh->print($_[0]->_clear_line_str) if $_[0]->_show_progress
102 DBIx::Class::Storage::Debug::PrettyPrint - Pretty Printing DebugObj
106 DBIC_TRACE_PROFILE=~/dbic.json perl -Ilib ./foo.pl
108 Where dbic.json contains:
120 my $pp = DBIx::Class::Storage::Debug::PrettyPrint->new({
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
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.
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