From: Ash Berlin <ash_github@firemirror.com>
Date: Tue, 10 Mar 2009 23:03:18 +0000 (+0000)
Subject: Quoting + simple selects (and tests)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4ee32f4102e019f9d8acaa3aaaa7ce721789f73b;p=dbsrgits%2FSQL-Abstract-2.0-ish.git

Quoting + simple selects (and tests)
---

diff --git a/Makefile.PL b/Makefile.PL
index 1630685..82f6194 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -5,7 +5,7 @@ use inc::Module::Install 0.79;
 
 name 'SQL-Abstract';
 requires 'Moose' => '0.71';
-requires 'MooseX::Method::Signatures' => '0.10';
+requires 'MooseX::Method::Signatures' => '0.13_804d1448';
 requires 'MooseX::Declare' => '0.09';
 
 test_requires 'Test::More';
diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 1963975..ad9b32e 100644
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -10,7 +10,7 @@ class SQL::Abstract {
   use MooseX::Types -declare => [qw/NameSeparator/];
   use MooseX::Types::Moose qw/ArrayRef Str Int HashRef CodeRef/;
   use MooseX::AttributeHelpers;
-  use SQL::Abstract::Types qw/NameSeparator AST ArrayAST/;
+  use SQL::Abstract::Types qw/NameSeparator QuoteChars AST ArrayAST/;
 
   clean;
 
@@ -77,7 +77,7 @@ class SQL::Abstract {
   has name_separator => ( 
     is => 'rw', 
     isa => NameSeparator,
-    default => sub { ['.'] },
+    default => '.',
     coerece => 1,
     required => 1,
   );
@@ -89,6 +89,14 @@ class SQL::Abstract {
     required => 1,
   );
 
+  has quote_chars => (
+    is => 'rw', 
+    isa => QuoteChars,
+    coerece => 1,
+    predicate => 'is_quoting',
+    clearer => 'disable_quoting', 
+  );
+
   has binds => (
     isa => ArrayRef,
     is => 'ro',
diff --git a/lib/SQL/Abstract/AST/v1.pm b/lib/SQL/Abstract/AST/v1.pm
index 5a2ccc9..10c3ac3 100644
--- a/lib/SQL/Abstract/AST/v1.pm
+++ b/lib/SQL/Abstract/AST/v1.pm
@@ -28,7 +28,36 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
   }
 
   method _select(HashAST $ast) {
-    
+    # Default to requiring columns and from
+    # Once TCs give better errors, make this a SelectAST type
+    for (qw/columns from/) {
+      confess "$_ key is required (and must be an AST) to select"
+        unless is_ArrayAST($ast->{$_});
+    }
+   
+    # Check that columns is a -list
+    confess "columns key should be a -list AST, not " . $ast->{columns}[0]
+      unless $ast->{columns}[0] eq '-list';
+
+    my @output = (
+      "SELECT", 
+      $self->dispatch($ast->{columns}),
+      "FROM",
+      $self->dispatch($ast->{from})
+    );
+
+    for (qw/join/) {
+      if (exists $ast->{$_}) {
+        my $sub_ast = $ast->{$_};
+        $sub_ast->{-type} = "$_" if is_HashRef($sub_ast);
+        confess "$_ option is not an AST"
+          unless is_AST($sub_ast);
+
+        push @output, $self->dispatch($sub_ast);
+      }
+    }
+
+    return join(' ', @output);
   }
 
   method _where(ArrayAST $ast) {
@@ -58,16 +87,28 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
     my (undef, @names) = @$ast;
 
     my $sep = $self->name_separator;
+    my $quote = $self->is_quoting 
+              ? $self->quote_chars
+              : [ '' ];
+
+    my $join = $quote->[-1] . $sep . $quote->[0];
 
-    return $sep->[0] . 
-           join( $sep->[1] . $sep->[0], @names ) . 
-           $sep->[1]
-              if (@$sep > 1);
+    # We dont want to quote * in [qw/me */]: `me`.* is the desired output there
+    # This means you can't have a field called `*`. I am willing to accept this
+    # situation, cos thats a really stupid thing to want.
+    my $post;
+    $post = pop @names if $names[-1] eq '*';
 
-    return join($sep->[0], @names);
+    my $ret = 
+      $quote->[0] . 
+      join( $join, @names ) . 
+      $quote->[-1];
+
+    $ret .= $sep . $post if defined $post;
+    return $ret;
   }
 
-  method _join(HashAST $ast) {
+  method _join(HashRef $ast) {
   
     my $output = 'JOIN ' . $self->dispatch($ast->{tablespec});
 
@@ -91,6 +132,10 @@ class SQL::Abstract::AST::v1 extends SQL::Abstract {
   method _alias(ArrayAST $ast) {
     my (undef, $alias, $as) = @$ast;
 
+    confess "Not enough paremeters to -alias"
+      unless defined $as;
+
+    # TODO: Maybe we want qq{ AS "$as"} here
     return $self->dispatch($alias) . " AS $as";
 
   }
diff --git a/lib/SQL/Abstract/Types.pm b/lib/SQL/Abstract/Types.pm
index 272584d..62eecba 100644
--- a/lib/SQL/Abstract/Types.pm
+++ b/lib/SQL/Abstract/Types.pm
@@ -1,7 +1,7 @@
 use MooseX::Declare;
 class SQL::Abstract::Types {
   use Moose::Util::TypeConstraints;
-  use MooseX::Types -declare => [qw/NameSeparator AST ArrayAST HashAST/];
+  use MooseX::Types -declare => [qw/NameSeparator QuoteChars AST ArrayAST HashAST/];
   use MooseX::Types::Moose qw/ArrayRef Str Int Ref HashRef/;
 
   subtype ArrayAST, as ArrayRef,
@@ -15,11 +15,16 @@ class SQL::Abstract::Types {
   subtype AST, as ArrayAST|HashAST; 
 
   subtype NameSeparator,
+    as Str,
+    where { length($_) == 1 };
+
+
+  subtype QuoteChars,
     as ArrayRef[Str];
-    #where { @$_ == 1 ||| @$_ == 2 },
-    #message { "Name separator must be one or two elements" };
+    where { @$_ == 1 || @$_ == 2 },
+    message { "Quote characters must be one or two elements" };
 
-  coerce NameSeparator, from Str, via { [ $_ ] };
+  coerce QuoteChars, from Str, via { [ split //, $_ ] };
 
 }
 
diff --git a/t/001_basic.t b/t/001_basic.t
index 21a4cb8..95b45e2 100644
--- a/t/001_basic.t
+++ b/t/001_basic.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 9;
+use Test::More tests => 11;
 use Test::Differences;
 
 use_ok('SQL::Abstract') or BAIL_OUT( "$@" );
@@ -12,6 +12,18 @@ my $sqla = SQL::Abstract->create(1);
 is $sqla->dispatch( [ -name => qw/me id/]), "me.id",
   "Simple name generator";
 
+is $sqla->dispatch( [ -name => qw/me */]), 
+   "me.*",
+   "Simple name generator";
+
+$sqla->quote_chars(['`']);
+
+is $sqla->dispatch( [ -name => qw/me */]), 
+   "`me`.*",
+   "Simple name generator";
+
+$sqla->disable_quoting;
+
 is $sqla->dispatch(
   [ '-false' ]
 ), "0 = 1", "false value";
diff --git a/t/201_select.t b/t/201_select.t
new file mode 100644
index 0000000..5ea9c38
--- /dev/null
+++ b/t/201_select.t
@@ -0,0 +1,38 @@
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+use Test::Differences;
+
+use_ok('SQL::Abstract') or BAIL_OUT( "$@" );
+
+my $sqla = SQL::Abstract->create(1);
+
+is $sqla->dispatch(
+  { -type => 'select',
+    from => [-alias => [-name => 'foo'] => 'me' ],
+    columns => [ -list => 
+        [ -name => qw/me id/ ],
+        [ -alias => [ -name => qw/me foo_id/ ], 'foo' ],
+    ]
+  }
+), "SELECT me.id, me.foo_id AS foo FROM foo AS me",
+   "simple select clause";
+
+is $sqla->dispatch(
+  { -type => 'select',
+    from => [-alias => [-name => 'foo'] => 'me' ],
+    columns => [ -list => 
+        [ -name => qw/me id/ ],
+        [ -alias => [ -name => qw/me foo_id/ ], 'foo' ],
+        [ -name => qw/bar name/ ],
+    ],
+    join => {
+      tablespec => [-name => qw/bar/],
+      on => [ '==', [-name => qw/bar id/], [ -name => qw/me bar_id/ ] ],
+    }
+  }
+), "SELECT me.id, me.foo_id AS foo, bar.name FROM foo AS me JOIN bar ON (bar.id = me.bar_id)", 
+   "select with join clause";
+
+