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