File Coverage

blib/lib/Pg/SQL/PrettyPrinter/Node/SelectStmt.pm
Criterion Covered Total %
statement 205 207 99.0
branch 70 72 97.2
condition 8 8 100.0
subroutine 24 24 100.0
pod 10 10 100.0
total 317 321 98.7


line stmt bran cond sub pod time code
1             package Pg::SQL::PrettyPrinter::Node::SelectStmt;
2              
3             # UTF8 boilerplace, per http://stackoverflow.com/questions/6162484/why-does-modern-perl-avoid-utf-8-by-default/
4 11     11   13404 use v5.26;
  11         48  
5 11     11   71 use strict;
  11         23  
  11         301  
6 11     11   49 use warnings;
  11         21  
  11         1613  
7 11     11   80 use warnings qw( FATAL utf8 );
  11         25  
  11         619  
8 11     11   68 use utf8;
  11         20  
  11         86  
9 11     11   522 use open qw( :std :utf8 );
  11         35  
  11         133  
10 11     11   1953 use Unicode::Normalize qw( NFC );
  11         58  
  11         1313  
11 11     11   79 use Unicode::Collate;
  11         36  
  11         557  
12 11     11   73 use Encode qw( decode );
  11         22  
  11         2035  
13              
14             if ( grep /\P{ASCII}/ => @ARGV ) {
15             @ARGV = map { decode( 'UTF-8', $_ ) } @ARGV;
16             }
17              
18             # If there is __DATA__,then uncomment next line:
19             # binmode( DATA, ':encoding(UTF-8)' );
20             # UTF8 boilerplace, per http://stackoverflow.com/questions/6162484/why-does-modern-perl-avoid-utf-8-by-default/
21              
22             # Useful common code
23 11     11   84 use autodie;
  11         22  
  11         164  
24 11     11   71069 use Carp qw( carp croak confess cluck );
  11         78  
  11         1469  
25 11     11   93 use English qw( -no_match_vars );
  11         24  
  11         133  
26 11     11   5610 use Data::Dumper qw( Dumper );
  11         27  
  11         3135  
27              
28             # give a full stack dump on any untrapped exceptions
29             local $SIG{ __DIE__ } = sub {
30             confess "Uncaught exception: @_" unless $^S;
31             };
32              
33             # now promote run-time warnings into stackdumped exceptions
34             # *unless* we're in an try block, in which
35             # case just generate a clucking stackdump instead
36             local $SIG{ __WARN__ } = sub {
37             if ( $^S ) { cluck "Trapped warning: @_" }
38             else { confess "Deadly warning: @_" }
39             };
40              
41             # Useful common code
42              
43 11     11   121 use parent qw( Pg::SQL::PrettyPrinter::Node );
  11         30  
  11         105  
