Commit | Line | Data |
abd9923d |
1 | use strict; |
2 | use warnings; |
3 | |
4 | { |
5 | package E; |
6 | |
7 | use overload |
8 | '==' => '_op_num_eq', |
9 | '>' => '_op_num_gt', |
10 | ; |
11 | |
12 | sub new { |
13 | my ($self, $data) = @_; |
14 | my $class = ref($self) || $self; |
15 | return bless(\$data, $class); |
16 | }; |
17 | |
18 | sub _op_num_eq { shift->_binop('==', @_) }; |
19 | sub _op_num_gt { shift->_binop('>', @_) }; |
20 | |
21 | sub _binop { |
22 | my ($self, $op, $rhs) = @_; |
23 | $self->new([ |
24 | $op, |
25 | ${$self}, |
26 | (ref $rhs ? ${$rhs} : [ -value, $rhs ]), |
27 | ]); |
28 | }; |
29 | |
30 | package I; |
31 | |
32 | sub AUTOLOAD { |
33 | our $AUTOLOAD =~ s/.*:://; |
34 | return I::E->new([ -name, $AUTOLOAD ]); |
35 | } |
36 | |
37 | sub DESTROY { } |
38 | |
39 | package I::E; |
40 | |
41 | our @ISA = qw(I E); |
42 | |
43 | 1; |
44 | } |
45 | |
46 | use Data::Dump qw(dump); |
47 | use Scalar::Util qw(blessed); |
48 | |
49 | sub _une { |
50 | my $un = shift; |
51 | blessed($un) && $un->isa('E') |
52 | ? ${$un} |
53 | : ref($un) eq 'ARRAY' |
54 | ? [ map { _une($_) } @$un ] |
55 | : $un; |
56 | } |
57 | |
58 | sub _run_e { |
59 | local $_ = bless(\do { my $x }, 'I'); |
60 | map { _une($_) } $_[0]->(); |
61 | } |
62 | |
29c7d026 |
63 | sub _aliasify { |
64 | map { ref($_) eq 'ARRAY' ? [ -alias, $_->[1], $_->[0] ] : $_ } @_ |
65 | } |
66 | |
abd9923d |
67 | sub expr (&) { _run_e(@_) } |
68 | sub _do { |
69 | my ($name, $code, @in) = @_; |
70 | [ $name, _run_e($code), @in ]; |
71 | } |
72 | sub _dolist { |
73 | my ($name, $code, @in) = @_; |
29c7d026 |
74 | _do($name, |
75 | sub { [ -list, |
76 | map { _une($_) } |
77 | _aliasify $code->() |
78 | ] }, |
79 | @in); |
abd9923d |
80 | } |
81 | sub ORDER_BY (&;@) { _do(-order_by, @_) } |
82 | sub SELECT (&;@) { _dolist('-select', @_); } |
29c7d026 |
83 | sub JOIN (&;@) { _do('-join', _aliasify @_) } |
abd9923d |
84 | sub WHERE (&;@) { _do(-where, @_) } |
85 | sub GROUP_BY (&;@) { _dolist(-group_by, @_); } |
86 | sub sum { E->new([ -sum, _une(shift) ]); } |
87 | |
88 | #warn dump(expr { $_->one == $_->two }); |
89 | warn dump( |
90 | ORDER_BY { $_->aggregates->total } |
91 | SELECT { $_->users->name, $_->aggregates->total } |
92 | JOIN { $_->users->id == $_->aggregates->recipient_id } |
93 | [ users => expr { $_->users } ], |
94 | [ aggregates => |
95 | expr { |
96 | SELECT { $_->recipient_id, [ total => sum($_->commission) ] } |
97 | WHERE { sum($_->commission) > 500 } |
98 | GROUP_BY { $_->recipient_id } |
99 | WHERE { $_->entry_date > '2007-01-01' } |
100 | expr { $_->commissions } |
101 | } |
102 | ] |
103 | ); |
252475d8 |
104 | |
105 | warn dump( |
106 | ORDER_BY { $_->aggregates->total } |
107 | SELECT { $_->users->name, $_->aggregates->total } |
108 | JOIN { $_->users->id == $_->aggregates->recipient_id } |
109 | [ users => expr { $_->users } ], |
110 | [ aggregates => |
111 | expr { |
112 | SELECT { $_->recipient_id, [ total => sum($_->commission) ] } |
113 | WHERE { sum($_->commission) > 500 } |
114 | GROUP_BY { $_->recipient_id } |
115 | WHERE { $_->entry_date > '2007-01-01' } |
116 | expr { $_->commissions } |
117 | } |
118 | ] |
119 | ); |
120 | |
121 | warn dump( |
122 | ORDER_BY { $_->aggregates->total } |
123 | SELECT { $_->users->name, $_->aggregates->total } |
124 | WHERE { $_->aggregates->total > 500 } |
125 | JOIN { $_->users->id == $_->aggregates->recipient_id } |
126 | [ users => expr { $_->users } ], |
127 | [ aggregates => |
128 | expr { |
129 | SELECT { $_->recipient_id, [ total => sum($_->commission) ] } |
130 | GROUP_BY { $_->recipient_id } |
131 | WHERE { $_->entry_date > '2007-01-01' } |
132 | expr { $_->commissions } |
133 | } |
134 | ] |
135 | ); |