Commit | Line | Data |
14774be0 |
1 | use MooseX::Declare; |
2 | |
3 | class SQL::Abstract::AST::v1 extends SQL::Abstract { |
4 | |
5 | use Carp qw/croak/; |
6 | use Data::Dump qw/pp/; |
7 | |
8 | use Moose::Util::TypeConstraints; |
9 | use MooseX::Types -declare => [qw/NameSeparator/]; |
10 | use MooseX::Types::Moose qw/ArrayRef Str Int/; |
11 | use MooseX::AttributeHelpers; |
12 | |
13 | clean; |
14 | |
0c371882 |
15 | # set things that are valid in where clauses |
0bf8a8c4 |
16 | override _build_where_dispatch_table { |
17 | return { |
18 | %{super()}, |
19 | -in => $self->can('_in'), |
0c371882 |
20 | -not_in => $self->can('_in'), |
21 | map { +"-$_" => $self->can("_$_") } qw/ |
22 | value |
23 | name |
24 | true |
25 | false |
26 | / |
0bf8a8c4 |
27 | }; |
14774be0 |
28 | } |
29 | |
30 | method _select(ArrayRef $ast) { |
31 | |
32 | } |
33 | |
34 | method _where(ArrayRef $ast) { |
35 | my (undef, @clauses) = @$ast; |
36 | |
37 | return 'WHERE ' . $self->_recurse_where(\@clauses); |
38 | } |
39 | |
40 | method _order_by(ArrayRef $ast) { |
41 | my (undef, @clauses) = @$ast; |
42 | |
43 | my @output; |
44 | |
45 | for (@clauses) { |
46 | if ($_->[0] =~ /^-(asc|desc)$/) { |
47 | my $o = $1; |
48 | push @output, $self->dispatch($_->[1]) . " " . uc($o); |
49 | next; |
50 | } |
51 | push @output, $self->dispatch($_); |
52 | } |
53 | |
54 | return "ORDER BY " . join(", ", @output); |
55 | } |
56 | |
57 | method _name(ArrayRef $ast) { |
58 | my (undef, @names) = @$ast; |
59 | |
60 | my $sep = $self->name_separator; |
61 | |
62 | return $sep->[0] . |
63 | join( $sep->[1] . $sep->[0], @names ) . |
64 | $sep->[1] |
65 | if (@$sep > 1); |
66 | |
67 | return join($sep->[0], @names); |
68 | } |
69 | |
70 | method _join(ArrayRef $ast) { |
704c5138 |
71 | my (undef, @items) = @$ast; |
72 | |
73 | croak "invalid component in JOIN: $_" unless ArrayRef->check($items[0]); |
74 | my @output = 'JOIN'; |
75 | |
76 | # TODO: Validation of inputs |
77 | return 'JOIN '. $self->dispatch(shift @items) . |
78 | ' ON (' . |
79 | $self->_recurse_where( \@items ) . ')'; |
80 | |
14774be0 |
81 | } |
82 | |
83 | method _list(ArrayRef $ast) { |
84 | my (undef, @items) = @$ast; |
85 | |
86 | return join( |
87 | $self->list_separator, |
88 | map { $self->dispatch($_) } @items); |
89 | } |
90 | |
91 | method _alias(ArrayRef $ast) { |
92 | my (undef, $alias, $as) = @$ast; |
93 | |
94 | return $self->dispatch($alias) . " AS $as"; |
95 | |
96 | } |
97 | |
98 | method _value(ArrayRef $ast) { |
99 | my ($undef, $value) = @$ast; |
100 | |
101 | $self->add_bind($value); |
102 | return "?"; |
103 | } |
104 | |
105 | method _recurse_where($clauses) { |
106 | |
107 | my $OP = 'AND'; |
108 | my $prio = $SQL::Abstract::PRIO{and}; |
109 | my $first = $clauses->[0]; |
110 | |
111 | if (!ref $first && $first =~ /^-(and|or)$/) { |
112 | $OP = uc($1); |
113 | $prio = $SQL::Abstract::PRIO{$1}; |
114 | shift @$clauses; |
115 | } |
116 | |
0bf8a8c4 |
117 | my $dispatch_table = $self->where_dispatch_table; |
118 | |
14774be0 |
119 | my @output; |
120 | foreach (@$clauses) { |
0c371882 |
121 | croak "invalid component in where clause: $_" unless ArrayRef->check($_); |
14774be0 |
122 | my $op = $_->[0]; |
123 | |
0c371882 |
124 | if ($op =~ /^-(and|or)$/) { |
14774be0 |
125 | my $sub_prio = $SQL::Abstract::PRIO{$1}; |
126 | |
127 | if ($sub_prio <= $prio) { |
128 | push @output, $self->_recurse_where($_); |
129 | } else { |
130 | push @output, '(' . $self->_recurse_where($_) . ')'; |
131 | } |
132 | } else { |
0c371882 |
133 | push @output, $self->_where_component($_); |
14774be0 |
134 | } |
135 | } |
136 | |
137 | return join(" $OP ", @output); |
138 | } |
139 | |
0c371882 |
140 | method _where_component($ast) { |
141 | my $op = $ast->[0]; |
142 | |
143 | if (my $code = $self->lookup_where_dispatch($op)) { |
144 | |
145 | return $code->($self, $ast); |
146 | |
147 | } |
148 | croak "'$op' is not a valid clause in a where AST" |
149 | if $op =~ /^-/; |
150 | |
151 | croak "'$op' is not a valid operator"; |
152 | |
153 | } |
154 | |
155 | |
0bf8a8c4 |
156 | method _binop($ast) { |
157 | my ($op, $lhs, $rhs) = @$ast; |
158 | |
0c371882 |
159 | join (' ', $self->_where_component($lhs), |
0bf8a8c4 |
160 | $self->binop_mapping($op) || croak("Unknown binary operator $op"), |
0c371882 |
161 | $self->_where_component($rhs) |
14774be0 |
162 | ); |
163 | } |
164 | |
165 | method _in($ast) { |
0bf8a8c4 |
166 | my ($tag, $field, @values) = @$ast; |
167 | |
168 | my $not = $tag =~ /^-not/ ? " NOT" : ""; |
14774be0 |
169 | |
44cfd1f6 |
170 | return $self->_false if @values == 0; |
0c371882 |
171 | return $self->_where_component($field) . |
0bf8a8c4 |
172 | $not. |
14774be0 |
173 | " IN (" . |
174 | join(", ", map { $self->dispatch($_) } @values ) . |
175 | ")"; |
176 | } |
177 | |
0bf8a8c4 |
178 | method _like($ast) { |
179 | my ($tag, $field, @values) = @$ast; |
180 | |
181 | my $not = $tag =~ /^-not/ ? " NOT" : ""; |
182 | |
183 | return $self->_false if @values == 0; |
0c371882 |
184 | return $self->_where_component($field) . |
0bf8a8c4 |
185 | $not. |
0c371882 |
186 | " LIKE " . |
187 | join(", ", map { $self->_where_component($_) } @values ) . |
188 | ""; |
0bf8a8c4 |
189 | } |
190 | |
14774be0 |
191 | method _generic_func(ArrayRef $ast) { |
192 | } |
193 | |
44cfd1f6 |
194 | # 'constants' that are portable across DBs |
195 | method _false($ast?) { "0 = 1" } |
196 | method _true($ast?) { "1 = 1" } |
197 | |
14774be0 |
198 | } |