From: Ash Berlin <ash_github@firemirror.com>
Date: Tue, 3 Mar 2009 23:20:16 +0000 (+0000)
Subject: Move the AST walking code out into seperate class
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=14774be0370577482457b0a400fc7f483837677f;p=dbsrgits%2FSQL-Abstract-2.0-ish.git

Move the AST walking code out into seperate class
---

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index dafa646..eb0f2a5 100644
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -1,5 +1,4 @@
 use MooseX::Declare;
-use MooseX::Method::Signatures;
 
 
 class SQL::Abstract {
@@ -70,9 +69,15 @@ class SQL::Abstract {
     }
   );
 
-  method BUILD( $ast ) {
-    croak "AST version @{[$self->ast_version]} is greater than supported version of $AST_VERSION"
-      if $self->ast_version > $AST_VERSION;
+  # TODO: once MXMS supports %args, use that here
+  method create(ClassName $class: Int $ver) {
+    croak "AST version $ver is greater than supported version of $AST_VERSION"
+      if $ver > $AST_VERSION;
+
+    my $name = "${class}::AST::v$ver";
+    Class::MOP::load_class($name);
+
+    return $name->new(ast_version => $ver);
   }
 
   # Main entry point
@@ -82,141 +87,11 @@ class SQL::Abstract {
 
     my (undef, $ver) = splice(@$ast, 0, 2);
 
-    my $self = $class->new(ast_version => $ver);
+    # TODO: once MXMS supports %args, use that here
+    my $self = $class->create($ver);
 
     return ($self->dispatch($ast), $self->binds);
   }
 
-  method dispatch (ArrayRef $ast) {
-
-    local $_ = $ast->[0];
-    s/^-/_/g or croak "Unknown type tag '$_'";
-    my $meth = $self->can($_) || \&_generic_func;
-    return $meth->($self, $ast);
-  }
-
-  method _select(ArrayRef $ast) {
-    
-  }
-
-  method _where(ArrayRef $ast) {
-    my (undef, @clauses) = @$ast;
-  
-    return 'WHERE ' . $self->_recurse_where(\@clauses);
-  }
-
-  method _order_by(ArrayRef $ast) {
-    my (undef, @clauses) = @$ast;
-
-    my @output;
-   
-    for (@clauses) {
-      if ($_->[0] =~ /^-(asc|desc)$/) {
-        my $o = $1;
-        push @output, $self->dispatch($_->[1]) . " " . uc($o);
-        next;
-      }
-      push @output, $self->dispatch($_);
-    }
-
-    return "ORDER BY " . join(", ", @output);
-  }
-
-  method _name(ArrayRef $ast) {
-    my (undef, @names) = @$ast;
-
-    my $sep = $self->name_separator;
-
-    return $sep->[0] . 
-           join( $sep->[1] . $sep->[0], @names ) . 
-           $sep->[1]
-              if (@$sep > 1);
-
-    return join($sep->[0], @names);
-  }
-
-  method _join(ArrayRef $ast) {
-    
-  }
-
-  method _list(ArrayRef $ast) {
-    my (undef, @items) = @$ast;
-
-    return join(
-      $self->list_separator,
-      map { $self->dispatch($_) } @items);
-  }
-
-  method _alias(ArrayRef $ast) {
-    my (undef, $alias, $as) = @$ast;
-
-    return $self->dispatch($alias) . " AS $as";
-
-  }
-
-  method _value(ArrayRef $ast) {
-    my ($undef, $value) = @$ast;
-
-    $self->add_bind($value);
-    return "?";
-  }
-
-  method _recurse_where($clauses) {
-
-    my $OP = 'AND';
-    my $prio = $PRIO{and};
-    my $first = $clauses->[0];
-
-    if (!ref $first && $first =~ /^-(and|or)$/) {
-      $OP = uc($1);
-      $prio = $PRIO{$1};
-      shift @$clauses;
-    }
-
-    my @output;
-    foreach (@$clauses) {
-      croak "invalid component in where clause" unless ArrayRef->check($_);
-      my $op = $_->[0];
-
-      unless (substr($op, 0, 1) eq '-') {
-        # A simple comparison op (==, >, etc.)
-        
-        push @output, $self->_binop(@$_);
-        
-      } elsif ($op =~ /^-(and|or)$/) {
-        my $sub_prio = $PRIO{$1}; 
-
-        if ($sub_prio <= $prio) {
-          push @output, $self->_recurse_where($_);
-        } else {
-          push @output, '(' . $self->_recurse_where($_) . ')';
-        }
-      } else {
-        push @output, $self->dispatch($_);
-      }
-    }
-
-    return join(" $OP ", @output);
-  }
-
-  method _binop($op, $lhs, $rhs) {
-    join (' ', $self->dispatch($lhs), 
-               $OP_MAP{$op} || croak("Unknown binary operator $op"),
-               $self->dispatch($rhs)
-    );
-  }
-
-  method _in($ast) {
-    my (undef, $field, @values) = @$ast;
-
-    return $self->dispatch($field) .
-           " IN (" .
-           join(", ", map { $self->dispatch($_) } @values ) .
-           ")";
-  }
-
-  method _generic_func(ArrayRef $ast) {
-  }
-
 
 };