44              
45             sub new {
46 119     119 1 5705 my $class = shift;
47 119         1251 my $self = $class->SUPER::new( @_ );
48 119         318 bless $self, $class;
49              
50 119         813 $self->objectify(
51             'valuesLists',
52             [ 'withClause', 'ctes' ],
53             );
54 119 100       551 if ( $self->setop ) {
55 5         14 $self->init_setop;
56             }
57             else {
58 114         410 $self->init_plain;
59             }
60              
61 119         398 return $self;
62             }
63              
64             sub setop {
65 169     169 1 279 my $self = shift;
66 169 100       649 return if $self->{ 'op' } eq 'SETOP_NONE';
67 41         49 my $op = $self->{ 'op' };
68 41         73 $op =~ s/^SETOP_//;
69 41 100       104 $op .= ' ALL' if $self->{ 'all' };
70 41         142 return $op;
71             }
72              
73             sub init_setop {
74 5     5 1 8 my $self = shift;
75 5         8 for my $element ( qw( rarg larg ) ) {
76 10         32 $self->{ $element } = $self->make_from( { 'SelectStmt' => $self->{ $element } } );
77             }
78             }
79              
80             sub init_plain {
81 114     114 1 211 my $self = shift;
82              
83 114         451 $self->objectify( qw( targetList fromClause whereClause groupClause havingClause sortClause limitCount limitOffset distinctClause lockingClause ) );
84             }
85              
86             sub as_text {
87 122     122 1 588 my $self = shift;
88 122 100       421 if ( exists $self->{ 'valuesLists' } ) {
89 16         66 return sprintf( 'VALUES %s', join( ', ', map { $_->as_text } @{ $self->{ 'valuesLists' } } ) );
  20         82  
  16         55  
90             }
91 106         232 my $prefix = '';
92 106 100       328 if ( exists $self->{ 'withClause' } ) {
93 2         4 $prefix = 'WITH ';
94 2 100       8 $prefix .= 'RECURSIVE ' if $self->{ 'withClause' }->{ 'recursive' };
95 2         10 $prefix .= join( ', ', map { $_->as_text } @{ $self->{ 'withClause' }->{ 'ctes' } } ) . ' ';
  4         11  
  2         5  
96             }
97 106 100       660 return $prefix . ( $self->{ 'op' } eq 'SETOP_NONE' ? $self->as_text_plain : $self->as_text_setop );
98             }
99              
100             sub as_text_setop {
101 5     5 1 8 my $self = shift;
102 5         7 my @elements = ();
103 5 100 100     12 if ( ( $self->{ 'larg' }->setop // '' ) eq $self->setop ) {
104 1         5 push @elements, $self->{ 'larg' }->as_text;
105             }
106             else {
107 4         11 push @elements, '(', $self->{ 'larg' }->as_text, ')';
108             }
109 5         11 push @elements, $self->setop;
110 5 50 100     11 if ( ( $self->{ 'rarg' }->setop // '' ) eq $self->setop ) {
111 0         0 push @elements, $self->{ 'rarg' }->as_text;
112             }
113             else {
114 5         7 push @elements, '(', $self->{ 'rarg' }->as_text, ')';
115             }
116 5         25 return join( " ", @elements );
117             }
118              
119             sub as_text_plain {
120 101     101 1 203 my $self = shift;
121 101         187 my $query = 'SELECT ';
122 101 100       317 if ( exists $self->{ 'distinctClause' } ) {
123 2 100       4 if ( 0 == scalar @{ $self->{ 'distinctClause' } } ) {
  2         8  
124 1         3 $query .= 'DISTINCT ';
125             }
126             else {
127             $query .= sprintf(
128             'DISTINCT ON ( %s ) ',
129 1         2 join( ', ', map { $_->as_text } @{ $self->{ 'distinctClause' } } )
  2         5  
  1         2  
130             );
131             }
132             }
133 101         206 $query .= join( ', ', map { $_->as_text } @{ $self->{ 'targetList' } } );
  242         796  
  101         268  
134 101 100       411 if ( exists $self->{ 'fromClause' } ) {
135 63         129 $query .= ' FROM ' . join( ', ', map { $_->as_text } @{ $self->{ 'fromClause' } } );
  65         272  
  63         173  
136             }
137 101 100       420 if ( exists $self->{ 'whereClause' } ) {
138 11         56 $query .= ' WHERE ' . $self->{ 'whereClause' }->as_text;
139             }
140 101 100       355 if ( exists $self->{ 'groupClause' } ) {
141 5         16 $query .= ' GROUP BY ' . join( ', ', map { $_->as_text } @{ $self->{ 'groupClause' } } );
  6         24  
  5         15  
142             }
143 101 100       311 if ( exists $self->{ 'havingClause' } ) {
144 1         5 $query .= ' HAVING ' . $self->{ 'havingClause' }->as_text;
145             }
146 101 100       305 if ( exists $self->{ 'sortClause' } ) {
147 12         23 $query .= ' ORDER BY ' . join( ', ', map { $_->as_text } @{ $self->{ 'sortClause' } } );
  22         65  
  12         30  
148             }
149 101 100       307 if ( exists $self->{ 'limitCount' } ) {
150 10         50 $query .= ' LIMIT ' . $self->{ 'limitCount' }->as_text;
151             }
152 101 100       280 if ( exists $self->{ 'limitOffset' } ) {
153 1         4 $query .= ' OFFSET ' . $self->{ 'limitOffset' }->as_text;
154             }
155 101 100       317 if ( exists $self->{ 'lockingClause' } ) {
156             $query .= ' ' . join(
157             ' ',
158 9         17 map { $_->as_text } @{ $self->{ 'lockingClause' } }
  10         30  
  9         23  
159             );
160             }
161 101         680 return $query;
162             }
163              
164             sub pretty_print {
165 117     117 1 96028 my $self = shift;
166 117 100       480 if ( exists $self->{ 'valuesLists' } ) {
167 16         36 my @lines = ();
168 16         48 push @lines, 'VALUES';
169 16         29 push @lines, map { $self->increase_indent( $_->as_text ) . ',' } @{ $self->{ 'valuesLists' } };
  20         116  
  16         46  
170              
171             # Remove unnecessary trailing , in last element
172 16         93 $lines[ -1 ] =~ s/,\z//;
173 16         109 return join( "\n", @lines );
174             }
175              
176 101 100       505 my $main_body = $self->{ 'op' } eq 'SETOP_NONE' ? $self->pretty_print_plain : $self->pretty_print_setop;
177 101 100       747 return $main_body unless exists $self->{ 'withClause' };
178              
179 2         4 my @cte_def = ();
180              
181 2         3 push @cte_def, map { $_->pretty_print . ',' } @{ $self->{ 'withClause' }->{ 'ctes' } };
  4         10  
  2         7  
182              
183             # Remove unnecessary trailing , in last element
184 2         8 $cte_def[ -1 ] =~ s/,\z//;
185 2 100       7 if ( $self->{ 'withClause' }->{ 'recursive' } ) {
186 1         7 $cte_def[ 0 ] = 'WITH RECURSIVE ' . $cte_def[ 0 ];
187             }
188             else {
189 1         3 $cte_def[ 0 ] = 'WITH ' . $cte_def[ 0 ];
190             }
191              
192 2         4 my @lines = ();
193 2         7 push @lines, join( ' ', @cte_def );
194 2         4 push @lines, $main_body;
195 2         11 return join( "\n", @lines );
196             }
197              
198             sub pretty_print_setop {
199 5     5 1 6 my $self = shift;
200 5         8 my @elements = ();
201 5 100 100     13 if ( ( $self->{ 'larg' }->setop // '' ) eq $self->setop ) {
202 1         5 push @elements, $self->{ 'larg' }->pretty_print;
203             }
204             else {
205 4         6 push @elements, '(';
206 4         11 push @elements, $self->increase_indent( $self->{ 'larg' }->pretty_print );
207 4         8 push @elements, ')';
208             }
209 5         28 push @elements, $self->setop;
210 5 50 100     11 if ( ( $self->{ 'rarg' }->setop // '' ) eq $self->setop ) {
211 0         0 push @elements, $self->{ 'rarg' }->pretty_print;
212             }
213             else {
214 5         9 push @elements, '(';
215 5         10 push @elements, $self->increase_indent( $self->{ 'rarg' }->pretty_print );
216 5         10 push @elements, ')';
217             }
218 5         18 return join( "\n", @elements );
219             }
220              
221             sub pretty_print_plain {
222 96     96 1 203 my $self = shift;
223 96         287 my @lines = ( 'SELECT' );
224              
225 96 100       336 if ( exists $self->{ 'distinctClause' } ) {
226 2 100       4 if ( 0 == scalar @{ $self->{ 'distinctClause' } } ) {
  2         10  
227 1         3 $lines[ 0 ] .= ' DISTINCT';
228             }
229             else {
230             push @lines, sprintf(
231             $self->increase_indent( 'DISTINCT ON ( %s )' ),
232 1         7 join( ', ', map { $_->pretty_print } @{ $self->{ 'distinctClause' } } )
  2         6  
  1         4  
233             );
234             }
235             }
236              
237 96         190 for my $i ( 0 .. $#{ $self->{ 'targetList' } } ) {
  96         432  
238 235         393 my $is_last = $i == $#{ $self->{ 'targetList' } };
  235         504  
239 235         482 my $target = $self->{ 'targetList' }->[ $i ];
240 235         1801 my $pretty = $self->increase_indent( $target->pretty_print() );
241 235 100       641 $pretty .= ',' unless $is_last;
242 235         621 push @lines, $pretty;
243             }
244 96 100       303 if ( exists $self->{ 'fromClause' } ) {
245 58         137 push @lines, 'FROM';
246 58         119 push @lines, map { $self->increase_indent( $_->pretty_print ) . ',' } @{ $self->{ 'fromClause' } };
  60         263  
  58         129  
247              
248             # Remove unnecessary trailing , in last element
249 58         3059 $lines[ -1 ] =~ s/,\z//;
250             }
251 96 100       335 if ( exists $self->{ 'whereClause' } ) {
252 10         28 push @lines, 'WHERE';
253 10         57 push @lines, $self->increase_indent( $self->{ 'whereClause' }->pretty_print );
254             }
255 96 100       274 if ( exists $self->{ 'groupClause' } ) {
256 5         21 push @lines, 'GROUP BY';
257 5         14 push @lines, map { $self->increase_indent( $_->pretty_print ) . ',' } @{ $self->{ 'groupClause' } };
  6         28  
  5         15  
258              
259             # Remove unnecessary trailing , in last element
260 5         31 $lines[ -1 ] =~ s/,\z//;
261             }
262 96 100       292 if ( exists $self->{ 'havingClause' } ) {
263 1         2 push @lines, 'HAVING';
264 1         7 push @lines, $self->increase_indent( $self->{ 'havingClause' }->pretty_print );
265             }
266 96 100       283 if ( exists $self->{ 'sortClause' } ) {
267 12         47 push @lines, 'ORDER BY';
268 12         24 push @lines, map { $self->increase_indent( $_->pretty_print ) . ',' } @{ $self->{ 'sortClause' } };
  22         66  
  12         35  
269              
270             # Remove unnecessary trailing , in last element
271 12         51 $lines[ -1 ] =~ s/,\z//;
272             }
273              
274 96 100       313 if ( exists $self->{ 'limitCount' } ) {
275 10         51 push @lines, 'LIMIT ' . $self->{ 'limitCount' }->pretty_print;
276             }
277 96 100       284 if ( exists $self->{ 'limitOffset' } ) {
278 1         3 push @lines, 'OFFSET ' . $self->{ 'limitOffset' }->pretty_print;
279             }
280 96 100       261 if ( exists $self->{ 'lockingClause' } ) {
281 9         18 push @lines, map { $_->pretty_print } @{ $self->{ 'lockingClause' } };
  10         33  
  9         21  
282             }
283              
284 96         495 return join( "\n", @lines );
285             }
286              
287             1;