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 | |
15 | method dispatch (ArrayRef $ast) { |
16 | |
17 | local $_ = $ast->[0]; |
18 | s/^-/_/g or croak "Unknown type tag '$_'"; |
19 | my $meth = $self->can($_) || \&_generic_func; |
20 | return $meth->($self, $ast); |
21 | } |
22 | |
23 | method _select(ArrayRef $ast) { |
24 | |
25 | } |
26 | |
27 | method _where(ArrayRef $ast) { |
28 | my (undef, @clauses) = @$ast; |
29 | |
30 | return 'WHERE ' . $self->_recurse_where(\@clauses); |
31 | } |
32 | |
33 | method _order_by(ArrayRef $ast) { |
34 | my (undef, @clauses) = @$ast; |
35 | |
36 | my @output; |
37 | |
38 | for (@clauses) { |
39 | if ($_->[0] =~ /^-(asc|desc)$/) { |
40 | my $o = $1; |
41 | push @output, $self->dispatch($_->[1]) . " " . uc($o); |
42 | next; |
43 | } |
44 | push @output, $self->dispatch($_); |
45 | } |
46 | |
47 | return "ORDER BY " . join(", ", @output); |
48 | } |
49 | |
50 | method _name(ArrayRef $ast) { |
51 | my (undef, @names) = @$ast; |
52 | |
53 | my $sep = $self->name_separator; |
54 | |
55 | return $sep->[0] . |
56 | join( $sep->[1] . $sep->[0], @names ) . |
57 | $sep->[1] |
58 | if (@$sep > 1); |
59 | |
60 | return join($sep->[0], @names); |
61 | } |
62 | |
63 | method _join(ArrayRef $ast) { |
64 | |
65 | } |
66 | |
67 | method _list(ArrayRef $ast) { |
68 | my (undef, @items) = @$ast; |
69 | |
70 | return join( |
71 | $self->list_separator, |
72 | map { $self->dispatch($_) } @items); |
73 | } |
74 | |
75 | method _alias(ArrayRef $ast) { |
76 | my (undef, $alias, $as) = @$ast; |
77 | |
78 | return $self->dispatch($alias) . " AS $as"; |
79 | |
80 | } |
81 | |
82 | method _value(ArrayRef $ast) { |
83 | my ($undef, $value) = @$ast; |
84 | |
85 | $self->add_bind($value); |
86 | return "?"; |
87 | } |
88 | |
89 | method _recurse_where($clauses) { |
90 | |
91 | my $OP = 'AND'; |
92 | my $prio = $SQL::Abstract::PRIO{and}; |
93 | my $first = $clauses->[0]; |
94 | |
95 | if (!ref $first && $first =~ /^-(and|or)$/) { |
96 | $OP = uc($1); |
97 | $prio = $SQL::Abstract::PRIO{$1}; |
98 | shift @$clauses; |
99 | } |
100 | |
101 | my @output; |
102 | foreach (@$clauses) { |
103 | croak "invalid component in where clause" unless ArrayRef->check($_); |
104 | my $op = $_->[0]; |
105 | |
106 | unless (substr($op, 0, 1) eq '-') { |
107 | # A simple comparison op (==, >, etc.) |
108 | |
109 | push @output, $self->_binop(@$_); |
110 | |
111 | } elsif ($op =~ /^-(and|or)$/) { |
112 | my $sub_prio = $SQL::Abstract::PRIO{$1}; |
113 | |
114 | if ($sub_prio <= $prio) { |
115 | push @output, $self->_recurse_where($_); |
116 | } else { |
117 | push @output, '(' . $self->_recurse_where($_) . ')'; |
118 | } |
119 | } else { |
120 | push @output, $self->dispatch($_); |
121 | } |
122 | } |
123 | |
124 | return join(" $OP ", @output); |
125 | } |
126 | |
127 | method _binop($op, $lhs, $rhs) { |
128 | join (' ', $self->dispatch($lhs), |
129 | $SQL::Abstract::OP_MAP{$op} || croak("Unknown binary operator $op"), |
130 | $self->dispatch($rhs) |
131 | ); |
132 | } |
133 | |
134 | method _in($ast) { |
135 | my (undef, $field, @values) = @$ast; |
136 | |
44cfd1f6 |
137 | return $self->_false if @values == 0; |
14774be0 |
138 | return $self->dispatch($field) . |
139 | " IN (" . |
140 | join(", ", map { $self->dispatch($_) } @values ) . |
141 | ")"; |
142 | } |
143 | |
144 | method _generic_func(ArrayRef $ast) { |
145 | } |
146 | |
44cfd1f6 |
147 | # 'constants' that are portable across DBs |
148 | method _false($ast?) { "0 = 1" } |
149 | method _true($ast?) { "1 = 1" } |
150 | |
14774be0 |
151 | } |