e.pl

   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 _aliasify {
  64   map { ref($_) eq 'ARRAY' ? [ -alias, $_->[1], $_->[0] ] : $_ } @_
  65 }
  66
  67 sub expr (&) { _run_e(@_) }
  68 sub _do {
  69   my ($name, $code, @in) = @_;
  70   warn "eek: ${\dump @in}" if @in > 1;
  71   [ $name, _run_e($code), @in ];
  72 }
  73 sub _dolist {
  74   my ($name, $code, @in) = @_;
  75   _do($name,
  76     sub { [ -list,
  77       map { _une($_) }
  78       _aliasify $code->()
  79     ] },
  80   @in);
  81 }
  82 sub ORDER_BY (&;@) { _do(-order_by, @_) }
  83 sub SELECT (&;@) { _dolist('-select', @_); }
  84 sub JOIN (&;@) { _do('-join', shift, [ -list => _aliasify @{+shift} ], @_) }
  85 sub WHERE (&;@) { _do(-where, @_) }
  86 sub GROUP_BY (&;@) { _dolist(-group_by, @_); }
  87 sub sum { E->new([ -sum, _une(shift) ]); }
  88
  89 #warn dump(expr { $_->one == $_->two });
  90 warn dump(
  91   ORDER_BY { $_->aggregates->total }
  92     SELECT { $_->users->name, $_->aggregates->total }
  93       JOIN { $_->users->id == $_->aggregates->recipient_id }
  94         [
  95           [ users => expr { $_->users } ],
  96           [ aggregates =>
  97               expr {
  98                   SELECT { $_->recipient_id, [ total => sum($_->commission) ] }
  99                    WHERE { sum($_->commission) > 500 }
 100                 GROUP_BY { $_->recipient_id }
 101                    WHERE { $_->entry_date > '2007-01-01' }
 102                     expr { $_->commissions }
 103             }
 104           ]
 105         ]
 106 );
 107
 108 warn dump(
 109   ORDER_BY { $_->aggregates->total }
 110     SELECT { $_->users->name, $_->aggregates->total }
 111       JOIN { $_->users->id == $_->aggregates->recipient_id }
 112         [
 113           [ users => expr { $_->users  } ],
 114           [ aggregates =>
 115               expr {
 116                   SELECT { $_->recipient_id, [ total => sum($_->commission) ] }
 117                    WHERE { sum($_->commission) > 500 }
 118                 GROUP_BY { $_->recipient_id }
 119                    WHERE { $_->entry_date > '2007-01-01' }
 120                     expr { $_->commissions }
 121               }
 122           ]
 123         ]
 124 );
 125
 126 warn dump(
 127   ORDER_BY { $_->aggregates->total }
 128     SELECT { $_->users->name, $_->aggregates->total }
 129      WHERE { $_->aggregates->total > 500 }
 130       JOIN { $_->users->id == $_->aggregates->recipient_id }
 131         [
 132           [ users => expr { $_->users  } ],
 133           [ aggregates =>
 134               expr {
 135                   SELECT { $_->recipient_id, [ total => sum($_->commission) ] }
 136                 GROUP_BY { $_->recipient_id }
 137                    WHERE { $_->entry_date > '2007-01-01' }
 138                     expr { $_->commissions }
 139               }
 140           ]
 141         ]
 142 );