diff --git a/lib/SQL/Abstract/AST/v1.pm b/lib/SQL/Abstract/AST/v1.pm
new file mode 100644
index 0000000..4040104
--- /dev/null
+++ b/lib/SQL/Abstract/AST/v1.pm
@@ -0,0 +1,146 @@
+use MooseX::Declare;
+
+class SQL::Abstract::AST::v1 extends 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/;
+  use MooseX::AttributeHelpers;
+
+  clean;
+
+  method dispatch (ArrayRef $ast) {
+
+    local $_ = $ast->[0];
+    s/^-/_/g or croak "Unknown type tag '$_'";
+    my $meth = $self->can($_) || \&_generic_func;
+    return $meth->($self, $ast);
+  }
+
+  method _select(ArrayRef $ast) {
+    
+  }
+
+  method _where(ArrayRef $ast) {
+    my (undef, @clauses) = @$ast;
+  
+    return 'WHERE ' . $self->_recurse_where(\@clauses);
+  }
+
+  method _order_by(ArrayRef $ast) {
+    my (undef, @clauses) = @$ast;
+
+    my @output;
+   
+    for (@clauses) {
+      if ($_->[0] =~ /^-(asc|desc)$/) {
+        my $o = $1;
+        push @output, $self->dispatch($_->[1]) . " " . uc($o);
+        next;
+      }
+      push @output, $self->dispatch($_);
+    }
+
+    return "ORDER BY " . join(", ", @output);
+  }
+
+  method _name(ArrayRef $ast) {
+    my (undef, @names) = @$ast;
+
+    my $sep = $self->name_separator;
+
+    return $sep->[0] . 
+           join( $sep->[1] . $sep->[0], @names ) . 
+           $sep->[1]
+              if (@$sep > 1);
+
+    return join($sep->[0], @names);
+  }
+
+  method _join(ArrayRef $ast) {
+    
+  }
+
+  method _list(ArrayRef $ast) {
+    my (undef, @items) = @$ast;
+
+    return join(
+      $self->list_separator,
+      map { $self->dispatch($_) } @items);
+  }
+
+  method _alias(ArrayRef $ast) {
+    my (undef, $alias, $as) = @$ast;
+
+    return $self->dispatch($alias) . " AS $as";
+
+  }
+
+  method _value(ArrayRef $ast) {
+    my ($undef, $value) = @$ast;
+
+    $self->add_bind($value);
+    return "?";
+  }
+
+  method _recurse_where($clauses) {
+
+    my $OP = 'AND';
+    my $prio = $SQL::Abstract::PRIO{and};
+    my $first = $clauses->[0];
+
+    if (!ref $first && $first =~ /^-(and|or)$/) {
+      $OP = uc($1);
+      $prio = $SQL::Abstract::PRIO{$1};
+      shift @$clauses;
+    }
+
+    my @output;
+    foreach (@$clauses) {
+      croak "invalid component in where clause" unless ArrayRef->check($_);
+      my $op = $_->[0];
+
+      unless (substr($op, 0, 1) eq '-') {
+        # A simple comparison op (==, >, etc.)
+        
+        push @output, $self->_binop(@$_);
+        
+      } elsif ($op =~ /^-(and|or)$/) {
+        my $sub_prio = $SQL::Abstract::PRIO{$1}; 
+
+        if ($sub_prio <= $prio) {
+          push @output, $self->_recurse_where($_);
+        } else {
+          push @output, '(' . $self->_recurse_where($_) . ')';
+        }
+      } else {
+        push @output, $self->dispatch($_);
+      }
+    }
+
+    return join(" $OP ", @output);
+  }
+
+  method _binop($op, $lhs, $rhs) {
+    join (' ', $self->dispatch($lhs), 
+               $SQL::Abstract::OP_MAP{$op} || croak("Unknown binary operator $op"),
+               $self->dispatch($rhs)
+    );
+  }
+
+  method _in($ast) {
+    my (undef, $field, @values) = @$ast;
+
+    return $self->dispatch($field) .
+           " IN (" .
+           join(", ", map { $self->dispatch($_) } @values ) .
+           ")";
+  }
+
+  method _generic_func(ArrayRef $ast) {
+  }
+
+}
diff --git a/t/001_basic.t b/t/001_basic.t
index a482a6d..ce0bb8f 100644
--- a/t/001_basic.t
+++ b/t/001_basic.t
@@ -6,7 +6,8 @@ use Test::Differences;
 
 use_ok('SQL::Abstract') or BAIL_OUT( "$@" );
 
-my $sqla = SQL::Abstract->new(ast_version => 1);
+# TODO: once MXMS supports %args, use that here
+my $sqla = SQL::Abstract->create(1);
 is $sqla->dispatch( [ -name => qw/me id/]), "me.id",
   "Simple name generator";