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