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