use MooseX::Declare;
-
class SQL::Abstract {
use Carp qw/croak/;
use Data::Dump qw/pp/;
use Moose::Util::TypeConstraints;
- use MooseX::Types -declare => [qw/NameSeparator/];
- use MooseX::Types::Moose qw/ArrayRef Str Int HashRef/;
+ use MooseX::Types::Moose qw/ArrayRef Str Int HashRef CodeRef/;
use MooseX::AttributeHelpers;
-
- clean;
-
- subtype NameSeparator,
- as ArrayRef[Str];
- #where { @$_ == 1 ||| @$_ == 2 },
- #message { "Name separator must be one or two elements" };
-
- coerce NameSeparator, from Str, via { [ $_ ] };
+ use SQL::Abstract::Types qw/NameSeparator QuoteChars AST/;
+ use Devel::PartialDump qw/dump/;
our $VERSION = '2.000000';
);
our %BINOP_MAP = (
+
+ '+' => '+',
+ '-' => '-',
+ '/' => '/',
+ '*' => '*',
+
'>' => '>',
+ '>=' => '>=',
'<' => '<',
+ '<=' => '<=',
'==' => '=',
'!=' => '!=',
# LIKE is always "field LIKE <value>"
- '-like' => 'IN',
- '-not_like' => 'NOT LIKE',
+ 'like' => 'LIKE',
+ 'not_like' => 'NOT LIKE',
);
- has where_dispatch_table => (
+ has expr_dispatch_table => (
is => 'ro',
- lazy_build => 1,
+ lazy => 1,
+ builder => '_build_expr_dispatch_table',
+ isa => HashRef[CodeRef],
+ metaclass => 'Collection::ImmutableHash',
+ provides => {
+ get => 'lookup_expr_dispatch'
+ }
);
has binop_map => (
is => 'ro',
- lazy_build => 1,
+ lazy => 1,
+ builder => '_build_binops',
isa => HashRef,
metaclass => 'Collection::ImmutableHash',
provides => {
}
);
- sub _build_binop_map { return {%BINOP_MAP} };
+ # List of default binary operators (for in where clauses)
+ sub _build_binops { return {%BINOP_MAP} };
- method _build_where_dispatch_table {
- my $binop = $self->can('_binop');
+ method _build_expr_dispatch_table {
+ my $binop = $self->can('_binop') or croak "InternalError: $self can't do _binop!";
return {
map { $_ => $binop } $self->binary_operators
}
required => 1
);
- has name_separator => (
+ has ident_separator => (
is => 'rw',
isa => NameSeparator,
- default => sub { ['.'] },
- coerece => 1,
+ default => '.',
required => 1,
);
required => 1,
);
+ has quote_chars => (
+ is => 'rw',
+ isa => QuoteChars,
+ predicate => 'is_quoting',
+ clearer => 'disable_quoting',
+ coerce => 1,
+ );
+
has binds => (
isa => ArrayRef,
is => 'ro',
);
# TODO: once MXMS supports %args, use that here
+ # TODO: improve this so you can pass other args
method create(ClassName $class: Int $ver) {
croak "AST version $ver is greater than supported version of $AST_VERSION"
if $ver > $AST_VERSION;
}
# Main entry point
- method generate(ClassName $class: ArrayRef $ast) {
+ method generate(ClassName $class: AST $ast) {
+ my $ver = $ast->{-ast_version};
croak "SQL::Abstract AST version not specified"
- unless ($ast->[0] eq '-ast_version');
-
- my (undef, $ver) = splice(@$ast, 0, 2);
+ unless defined $ver;
# TODO: once MXMS supports %args, use that here
my $self = $class->create($ver);
$self->_clear_binds();
}
- method dispatch (ArrayRef $ast) {
+ method dispatch (AST $ast) {
- local $_ = $ast->[0];
- s/^-/_/ or croak "Unknown type tag '$_'";
+ my $tag = "_" . $ast->{-type};
- my $meth = $self->can($_) || croak "Unknown tag '$_'";
+ my $meth = $self->can($tag) || croak "Unknown tag '$tag'";
return $meth->($self, $ast);
}
};
+
+__END__
+
+=head1 NAME
+
+SQL::Abstract - AST based re-implementation of SQL::Abstract
+
+=head1 LICENSE
+
+=head1 AUTHORS
+
+Ash Berlin C<< <ash@cpan.org> >>
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+