lib/Data/Query/ExprDeclare.pm

   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;
   8
   9 use base qw(Exporter);
  10
  11 our @EXPORT = qw(
  12   expr SELECT AS FROM BY JOIN ON LEFT WHERE ORDER GROUP DESC
  13 );
  14
  15 sub expr (&) {
  16   _run_expr($_[0])->{expr};
  17 }
  18
  19 sub _run_expr {
  20   local $_ = Data::Query::ExprBuilder::Identifier->new({
  21     expr => Identifier(),
  22   });
  23   $_[0]->();
  24 }
  25
  26 sub _value {
  27   if ($_[0]->$_isa('Data::Query::ExprBuilder')) {
  28     $_[0]->{expr};
  29   } elsif (ref($_[0])) {
  30     $_[0]
  31   } else {
  32     perl_scalar_value($_[0]);
  33   }
  34 }
  35
  36 sub AS {
  37   my $as = shift;
  38   (bless(\$as, 'LIES::AS'), @_);
  39 }
  40
  41 sub SELECT (&;@) {
  42   my @select = map _value($_), _run_expr(shift);
  43   my @final;
  44   while (@select) {
  45     my $e = shift @select;
  46     push @final,
  47       (ref($select[0]) eq 'LIES::AS'
  48         ? Alias(${shift(@select)}, $e)
  49         : $e
  50      );
  51   }
  52
  53   return Select(\@final, $_[0]);
  54 }
  55
  56 sub BY (&;@) { @_ }
  57
  58 sub FROM (&;@) {
  59   my @from = _run_expr(shift);
  60   my $from_dq = do {
  61     if (@from == 2 and ref($from[1]) eq 'LIES::AS') {
  62       Alias(${$from[1]}, _value($from[0]))
  63     } elsif (@from == 1) {
  64       _value($from[0]);
  65     }
  66   };
  67   while (is_Join($_[0])) {
  68     $from_dq = { %{+shift}, left => $from_dq };
  69   }
  70   if (is_Where($_[0])) {
  71     my $where = shift->{where};
  72     if (is_Select($from_dq)) {
  73       $from_dq = Select($from_dq->{select}, Where($where, $from_dq->{from}));
  74     } else {
  75       $from_dq = Where($where, $from_dq);
  76     }
  77   }
  78   while (is_Order($_[0])) {
  79     my $order = shift;
  80     $from_dq = Order($order->{by}, $order->{reverse}, $from_dq);
  81   }
  82   return $from_dq;
  83 }
  84
  85 sub LEFT {
  86   my ($join, @rest) = @_;
  87   die "LEFT used as modifier on non-join ${join}"
  88     unless is_Join($join);
  89   return +{ %$join, outer => 'LEFT' }, @rest;
  90 }
  91
  92 sub JOIN (&;@) {
  93   my $join = FROM(\&{+shift});
  94   my $on = do {
  95     if ($_[0]->$_isa('LIES::ON')) {
  96       ${+shift}
  97     } else {
  98       undef
  99     }
 100   };
 101   Join(undef, $join, $on), @_;
 102 }
 103
 104 sub ON (&;@) {
 105   my $on = _value(_run_expr(shift));
 106   return bless(\$on, 'LIES::ON'), @_;
 107 }
 108
 109 sub WHERE (&;@) {
 110   my $w = shift;
 111   return Where(_value(_run_expr($w))), @_;
 112 }
 113
 114 sub DESC { bless({}, 'LIES::DESC'), @_ }
 115
 116 sub ORDER {
 117   my @order = map _value($_), _run_expr(shift);
 118   my $reverse = do {
 119     if ($_[0]->$_isa('LIES::DESC')) {
 120       shift; 1;
 121     } else {
 122       0;
 123     }
 124   };
 125   return compose { Order($b, $reverse, $a) } @order, undef;
 126 }
 127
 128 1;