Commit | Line | Data |
d70ca130 |
1 | use MooseX::Declare; |
2 | |
3 | class SQL::Abstract::AST::Compat { |
4 | |
5 | use MooseX::Types::Moose qw/ArrayRef HashRef Str ScalarRef/; |
6 | use SQL::Abstract::Types qw/AST/; |
7 | use SQL::Abstract::Types::Compat ':all'; |
8 | use Devel::PartialDump qw/dump/; |
9 | use Carp qw/croak/; |
10 | |
11 | clean; |
12 | |
13 | has logic => ( |
14 | is => 'rw', |
15 | isa => LogicEnum, |
16 | default => 'AND' |
17 | ); |
18 | |
19 | method generate(WhereType $ast) returns (AST) { |
20 | return $self->recurse_where($ast); |
21 | } |
22 | |
23 | method recurse_where(WhereType $ast, LogicEnum $logic?) returns (AST) { |
24 | return $self->recurse_where_hash($logic || 'AND', $ast) if is_HashRef($ast); |
25 | return $self->recurse_where_array($logic || 'OR', $ast) if is_ArrayRef($ast); |
26 | croak "Unknown where clause type " . dump($ast); |
27 | } |
28 | |
29 | method recurse_where_hash(LogicEnum $logic, HashRef $ast) returns (AST) { |
30 | my @args; |
31 | my $ret = { |
32 | -type => 'expr', |
33 | op => lc $logic, |
34 | args => \@args |
35 | }; |
36 | |
37 | while (my ($key,$value) = each %$ast) { |
38 | if ($key =~ /^-(or|and)$/) { |
39 | my $val = $self->recurse_where($value, uc $1); |
40 | if ($val->{op} eq $ret->{op}) { |
41 | push @args, @{$val->{args}}; |
42 | } |
43 | else { |
44 | push @args, $val; |
45 | } |
46 | next; |
47 | } |
48 | |
49 | push @args, $self->field($key, $value); |
50 | } |
51 | |
52 | return $args[0] if @args == 1; |
53 | |
54 | return $ret; |
55 | } |
56 | |
57 | method recurse_where_array(LogicEnum $logic, ArrayRef $ast) returns (AST) { |
58 | my @args; |
59 | my $ret = { |
60 | -type => 'expr', |
61 | op => lc $logic, |
62 | args => \@args |
63 | }; |
64 | my @nodes = @$ast; |
65 | |
66 | while (my $key = shift @nodes) { |
67 | if ($key =~ /^-(or|and)$/) { |
68 | my $value = shift @nodes |
69 | or confess "missing value after $key at " . dump($ast); |
70 | |
71 | my $val = $self->recurse_where($value, uc $1); |
72 | if ($val->{op} eq $ret->{op}) { |
73 | push @args, @{$val->{args}}; |
74 | } |
75 | else { |
76 | push @args, $val; |
77 | } |
78 | next; |
79 | } |
80 | |
81 | push @args, $self->recurse_where($key); |
82 | } |
83 | |
84 | return $args[0] if @args == 1; |
85 | |
86 | return $ret; |
87 | } |
88 | |
89 | method field(Str $key, $value) returns (AST) { |
90 | my $ret = { |
91 | -type => 'expr', |
92 | op => '==', |
93 | args => [ |
94 | { -type => 'name', args => [$key] } |
95 | ], |
96 | }; |
97 | |
c6039348 |
98 | if (is_HashRef($value)) { |
99 | my ($op, @rest) = keys %$value; |
100 | confess "Don't know how to handle " . dump($value) . " (too many keys)" |
101 | if @rest; |
102 | |
2e828b0b |
103 | # TODO: Validate the op? |
104 | if ($op =~ /^-([a-z_]+)$/i) { |
105 | $ret->{op} = lc $1; |
106 | |
107 | if (is_ArrayRef($value->{$op})) { |
108 | push @{$ret->{args}}, $self->value($_) |
109 | for @{$value->{$op}}; |
110 | return $ret; |
111 | } |
112 | } |
113 | else { |
114 | $ret->{op} = $op; |
115 | } |
116 | |
c6039348 |
117 | push @{$ret->{args}}, $self->value($value->{$op}); |
118 | |
119 | } |
120 | elsif (is_ArrayRef($value)) { |
121 | # Return an or clause, sort of. |
122 | return { |
123 | -type => 'expr', |
124 | op => 'or', |
125 | args => [ map { |
126 | { |
127 | -type => 'expr', |
128 | op => '==', |
129 | args => [ |
130 | { -type => 'name', args => [$key] }, |
131 | $self->value($_) |
132 | ], |
133 | } |
134 | } @$value ] |
135 | }; |
136 | } |
137 | else { |
138 | push @{$ret->{args}}, $self->value($value); |
d70ca130 |
139 | } |
140 | |
141 | return $ret; |
142 | } |
143 | |
c6039348 |
144 | method value($value) returns (AST) { |
2e828b0b |
145 | return { -type => 'value', value => $value } |
146 | if is_Str($value); |
147 | |
148 | confess "Don't know how to handle terminal value " . dump($value); |
c6039348 |
149 | } |
150 | |
d70ca130 |
151 | |
152 | }; |
153 | |
154 | 1; |
155 | |
156 | =head1 NAME |
157 | |
158 | SQL::Abstract::AST::Compat - v1.xx AST -> v2 AST visitor |
159 | |
160 | =head1 DESCRIPTION |
161 | |
162 | The purpose of this module is to take the where clause arguments from version |
163 | 1.x of SQL::Abstract, and turn it into a proper, explicit AST, suitable for use |
164 | in the rest of the code. |
165 | |
166 | Please note that this module does not have the same interface as other |
167 | SQL::Abstract ASTs. |
168 | |
169 | =head1 AUTHOR |
170 | |
171 | Ash Berlin C<< <ash@cpan.org> >> |
172 | |
173 | =cut |