fix precedence for executing in new
[dbsrgits/SQL-Abstract.git] / lib / DBIx / Class / Storage / Debug / PrettyPrint.pm
1 package DBIx::Class::Storage::Debug::PrettyPrint;
2
3 use strict;
4 use warnings;
5
6 use base 'DBIx::Class::Storage::Statistics';
7
8 use SQL::Abstract::Tree;
9
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' );
16
17 sub new {
18    my $class = shift;
19    my $args  = shift;
20
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');
26       } : 'EXECUTING...'
27    );
28    my $show_progress = $args->{show_progress};
29
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);
36
37    $self->squash_repeats($squash_repeats);
38
39    $self->_sqlat($sqlat);
40    $self->_last_sql('');
41
42    return $self
43 }
44
45 sub print {
46   my $self = shift;
47   my $string = shift;
48   my $bindargs = shift || [];
49
50   my ($lw, $lr);
51   ($lw, $string, $lr) = $string =~ /^(\s*)(.+?)(\s*)$/s;
52
53   local $self->_sqlat->{fill_in_placeholders} = 0 if defined $bindargs
54     && defined $bindargs->[0] && $bindargs->[0] eq q('__BULK_INSERT__');
55
56   my $use_placeholders = !!$self->_sqlat->fill_in_placeholders;
57
58   # DBIC pre-quotes bindargs
59   $bindargs = [map { s/^'//; s/'$//; $_ } @{$bindargs}] if $use_placeholders;
60
61   my $sqlat = $self->_sqlat;
62   my $formatted;
63   if ($self->squash_repeats && $self->_last_sql eq $string) {
64      my ( $l, $r ) = @{ $sqlat->placeholder_surround };
65      $formatted = '... : ' . join(', ', map "$l$_$r", @$bindargs)
66   } else {
67      $self->_last_sql($string);
68      $formatted = $sqlat->format($string, $bindargs);
69      $formatted = "$formatted : " . join ', ', @{$bindargs}
70         unless $use_placeholders;
71   }
72
73   $self->next::method("$lw$formatted$lr", @_);
74 }
75
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
85   $string =~ s/\s+$//;
86
87   $self->print("$string\n", \@bind);
88
89   $self->debugfh->print($self->_executing_str) if $self->_show_progress
90 }
91
92 sub query_end {
93   $_[0]->debugfh->print($_[0]->_clear_line_str) if $_[0]->_show_progress
94 }
95
96 1;
97
98 =pod
99
100 =head1 SYNOPSIS
101
102  package MyApp::Schema;
103
104  use parent 'DBIx::Class::Schema';
105
106  use DBIx::Class::Storage::Debug::PrettyPrint;
107
108  __PACKAGE__->load_namespaces;
109
110  my $pp = DBIx::Class::Storage::Debug::PrettyPrint->new({
111    profile => 'console',
112  });
113
114  sub connection {
115    my $self = shift;
116
117    my $ret = $self->next::method(@_);
118
119    $self->storage->debugobj($pp);
120
121    $ret
122  }
123