[Bast-commits] r9529 - SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract

[dhoss at dev.catalyst.perl.org]

Author: dhoss
Date: 2010-06-01 23:31:03 +0100 (Tue, 01 Jun 2010)
New Revision: 9529

Modified:
   SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Tree.pm
Log:
more Tree unfuckery

Modified: SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Tree.pm
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Tree.pm	2010-06-01 22:19:53 UTC (rev 9528)
+++ SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Tree.pm	2010-06-01 22:31:03 UTC (rev 9529)
@@ -53,7 +53,7 @@
 my $stuff_around_mathops =  qr/[\w\s\`\'\"\)]/;
 
 
-my $binary_op_keywords =  (
+my @binary_op_keywords =  (
         map {
             ' ^ ' . quotemeta($_) . "(?= \$ | " . $stuff_around_mathops . " ) ",
               " (?<= "
@@ -72,22 +72,17 @@
 
 
 
-my $tokenizer_re_str = sub {
-    my @expr = @expression_terminator_sql_keywords;
-    my @binops = $binary_op_keywords;
-    return join( "\n\t|\n", ( map { '\b' . $_ . '\b' } @expr, 'AND', 'OR', 'NOT' ), @binops );
-};
+my $tokenizer_re_str = join("\n\t|\n",
+  ( map { '\b' . $_ . '\b' } @expression_terminator_sql_keywords, 'AND', 'OR', 'NOT'),
+    @binary_op_keywords,
+    );
 
+my $tokenizer_re = qr/ \s* ( $tokenizer_re_str | \( | \) | \? ) \s* /xi;
 
-my $tokenizer_re = sub {
-    my $re   = $tokenizer_re_str;
-    return qr/ \s* ( $re | \( | \) | \? ) \s* /xi;
-};
 
+my  @unrollable_ops =( 'ON', 'WHERE', 'GROUP \s+ BY', 'HAVING', 'ORDER \s+ BY', );
 
-my  $unrollable_ops =( 'ON', 'WHERE', 'GROUP \s+ BY', 'HAVING', 'ORDER \s+ BY', );
 
-
 # Parser states for _recurse_parse()
 use constant PARSE_TOP_LEVEL => 0;
 use constant PARSE_IN_EXPR   => 1;
@@ -114,7 +109,7 @@
 
     my $left;
     my @expr = @expression_terminator_sql_keywords;
-    my @binops = $binary_op_keywords;
+    my @binops = @binary_op_keywords;
     while (1) {    # left-associative parsing
         warn "Tokens: " . Dumper $tokens;
         my $lookahead = $tokens->[0];
@@ -164,7 +159,7 @@
         }
 
         # binary operator keywords
-        elsif ( grep { $token =~ /^ $_ $/xi } $binary_op_keywords ) {
+        elsif ( grep { $token =~ /^ $_ $/xi } @binary_op_keywords ) {
             my $op = uc $token;
             my $right = $self->_recurse_parse( $tokens, PARSE_RHS );
 
@@ -242,7 +237,7 @@
             }
 
             # if the parent operator explcitly allows it nuke the parenthesis
-            elsif ( grep { $ast->[0] =~ /^ $_ $/xi } $unrollable_ops ) {
+            elsif ( grep { $ast->[0] =~ /^ $_ $/xi } @unrollable_ops ) {
                 push @children, $child->[1][0];
                 $changes++;
             }
@@ -255,7 +250,7 @@
 
             # only one element in the parenthesis which is a binary op with two LITERAL sub-children
             elsif ( @{ $child->[1] } == 1
-                and grep { $child->[1][0][0] =~ /^ $_ $/xi } ( $binary_op_keywords )
+                and grep { $child->[1][0][0] =~ /^ $_ $/xi } ( @binary_op_keywords )
                   and $child->[1][0][1][0][0] eq 'LITERAL'
                 and $child->[1][0][1][1][0]   eq 'LITERAL' )
             {
@@ -277,7 +272,7 @@
 
 sub unparse {
     my ( $self, $tree ) = shift;
-    my @binops = $binary_op_keywords;
+    my @binops = @binary_op_keywords;
     if ( not $tree ) {
         return '';
     } elsif ( ref $tree->[0] ) {