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 | |
63 | sub expr (&) { _run_e(@_) } |
64 | sub _do { |
65 | my ($name, $code, @in) = @_; |
66 | [ $name, _run_e($code), @in ]; |
67 | } |
68 | sub _dolist { |
69 | my ($name, $code, @in) = @_; |
70 | _do($name, sub { [ -list, map { _une($_) } $code->() ] }, @in); |
71 | } |
72 | sub ORDER_BY (&;@) { _do(-order_by, @_) } |
73 | sub SELECT (&;@) { _dolist('-select', @_); } |
74 | sub JOIN (&;@) { _do('-join', @_) } |
75 | sub WHERE (&;@) { _do(-where, @_) } |
76 | sub GROUP_BY (&;@) { _dolist(-group_by, @_); } |
77 | sub sum { E->new([ -sum, _une(shift) ]); } |
78 | |
79 | #warn dump(expr { $_->one == $_->two }); |
80 | warn dump( |
81 | ORDER_BY { $_->aggregates->total } |
82 | SELECT { $_->users->name, $_->aggregates->total } |
83 | JOIN { $_->users->id == $_->aggregates->recipient_id } |
84 | [ users => expr { $_->users } ], |
85 | [ aggregates => |
86 | expr { |
87 | SELECT { $_->recipient_id, [ total => sum($_->commission) ] } |
88 | WHERE { sum($_->commission) > 500 } |
89 | GROUP_BY { $_->recipient_id } |
90 | WHERE { $_->entry_date > '2007-01-01' } |
91 | expr { $_->commissions } |
92 | } |
93 | ] |
94 | ); |
252475d8 |
95 | |
96 | warn dump( |
97 | ORDER_BY { $_->aggregates->total } |
98 | SELECT { $_->users->name, $_->aggregates->total } |
99 | JOIN { $_->users->id == $_->aggregates->recipient_id } |
100 | [ users => expr { $_->users } ], |
101 | [ aggregates => |
102 | expr { |
103 | SELECT { $_->recipient_id, [ total => sum($_->commission) ] } |
104 | WHERE { sum($_->commission) > 500 } |
105 | GROUP_BY { $_->recipient_id } |
106 | WHERE { $_->entry_date > '2007-01-01' } |
107 | expr { $_->commissions } |
108 | } |
109 | ] |
110 | ); |
111 | |
112 | warn dump( |
113 | ORDER_BY { $_->aggregates->total } |
114 | SELECT { $_->users->name, $_->aggregates->total } |
115 | WHERE { $_->aggregates->total > 500 } |
116 | JOIN { $_->users->id == $_->aggregates->recipient_id } |
117 | [ users => expr { $_->users } ], |
118 | [ aggregates => |
119 | expr { |
120 | SELECT { $_->recipient_id, [ total => sum($_->commission) ] } |
121 | GROUP_BY { $_->recipient_id } |
122 | WHERE { $_->entry_date > '2007-01-01' } |
123 | expr { $_->commissions } |
124 | } |
125 | ] |
126 | ); |