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; |
a464be15 |
11 | use SQL::Abstract::Types qw/NameSeparator QuoteChars AST HashAST ArrayAST/; |
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 = ( |
3e63a4d5 |
27 | '>' => '>', |
28 | '<' => '<', |
29 | '==' => '=', |
30 | '!=' => '!=', |
0bf8a8c4 |
31 | # LIKE is always "field LIKE <value>" |
1b85673a |
32 | '-like' => 'LIKE', |
0bf8a8c4 |
33 | '-not_like' => 'NOT LIKE', |
3e63a4d5 |
34 | ); |
35 | |
ef0d6124 |
36 | has expr_dispatch_table => ( |
0bf8a8c4 |
37 | is => 'ro', |
eb22ecd3 |
38 | lazy => 1, |
ef0d6124 |
39 | builder => '_build_expr_dispatch_table', |
0c371882 |
40 | isa => HashRef[CodeRef], |
41 | metaclass => 'Collection::ImmutableHash', |
42 | provides => { |
ef0d6124 |
43 | get => 'lookup_expr_dispatch' |
0c371882 |
44 | } |
0bf8a8c4 |
45 | ); |
46 | |
47 | has binop_map => ( |
48 | is => 'ro', |
eb22ecd3 |
49 | lazy => 1, |
50 | builder => '_build_binops', |
0bf8a8c4 |
51 | isa => HashRef, |
52 | metaclass => 'Collection::ImmutableHash', |
53 | provides => { |
54 | exists => 'is_valid_binop', |
55 | get => 'binop_mapping', |
56 | keys => 'binary_operators' |
57 | } |
58 | ); |
59 | |
eb22ecd3 |
60 | # List of default binary operators (for in where clauses) |
61 | sub _build_binops { return {%BINOP_MAP} }; |
0bf8a8c4 |
62 | |
ef0d6124 |
63 | method _build_expr_dispatch_table { |
0c371882 |
64 | my $binop = $self->can('_binop') or croak "InternalError: $self can't do _binop!"; |
0bf8a8c4 |
65 | return { |
66 | map { $_ => $binop } $self->binary_operators |
67 | } |
68 | } |
69 | |
c314b35d |
70 | has ast_version => ( |
71 | is => 'ro', |
72 | isa => Int, |
73 | required => 1 |
74 | ); |
75 | |
a0185af2 |
76 | has name_separator => ( |
77 | is => 'rw', |
78 | isa => NameSeparator, |
4ee32f41 |
79 | default => '.', |
a0185af2 |
80 | required => 1, |
81 | ); |
82 | |
83 | has list_separator => ( |
84 | is => 'rw', |
85 | isa => Str, |
86 | default => ', ', |
87 | required => 1, |
88 | ); |
89 | |
4ee32f41 |
90 | has quote_chars => ( |
91 | is => 'rw', |
92 | isa => QuoteChars, |
4ee32f41 |
93 | predicate => 'is_quoting', |
94 | clearer => 'disable_quoting', |
8eda2119 |
95 | coerce => 1, |
4ee32f41 |
96 | ); |
97 | |
4769c837 |
98 | has binds => ( |
99 | isa => ArrayRef, |
5bf8c024 |
100 | is => 'ro', |
0bf8a8c4 |
101 | clearer => '_clear_binds', |
102 | lazy => 1, |
4769c837 |
103 | default => sub { [ ] }, |
104 | metaclass => 'Collection::Array', |
105 | provides => { |
106 | push => 'add_bind', |
4769c837 |
107 | } |
108 | ); |
109 | |
14774be0 |
110 | # TODO: once MXMS supports %args, use that here |
111 | method create(ClassName $class: Int $ver) { |
112 | croak "AST version $ver is greater than supported version of $AST_VERSION" |
113 | if $ver > $AST_VERSION; |
114 | |
115 | my $name = "${class}::AST::v$ver"; |
116 | Class::MOP::load_class($name); |
117 | |
118 | return $name->new(ast_version => $ver); |
c314b35d |
119 | } |
120 | |
121 | # Main entry point |
a464be15 |
122 | method generate(ClassName $class: HashAST $ast) { |
123 | my $ver = $ast->{-ast_version}; |
c314b35d |
124 | croak "SQL::Abstract AST version not specified" |
a464be15 |
125 | unless defined $ver; |
c314b35d |
126 | |
14774be0 |
127 | # TODO: once MXMS supports %args, use that here |
128 | my $self = $class->create($ver); |
c314b35d |
129 | |
130 | return ($self->dispatch($ast), $self->binds); |
131 | } |
132 | |
0bf8a8c4 |
133 | method reset() { |
134 | $self->_clear_binds(); |
135 | } |
136 | |
cbcfedc1 |
137 | method dispatch (AST $ast) { |
f7dc4536 |
138 | |
139 | |
cbcfedc1 |
140 | # I want multi methods! |
141 | my $tag; |
142 | if (is_ArrayAST($ast)) { |
747f7c21 |
143 | confess "FIX: " . dump($ast); |
cbcfedc1 |
144 | } else { |
145 | $tag = "_" . $ast->{-type}; |
146 | } |
0bf8a8c4 |
147 | |
cbcfedc1 |
148 | my $meth = $self->can($tag) || croak "Unknown tag '$tag'"; |
0bf8a8c4 |
149 | return $meth->($self, $ast); |
150 | } |
4769c837 |
151 | |
a0185af2 |
152 | }; |