add more attributes

[dbsrgits/Data-Query.git] / t / expr.include

use strictures 1;
use Data::Query::ExprBuilder::Identifier;
use Data::Query::Constants qw(
  DQ_SELECT DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE DQ_ALIAS
);
use Data::Query::ExprHelpers qw(perl_scalar_value identifier);

sub expr (&) {
  _run_expr($_[0])->{expr};
}

sub _run_expr {
  local $_ = Data::Query::ExprBuilder::Identifier->new({
    expr => identifier()
  });
  $_[0]->();
}

sub AS {
  my $as = shift;
  (bless(\$as, 'LIES::AS'), @_);
}

sub SELECT (&;@) {
  my @select = map +(
    ref()
      ? $_
      : { expr => perl_scalar_value($_) }
  ), _run_expr(shift);
  my @final;
  while (@select) {
    my $e = shift @select;
    push @final,
      (ref($select[0]) eq 'LIES::AS'
        ? +{
             type => DQ_ALIAS,
             alias => $e->{expr},
             as => ${shift(@select)}
          }
        : $e->{expr}
     );
  }
      
  return +{
    expr => {
      type => DQ_SELECT,
      select => \@final
    },
    @_ ? (from => $_[0]->{expr}) : ()
  };
}

sub BY (&;@) { @_ }

sub FROM (&;@) {
  my @from = _run_expr(shift);
  if (@from == 2 and ref($from[1]) eq 'LIES::AS') {
    return +{
      expr => {
        type => DQ_ALIAS,
        source => $from[0],
        alias => identifier(${$from[1]}),
      }
    };
  } elsif (@from == 1) {
    return { expr => $from[0] };
  }
  die "Huh?"
}

1;