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 | |
98 | if (is_Str($value)) { |
99 | push @{$ret->{args}}, { -type => 'value', value => $value }; |
100 | } |
101 | |
102 | return $ret; |
103 | } |
104 | |
105 | |
106 | }; |
107 | |
108 | 1; |
109 | |
110 | =head1 NAME |
111 | |
112 | SQL::Abstract::AST::Compat - v1.xx AST -> v2 AST visitor |
113 | |
114 | =head1 DESCRIPTION |
115 | |
116 | The purpose of this module is to take the where clause arguments from version |
117 | 1.x of SQL::Abstract, and turn it into a proper, explicit AST, suitable for use |
118 | in the rest of the code. |
119 | |
120 | Please note that this module does not have the same interface as other |
121 | SQL::Abstract ASTs. |
122 | |
123 | =head1 AUTHOR |
124 | |
125 | Ash Berlin C<< <ash@cpan.org> >> |
126 | |
127 | =cut |