Commit | Line | Data |
a0185af2 |
1 | use MooseX::Declare; |
a0185af2 |
2 | |
a0185af2 |
3 | class SQL::Abstract { |
4 | |
5 | use Carp qw/croak/; |
6 | use Data::Dump qw/pp/; |
7 | |
8 | use Moose::Util::TypeConstraints; |
0c371882 |
9 | use MooseX::Types::Moose qw/ArrayRef Str Int HashRef CodeRef/; |
4769c837 |
10 | use MooseX::AttributeHelpers; |
bad761ba |
11 | use SQL::Abstract::Types qw/NameSeparator QuoteChars AST/; |
747f7c21 |
12 | use Devel::PartialDump qw/dump/; |
4769c837 |
13 | |
c314b35d |
14 | clean; |
a0185af2 |
15 | |
a0185af2 |
16 | our $VERSION = '2.000000'; |
17 | |
18 | our $AST_VERSION = '1'; |
19 | |
3e63a4d5 |
20 | # Operator precedence for bracketing |
21 | our %PRIO = ( |
22 | and => 10, |
23 | or => 50 |
24 | ); |
25 | |
0bf8a8c4 |
26 | our %BINOP_MAP = ( |
fc20481d |
27 | |
28 | '+' => '+', |
29 | '-' => '-', |
30 | '/' => '/', |
31 | '*' => '*', |
32 | |
3e63a4d5 |
33 | '>' => '>', |
64f3d05e |
34 | '>=' => '>=', |
3e63a4d5 |
35 | '<' => '<', |
64f3d05e |
36 | '<=' => '<=', |
3e63a4d5 |
37 | '==' => '=', |
38 | '!=' => '!=', |
0bf8a8c4 |
39 | # LIKE is always "field LIKE <value>" |
db861e66 |
40 | 'like' => 'LIKE', |
41 | 'not_like' => 'NOT LIKE', |
3e63a4d5 |
42 | ); |
43 | |
ef0d6124 |
44 | has expr_dispatch_table => ( |
0bf8a8c4 |
45 | is => 'ro', |
eb22ecd3 |
46 | lazy => 1, |
ef0d6124 |
47 | builder => '_build_expr_dispatch_table', |
0c371882 |
48 | isa => HashRef[CodeRef], |
49 | metaclass => 'Collection::ImmutableHash', |
50 | provides => { |
ef0d6124 |
51 | get => 'lookup_expr_dispatch' |
0c371882 |
52 | } |
0bf8a8c4 |
53 | ); |
54 | |
55 | has binop_map => ( |
56 | is => 'ro', |
eb22ecd3 |
57 | lazy => 1, |
58 | builder => '_build_binops', |
0bf8a8c4 |
59 | isa => HashRef, |
60 | metaclass => 'Collection::ImmutableHash', |
61 | provides => { |
62 | exists => 'is_valid_binop', |
63 | get => 'binop_mapping', |
64 | keys => 'binary_operators' |
65 | } |
66 | ); |
67 | |
eb22ecd3 |
68 | # List of default binary operators (for in where clauses) |
69 | sub _build_binops { return {%BINOP_MAP} }; |
0bf8a8c4 |
70 | |
ef0d6124 |
71 | method _build_expr_dispatch_table { |
0c371882 |
72 | my $binop = $self->can('_binop') or croak "InternalError: $self can't do _binop!"; |
0bf8a8c4 |
73 | return { |
74 | map { $_ => $binop } $self->binary_operators |
75 | } |
76 | } |
77 | |
c314b35d |
78 | has ast_version => ( |
79 | is => 'ro', |
80 | isa => Int, |
81 | required => 1 |
82 | ); |
83 | |
627dcb62 |
84 | has ident_separator => ( |
a0185af2 |
85 | is => 'rw', |
86 | isa => NameSeparator, |
4ee32f41 |
87 | default => '.', |
a0185af2 |
88 | required => 1, |
89 | ); |
90 | |
91 | has list_separator => ( |
92 | is => 'rw', |
93 | isa => Str, |
94 | default => ', ', |
95 | required => 1, |
96 | ); |
97 | |
4ee32f41 |
98 | has quote_chars => ( |
99 | is => 'rw', |
100 | isa => QuoteChars, |
4ee32f41 |
101 | predicate => 'is_quoting', |
102 | clearer => 'disable_quoting', |
8eda2119 |
103 | coerce => 1, |
4ee32f41 |
104 | ); |
105 | |
4769c837 |
106 | has binds => ( |
107 | isa => ArrayRef, |
5bf8c024 |
108 | is => 'ro', |
0bf8a8c4 |
109 | clearer => '_clear_binds', |
110 | lazy => 1, |
4769c837 |
111 | default => sub { [ ] }, |
112 | metaclass => 'Collection::Array', |
113 | provides => { |
114 | push => 'add_bind', |
4769c837 |
115 | } |
116 | ); |
117 | |
14774be0 |
118 | # TODO: once MXMS supports %args, use that here |
e76b9ff7 |
119 | # TODO: improve this so you can pass other args |
14774be0 |
120 | method create(ClassName $class: Int $ver) { |
121 | croak "AST version $ver is greater than supported version of $AST_VERSION" |
122 | if $ver > $AST_VERSION; |
123 | |
124 | my $name = "${class}::AST::v$ver"; |
125 | Class::MOP::load_class($name); |
126 | |
127 | return $name->new(ast_version => $ver); |
c314b35d |
128 | } |
129 | |
130 | # Main entry point |
bad761ba |
131 | method generate(ClassName $class: AST $ast) { |
a464be15 |
132 | my $ver = $ast->{-ast_version}; |
c314b35d |
133 | croak "SQL::Abstract AST version not specified" |
a464be15 |
134 | unless defined $ver; |
c314b35d |
135 | |
14774be0 |
136 | # TODO: once MXMS supports %args, use that here |
137 | my $self = $class->create($ver); |
c314b35d |
138 | |
139 | return ($self->dispatch($ast), $self->binds); |
140 | } |
141 | |
0bf8a8c4 |
142 | method reset() { |
143 | $self->_clear_binds(); |
144 | } |
145 | |
cbcfedc1 |
146 | method dispatch (AST $ast) { |
f7dc4536 |
147 | |
bad761ba |
148 | my $tag = "_" . $ast->{-type}; |
0bf8a8c4 |
149 | |
cbcfedc1 |
150 | my $meth = $self->can($tag) || croak "Unknown tag '$tag'"; |
0bf8a8c4 |
151 | return $meth->($self, $ast); |
152 | } |
4769c837 |
153 | |
a0185af2 |
154 | }; |
c8c2694a |
155 | |
156 | __END__ |
157 | |
158 | =head1 NAME |
159 | |
160 | SQL::Abstract - AST based re-implementation of SQL::Abstract |
161 | |
162 | =head1 LICENSE |
163 | |
164 | =head1 AUTHORS |
165 | |
166 | Ash Berlin C<< <ash@cpan.org> >> |
167 | |
168 | =head1 LICENSE |
169 | |
170 | This program is free software; you can redistribute it and/or modify it under |
171 | the same terms as Perl itself. |
172 | |