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 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 );