Commit | Line | Data |
aad6ee1b |
1 | package Data::Query::ExprDeclare; |
2 | |
3 | use strictures; |
4 | use Data::Query::ExprBuilder::Identifier; |
5 | use Data::Query::ExprHelpers; |
6 | use Data::Query::Constants; |
7 | use Safe::Isa; |
e3714aad |
8 | use Exporter (); |
aad6ee1b |
9 | |
e3714aad |
10 | sub import { |
11 | warnings->unimport('precedence'); |
12 | goto &Exporter::import; |
13 | } |
aad6ee1b |
14 | |
0875b420 |
15 | our @EXPORT = qw(expr); |
16 | |
17 | our @EXPORT_OK = qw( |
18 | SELECT AS FROM BY JOIN ON LEFT WHERE ORDER GROUP DESC LIMIT OFFSET NULLS FIRST LAST |
9f0ad8f6 |
19 | ); |
aad6ee1b |
20 | |
21 | sub expr (&) { |
0875b420 |
22 | _run_expr($_[0]); |
aad6ee1b |
23 | } |
24 | |
25 | sub _run_expr { |
26 | local $_ = Data::Query::ExprBuilder::Identifier->new({ |
27 | expr => Identifier(), |
28 | }); |
29 | $_[0]->(); |
30 | } |
31 | |
32 | sub _value { |
4e0c6139 |
33 | if ($_[0]->$_isa('Data::Query::ExprBuilder')) { |
34 | $_[0]->{expr}; |
35 | } elsif (ref($_[0])) { |
36 | $_[0] |
37 | } else { |
38 | perl_scalar_value($_[0]); |
39 | } |
aad6ee1b |
40 | } |
41 | |
42 | sub AS { |
43 | my $as = shift; |
44 | (bless(\$as, 'LIES::AS'), @_); |
45 | } |
46 | |
47 | sub SELECT (&;@) { |
48 | my @select = map _value($_), _run_expr(shift); |
49 | my @final; |
50 | while (@select) { |
51 | my $e = shift @select; |
52 | push @final, |
53 | (ref($select[0]) eq 'LIES::AS' |
54 | ? Alias(${shift(@select)}, $e) |
55 | : $e |
56 | ); |
57 | } |
49299143 |
58 | |
d2773428 |
59 | my $final = Select(\@final, shift); |
60 | |
61 | if (is_Slice($_[0])) { |
62 | my ($limit, $offset) = @{+shift}{qw(limit offset)}; |
63 | $final = Slice($offset, $limit, $final); |
64 | } |
65 | |
66 | return $final; |
aad6ee1b |
67 | } |
68 | |
69 | sub BY (&;@) { @_ } |
70 | |
71 | sub FROM (&;@) { |
72 | my @from = _run_expr(shift); |
73 | my $from_dq = do { |
74 | if (@from == 2 and ref($from[1]) eq 'LIES::AS') { |
75 | Alias(${$from[1]}, _value($from[0])) |
76 | } elsif (@from == 1) { |
77 | _value($from[0]); |
78 | } |
79 | }; |
4e0c6139 |
80 | while (is_Join($_[0])) { |
aad6ee1b |
81 | $from_dq = { %{+shift}, left => $from_dq }; |
82 | } |
4e0c6139 |
83 | if (is_Where($_[0])) { |
9f0ad8f6 |
84 | my $where = shift->{where}; |
85 | if (is_Select($from_dq)) { |
86 | $from_dq = Select($from_dq->{select}, Where($where, $from_dq->{from})); |
87 | } else { |
88 | $from_dq = Where($where, $from_dq); |
89 | } |
90 | } |
91 | while (is_Order($_[0])) { |
92 | my $order = shift; |
e3335558 |
93 | $from_dq = Order($order->{by}, $order->{reverse}, $order->{nulls}, $from_dq); |
4e0c6139 |
94 | } |
d2773428 |
95 | return ($from_dq, @_); |
aad6ee1b |
96 | } |
97 | |
98 | sub LEFT { |
99 | my ($join, @rest) = @_; |
100 | die "LEFT used as modifier on non-join ${join}" |
101 | unless is_Join($join); |
102 | return +{ %$join, outer => 'LEFT' }, @rest; |
103 | } |
104 | |
105 | sub JOIN (&;@) { |
d2773428 |
106 | my ($join) = FROM(\&{+shift}); |
aad6ee1b |
107 | my $on = do { |
108 | if ($_[0]->$_isa('LIES::ON')) { |
109 | ${+shift} |
110 | } else { |
111 | undef |
112 | } |
113 | }; |
114 | Join(undef, $join, $on), @_; |
115 | } |
116 | |
117 | sub ON (&;@) { |
118 | my $on = _value(_run_expr(shift)); |
119 | return bless(\$on, 'LIES::ON'), @_; |
120 | } |
121 | |
122 | sub WHERE (&;@) { |
123 | my $w = shift; |
124 | return Where(_value(_run_expr($w))), @_; |
125 | } |
126 | |
9f0ad8f6 |
127 | sub DESC { bless({}, 'LIES::DESC'), @_ } |
e3335558 |
128 | sub NULLS { bless(\shift, 'LIES::NULLS'), @_ } |
129 | sub FIRST { 1, @_ } |
130 | sub LAST { -1, @_ } |
9f0ad8f6 |
131 | |
132 | sub ORDER { |
133 | my @order = map _value($_), _run_expr(shift); |
134 | my $reverse = do { |
135 | if ($_[0]->$_isa('LIES::DESC')) { |
136 | shift; 1; |
137 | } else { |
138 | 0; |
139 | } |
140 | }; |
e3335558 |
141 | my $nulls = $_[0]->$_isa('LIES::NULLS') ? ${+shift} : undef; |
142 | |
143 | return ((compose { Order($b, $reverse, $nulls, $a) } @order, undef), @_); |
d2773428 |
144 | } |
145 | |
146 | sub LIMIT (&;@) { |
147 | my ($limit) = map _value($_), _run_expr(shift); |
148 | if (is_Slice($_[0])) { |
149 | my $slice = shift; |
150 | return +{ %{$slice}, limit => $limit }, @_; |
151 | } |
152 | return Slice(undef, $limit), @_; |
153 | } |
154 | |
155 | sub OFFSET (&;@) { |
156 | my ($offset) = map _value($_), _run_expr(shift); |
157 | return Slice($offset, undef), @_; |
9f0ad8f6 |
158 | } |
159 | |
aad6ee1b |
160 | 1; |