use Moose::Util::TypeConstraints;
use MooseX::Types::Moose qw/Str ScalarRef ArrayRef HashRef/;
use SQL::Abstract::Types::Compat ':all';
- use SQL::Abstract::Types qw/AST/;
+ use SQL::Abstract::Types qw/AST NameSeparator QuoteChars/;
use SQL::Abstract::AST::v1;
use Data::Dump qw/pp/;
use Devel::PartialDump qw/dump/;
'=' => '==',
);
+ has convert => (
+ is => 'rw',
+ isa => 'Str',
+ predicate => 'has_field_convertor'
+ );
+
+ # TODO: a metaclass trait to automatically use this on vistior construction
+ has quote_char => (
+ is => 'rw',
+ isa => QuoteChars,
+ coerce => 1,
+ predicate => "has_quote_chars"
+ );
+
+ has name_sep => (
+ is => 'rw',
+ isa => NameSeparator,
+ predicate => "has_name_sep"
+ );
+
+ method _build_visitor() {
+ my %args = (
+ ast_version => 1
+ );
+ $args{quote_chars} = $self->quote_char
+ if $self->has_quote_chars;
+ $args{name_sep} = $self->name_sep
+ if $self->has_name_sep;
+
+ # TODO: this needs improving along with SQL::A::create
+ my $visitor = SQL::Abstract::AST::v1->new(%args);
+ }
+
method select(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields,
WhereType $where?,
WhereType $order?)
{
+ my $ast = $self->select_ast($from,$fields,$where,$order);
+
+ $DB::single = 1;
+ 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($_)
+ $self->mk_name(0, $_)
} ( is_Str($fields) ? $fields : @$fields )
],
tablespec => $self->tablespec($from)
$ast->{where} = $self->recurse_where($where)
if defined $where;
- return ($self->visitor->dispatch($ast), $self->visitor->binds);
+ if (defined $order) {
+ my @order = is_ArrayRef($order) ? @$order : $order;
+ $ast->{order_by} = [ map { $self->mk_name(0, $_) } @order ];
+ }
+
+ return $ast;
}
method where(WhereType $where,
return $ret;
}
- method _build_visitor() {
- return SQL::Abstract->create(1);
- }
+ # method mk_name(Bool $use_convert, Str @names) {
sub mk_name {
- shift;
- return { -type => 'name', args => [ @_ ] };
+ my ($self, $use_convert, @names) = @_;
+
+ @names = split /\Q@{[$self->name_sep]}\E/, $names[0]
+ if (@names == 1 && $self->has_name_sep);
+
+ my $ast = { -type => 'name', args => [ @names ] };
+
+ return $ast
+ unless $use_convert && $self->has_field_convertor;
+
+ return $self->apply_convert($ast);
}
method tablespec(Str|ArrayRef|ScalarRef $from) {
- return $self->mk_name($from)
+ return $self->mk_name(0, $from)
if is_Str($from);
+
+ return {
+ -type => 'list',
+ args => [ map {
+ $self->mk_name(0, $_)
+ } @$from ]
+ };
}
method recurse_where(WhereType $ast, LogicEnum $logic?) returns (AST) {
croak "Unknown where clause type " . dump($ast);
}
+ # Deals with where({ .... }) case
method recurse_where_hash(LogicEnum $logic, HashRef $ast) returns (AST) {
my @args;
my $ret = {
args => \@args
};
- while (my ($key,$value) = each %$ast) {
+ for my $key ( sort keys %$ast ) {
+ my $value = $ast->{$key};
+
if ($key =~ /^-(or|and)$/) {
my $val = $self->recurse_where($value, uc $1);
if ($val->{op} eq $ret->{op}) {
return $ret;
}
+ # Deals with where([ .... ]) case
method recurse_where_array(LogicEnum $logic, ArrayRef $ast) returns (AST) {
my @args;
my $ret = {
return $ret;
}
- method field(Str $key, $value) returns (AST) {
- my $op = $CMP_MAP{$self->cmp} || $self->cmp;
+ # { field => { .... } } case
+ method field_hash(Str $key, HashRef $value) returns (AST) {
+ my ($op, @rest) = keys %$value;
+
+ confess "Don't know how to handle " . dump($value) . " (too many keys)"
+ if @rest;
+
+ $value = $value->{$op};
+
my $ret = {
-type => 'expr',
op => $op,
args => [
- { -type => 'name', args => [$key] }
+ $self->mk_name(1, $key)
],
};
+ $ret->{op} = $op;
- if (is_HashRef($value)) {
- my ($op, @rest) = keys %$value;
- confess "Don't know how to handle " . dump($value) . " (too many keys)"
- if @rest;
-
- # TODO: Validate the op?
- if ($op =~ /^-([a-z_]+)$/i) {
- $ret->{op} = lc $1;
-
- if (is_ArrayRef($value->{$op})) {
- push @{$ret->{args}}, $self->value($_)
- for @{$value->{$op}};
- return $ret;
- }
- }
- else {
- $ret->{op} = $op;
- }
+ # TODO: Validate the op?
+ # 'word_like' operator
+ if ($op =~ /^-?(?:(not)[_ ])?([a-z_]+)$/i) {
+ $ret->{op} = lc $2;
+ $ret->{op} = "not_" . $ret->{op} if $1;
- push @{$ret->{args}}, $self->value($value->{$op});
+ if (is_ArrayRef($value)) {
+ push @{$ret->{args}}, $self->value($_) for @{$value};
+ return $ret;
+ }
}
- elsif (is_ArrayRef($value)) {
- # Return an or clause, sort of.
- return {
+
+ # Cases like:
+ # field => { '!=' => [ 'a','b','c'] }
+ # field => { '<' => [ 'a','b','c'] }
+ #
+ # *not* when op is a work or function operator - basic cmp operator only
+ if (is_ArrayRef($value)) {
+ local $self->{cmp} = $op;
+
+ my $ast = {
-type => 'expr',
op => 'or',
args => [ map {
- {
- -type => 'expr',
- op => $op,
- args => [
- { -type => 'name', args => [$key] },
- $self->value($_)
- ],
- }
- } @$value ]
+ $self->field($key, $_)
+ } @{$value} ]
};
+ return $ast;
+ }
+
+
+ push @{$ret->{args}}, $self->value($value);
+ return $ret;
+ }
+
+ # Handle [ { ... }, { ... } ]
+ method field_array(Str $key, ArrayRef $value) {
+ # Return an or clause, sort of.
+ return {
+ -type => 'expr',
+ op => 'or',
+ args => [ map {
+ $self->field($key, $_)
+ } @$value ]
+ };
+ }
+
+ method field(Str $key, $value) returns (AST) {
+
+ if (is_HashRef($value)) {
+ return $self->field_hash($key, $value);
}
- else {
- push @{$ret->{args}}, $self->value($value);
+ elsif (is_ArrayRef($value)) {
+ return $self->field_array($key, $value);
}
+ my $ret = {
+ -type => 'expr',
+ op => $CMP_MAP{$self->cmp} || $self->cmp,
+ args => [
+ $self->mk_name(1, $key),
+ $self->value($value)
+ ],
+ };
+
return $ret;
}
method value($value) returns (AST) {
- return { -type => 'value', value => $value }
+ 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 ]
+ };
+ }
+
}
projects / dbsrgits/SQL-Abstract-2.0-ish.git / blobdiff