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 LIMIT OFFSET NULLS FIRST LAST
  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   my $final = Select(\@final, shift);
  54
  55   if (is_Slice($_[0])) {
  56     my ($limit, $offset) = @{+shift}{qw(limit offset)};
  57     $final = Slice($offset, $limit, $final);
  58   }
  59
  60   return $final;
  61 }
  62
  63 sub BY (&;@) { @_ }
  64
  65 sub FROM (&;@) {
  66   my @from = _run_expr(shift);
  67   my $from_dq = do {
  68     if (@from == 2 and ref($from[1]) eq 'LIES::AS') {
  69       Alias(${$from[1]}, _value($from[0]))
  70     } elsif (@from == 1) {
  71       _value($from[0]);
  72     }
  73   };
  74   while (is_Join($_[0])) {
  75     $from_dq = { %{+shift}, left => $from_dq };
  76   }
  77   if (is_Where($_[0])) {
  78     my $where = shift->{where};
  79     if (is_Select($from_dq)) {
  80       $from_dq = Select($from_dq->{select}, Where($where, $from_dq->{from}));
  81     } else {
  82       $from_dq = Where($where, $from_dq);
  83     }
  84   }
  85   while (is_Order($_[0])) {
  86     my $order = shift;
  87     $from_dq = Order($order->{by}, $order->{reverse}, $order->{nulls}, $from_dq);
  88   }
  89   return ($from_dq, @_);
  90 }
  91
  92 sub LEFT {
  93   my ($join, @rest) = @_;
  94   die "LEFT used as modifier on non-join ${join}"
  95     unless is_Join($join);
  96   return +{ %$join, outer => 'LEFT' }, @rest;
  97 }
  98
  99 sub JOIN (&;@) {
 100   my ($join) = FROM(\&{+shift});
 101   my $on = do {
 102     if ($_[0]->$_isa('LIES::ON')) {
 103       ${+shift}
 104     } else {
 105       undef
 106     }
 107   };
 108   Join(undef, $join, $on), @_;
 109 }
 110
 111 sub ON (&;@) {
 112   my $on = _value(_run_expr(shift));
 113   return bless(\$on, 'LIES::ON'), @_;
 114 }
 115
 116 sub WHERE (&;@) {
 117   my $w = shift;
 118   return Where(_value(_run_expr($w))), @_;
 119 }
 120
 121 sub DESC { bless({}, 'LIES::DESC'), @_ }
 122 sub NULLS { bless(\shift, 'LIES::NULLS'), @_ }
 123 sub FIRST { 1, @_ }
 124 sub LAST { -1, @_ }
 125
 126 sub ORDER {
 127   my @order = map _value($_), _run_expr(shift);
 128   my $reverse = do {
 129     if ($_[0]->$_isa('LIES::DESC')) {
 130       shift; 1;
 131     } else {
 132       0;
 133     }
 134   };
 135   my $nulls = $_[0]->$_isa('LIES::NULLS') ? ${+shift} : undef;
 136
 137   return ((compose { Order($b, $reverse, $nulls, $a) } @order, undef), @_);
 138 }
 139
 140 sub LIMIT (&;@) {
 141   my ($limit) = map _value($_), _run_expr(shift);
 142   if (is_Slice($_[0])) {
 143     my $slice = shift;
 144     return +{ %{$slice}, limit => $limit }, @_;
 145   }
 146   return Slice(undef, $limit), @_;
 147 }
 148
 149 sub OFFSET (&;@) {
 150   my ($offset) = map _value($_), _run_expr(shift);
 151   return Slice($offset, undef), @_;
 152 }
 153
 154 1;