use Moose::Util::TypeConstraints;
use MooseX::Types::Moose qw/Str ScalarRef ArrayRef HashRef/;
- use MooseX::Types -declare => [qw/LogicEnum WhereType/];
-
- enum LogicEnum, qw(OR AND);
-
- subtype WhereType, as Str;
+ use SQL::Abstract::Types::Compat ':all';
+ use SQL::Abstract::Types qw/AST/;
+ use SQL::Abstract::AST::v1;
+ use Data::Dump qw/pp/;
+ use Devel::PartialDump qw/dump/;
+ use Carp qw/croak/;
+ class_type 'SQL::Abstract';
clean;
has logic => (
is => 'rw',
isa => LogicEnum,
- default => 'AND'
+ default => 'AND',
+ coerce => 1,
+ required => 1,
+ );
+
+ has visitor => (
+ is => 'rw',
+ isa => 'SQL::Abstract',
+ clearer => 'clear_visitor',
+ lazy => 1,
+ builder => '_build_visitor',
);
+ has cmp => (
+ is => 'rw',
+ isa => 'Str',
+ default => '=',
+ required => 1,
+ );
+ our %CMP_MAP = (
+ '=' => '==',
+ );
+
+ has convert => (
+ is => 'rw',
+ isa => 'Str',
+ predicate => 'has_field_convertor'
+ );
method select(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields,
- Str|ScalarRef|ArrayRef|HashRef $where?,
- Str|ScalarRef|ArrayRef|HashRef $order?) {
- return ("", );
+ WhereType $where?,
+ WhereType $order?)
+ {
+ my $ast = $self->select_ast($from,$fields,$where,$order);
+
+ return ($self->visitor->dispatch($ast), $self->visitor->binds);
}
+ method select_ast(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields,
+ WhereType $where?,
+ WhereType $order?)
+ {
+ my $ast = {
+ -type => 'select',
+ columns => [
+ map {
+ $self->mk_name(0, $_)
+ } ( is_Str($fields) ? $fields : @$fields )
+ ],
+ tablespec => $self->tablespec($from)
+ };
- method where(Str|ScalarRef|ArrayRef|HashRef $where,
- Str|ScalarRef|ArrayRef|HashRef $order?) {
- my $ast = {
+ $ast->{where} = $self->recurse_where($where)
+ if defined $where;
+ return $ast;
+ }
+
+ method where(WhereType $where,
+ WhereType $order?)
+ {
+ my $ret = "";
+
+ if ($where) {
+ my $ast = $self->recurse_where($where);
+ $ret .= "WHERE " . $self->visitor->_expr($ast);
+ }
+
+ return $ret;
+ }
+
+ method _build_visitor() {
+ return SQL::Abstract->create(1);
+ }
+
+ sub mk_name {
+ my ($self, $use_convert) = (shift,shift);
+ my $ast = { -type => 'name', args => [ @_ ] };
+
+ return $ast
+ unless $use_convert && $self->has_field_convertor;
+
+ return $self->apply_convert($ast);
+ }
+
+ method tablespec(Str|ArrayRef|ScalarRef $from) {
+ return $self->mk_name(0, $from)
+ if is_Str($from);
+ }
+
+ method recurse_where(WhereType $ast, LogicEnum $logic?) returns (AST) {
+ return $self->recurse_where_hash($logic || 'AND', $ast) if is_HashRef($ast);
+ return $self->recurse_where_array($logic || 'OR', $ast) if is_ArrayRef($ast);
+ croak "Unknown where clause type " . dump($ast);
+ }
+
+ method recurse_where_hash(LogicEnum $logic, HashRef $ast) returns (AST) {
+ my @args;
+ my $ret = {
-type => 'expr',
+ op => lc $logic,
+ args => \@args
};
+
+ while (my ($key,$value) = each %$ast) {
+ if ($key =~ /^-(or|and)$/) {
+ my $val = $self->recurse_where($value, uc $1);
+ if ($val->{op} eq $ret->{op}) {
+ push @args, @{$val->{args}};
+ }
+ else {
+ push @args, $val;
+ }
+ next;
+ }
+
+ push @args, $self->field($key, $value);
+ }
+
+ return $args[0] if @args == 1;
+
+ return $ret;
}
- method recurse_where(LogicEsnum $where) {
-
+ method recurse_where_array(LogicEnum $logic, ArrayRef $ast) returns (AST) {
+ my @args;
+ my $ret = {
+ -type => 'expr',
+ op => lc $logic,
+ args => \@args
+ };
+ my @nodes = @$ast;
+
+ while (my $key = shift @nodes) {
+ if ($key =~ /^-(or|and)$/) {
+ my $value = shift @nodes
+ or confess "missing value after $key at " . dump($ast);
+
+ my $val = $self->recurse_where($value, uc $1);
+ if ($val->{op} eq $ret->{op}) {
+ push @args, @{$val->{args}};
+ }
+ else {
+ push @args, $val;
+ }
+ next;
+ }
+
+ push @args, $self->recurse_where($key);
+ }
+
+ return $args[0] if @args == 1;
+
+ return $ret;
}
+ method field(Str $key, $value) returns (AST) {
+ my $op = $CMP_MAP{$self->cmp} || $self->cmp;
+ my $ret = {
+ -type => 'expr',
+ op => $op,
+ args => [
+ $self->mk_name(1, $key)
+ ],
+ };
+
+ if (is_HashRef($value)) {
+ my ($op, @rest) = keys %$value;
+ confess "Don't know how to handle " . dump($value) . " (too many keys)"
+ if @rest;
+ $value = $value->{$op};
+
+ # TODO: Validate the op?
+ if ($op =~ /^-?(?:(not)[_ ])?([a-z_]+)$/i) {
+ $ret->{op} = lc $2;
+ $ret->{op} = "not_" . $ret->{op} if $1;
+
+ if (is_ArrayRef($value)) {
+ push @{$ret->{args}}, $self->value($_)
+ for @{$value};
+ return $ret;
+ }
+ }
+ else {
+ $ret->{op} = $op;
+ }
+
+ if (is_ArrayRef($value)) {
+ local $self->{cmp} = $op;
+
+ my $ast = {
+ -type => 'expr',
+ # Handle e => { '!=', [qw(f g)] }.
+ # SQLA treats this as a 'DWIM'
+ op => $op eq '!=' ? 'or' : 'and',
+ args => [ map {
+ $self->field($key, $_)
+ } @{$value} ]
+ };
+ return $ast;
+ }
+ push @{$ret->{args}}, $self->value($value);
+
+ }
+ elsif (is_ArrayRef($value)) {
+ # Return an or clause, sort of.
+ return {
+ -type => 'expr',
+ op => 'or',
+ args => [ map {
+ $self->field($key, $_)
+ } @$value ]
+ };
+ }
+ else {
+ push @{$ret->{args}}, $self->value($value);
+ }
+
+ return $ret;
+ }
+
+ method value($value) returns (AST) {
+ return $self->apply_convert( { -type => 'value', value => $value })
+ if is_Str($value);
+
+ confess "Don't know how to handle terminal value " . dump($value);
+ }
+
+ method apply_convert(AST $ast) {
+ return $ast unless $self->has_field_convertor;
+
+ return {
+ -type => 'expr',
+ op => $self->convert,
+ args => [ $ast ]
+ };
+ }
+
+
}
=head1 NAME
projects / dbsrgits/SQL-Abstract-2.0-ish.git / blobdiff