Commit | Line | Data |
b3b54441 |
1 | package SQL::Abstract::Formatter; |
2 | |
3 | require SQL::Abstract::Parts; # it loads us too, don't cross the streams |
4 | |
5 | use Moo; |
6 | |
7 | has indent_by => (is => 'ro', default => ' '); |
8 | has max_width => (is => 'ro', default => 78); |
9 | |
10 | sub _join { |
11 | shift; |
4ebfbfc1 |
12 | return SQL::Abstract::Parts::stringify(\@_); |
b3b54441 |
13 | } |
14 | |
15 | sub format { |
16 | my ($self, $join, @parts) = @_; |
07070f1a |
17 | $self->_fold_sql('', '', @{$self->_simplify($join, @parts)}); |
18 | } |
19 | |
20 | sub _simplify { |
21 | my ($self, $join, @parts) = @_; |
22 | return '' unless @parts; |
23 | return $parts[0] if @parts == 1 and !ref($parts[0]); |
24 | return $self->_simplify(@{$parts[0]}) if @parts == 1; |
25 | return [ $join, map ref() ? $self->_simplify(@$_) : $_, @parts ]; |
26 | } |
27 | |
28 | sub _fold_sql { |
07070f1a |
29 | my ($self, $indent0, $indent, $join, @parts) = @_; |
30 | my @res; |
31 | my $w = $self->max_width; |
32 | my $join_len = 0; |
33 | (s/, \Z/,\n/ and $join_len = 1) |
34 | or s/\A /\n/ |
35 | or $_ = "\n" |
36 | for my $line_join = $join; |
37 | my ($nl_pre, $nl_post) = split "\n", $line_join; |
12fceb64 |
38 | my $line_orig = my $line = $indent0; |
07070f1a |
39 | my $next_indent = $indent.$self->indent_by; |
12fceb64 |
40 | my $line_proto = $indent.$nl_post; |
07070f1a |
41 | PART: foreach my $idx (0..$#parts) { |
07070f1a |
42 | my $p = $parts[$idx]; |
3f9c7484 |
43 | #::DwarnT STARTPART => $p, \@res, $line, $line_orig; |
12fceb64 |
44 | my $pre = ($line ne $line_orig ? $join : ''); |
07070f1a |
45 | my $j_part = $pre.(my $j = ref($p) ? $self->_join(@$p) : $p); |
46 | if (length($j_part) + length($line) + $join_len <= $w) { |
47 | $line .= $j_part; |
152035ec |
48 | next PART; |
49 | } |
a2795aac |
50 | my $innerdent = @res |
51 | ? $next_indent |
52 | : $indent0.$self->indent_by; |
152035ec |
53 | if (ref($p) and $p->[1] eq '(' and $p->[-1] eq ')') { |
54 | my $already = !($line eq $indent0 or $line eq $line_orig); |
55 | push @res, $line.($already ? $join : '').'('."\n"; |
56 | my (undef, undef, $inner) = @$p; |
9046a418 |
57 | my $folded = $self->_fold_sql($innerdent, $innerdent, @$inner); |
4a9ad1af |
58 | $folded =~ s/\n\Z//; |
152035ec |
59 | push @res, $folded."\n"; |
60 | $line_orig = $line |
bc3c183b |
61 | = $indent0.')'.($idx == $#parts ? '' : $join); |
152035ec |
62 | next PART; |
63 | } |
9ada12a4 |
64 | if ($line ne $line_orig) { |
65 | push @res, $line.($idx == $#parts ? '' : $nl_pre)."\n"; |
66 | } |
152035ec |
67 | if (length($line = $line_proto.$j) <= $w) { |
152035ec |
68 | next PART; |
07070f1a |
69 | } |
152035ec |
70 | my $folded = $self->_fold_sql($line_proto, $innerdent, @$p); |
71 | $folded =~ s/\n\Z//; |
9ada12a4 |
72 | push @res, $folded.($idx == $#parts ? '' : $nl_pre)."\n"; |
152035ec |
73 | $line_orig = $line = $idx == $#parts ? '' : $line_proto; |
3f9c7484 |
74 | } continue { |
75 | #::DwarnT ENDPART => $parts[$idx], \@res, $line, $line_orig; |
07070f1a |
76 | } |
4ebfbfc1 |
77 | return join '', @res, $line; |
b3b54441 |
78 | } |
79 | |
80 | 1; |